結果

問題 No.106 素数が嫌い！2
コンテスト
ユーザー poapoa
提出日時 2020-07-31 11:25:25
言語 Haskell
(9.10.1)
結果
AC  
実行時間 63 ms / 5,000 ms
コード長 4,456 bytes
記録
記録タグの例:
初AC ショートコード 純ショートコード 純主流ショートコード 最速実行時間
コンパイル時間 12,514 ms
コンパイル使用メモリ 207,904 KB
実行使用メモリ 24,288 KB
最終ジャッジ日時 2024-07-06 01:30:10
合計ジャッジ時間 13,528 ms
ジャッジサーバーID
（参考情報） 		judge2 / judge5
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 3
other AC * 13
権限があれば一括ダウンロードができます
コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )

Main.hs:125:34: warning: [GHC-63394] [-Wx-partial]
    In the use of ‘head’
    (imported from Prelude, but defined in GHC.List):
    "This is a partial function, it throws an error on empty lists. Use pattern matching or Data.List.uncons instead. Consider refactoring to use Data.List.NonEmpty."
    |
125 | wheelSieve k = reverse ps ++ map head (pSieve p (cycle ns))
    |                                  ^^^^
[2 of 2] Linking a.out

ソースコード

diff #
raw source code 

import qualified Control.Arrow               as Arrow
import qualified Control.Monad               as Monad
import qualified Data.ByteString.Char8       as BSC8
import qualified Data.List                   as List
import qualified Data.Vector.Unboxed         as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

-- solver
solver :: Int -> Int -> IO Int
solver n k = do
  table <- VUM.replicate (n+1) 0 :: IO (VUM.IOVector Int)
  Monad.forM_ [2..n] $ \i -> do
    x <- VUM.read table i
    Monad.when (x == 0) $ do
      VUM.write table i 1
      Monad.forM_ [2 * i, 3 * i .. n] $ \j -> _modify table j (+1)
  Monad.foldM (_func k table) 0 [2 .. n]
    where
      _func k table c i = do
        x <- VUM.read table i
        if x >= k
          then return (c + 1)
          else return c

_modify :: VUM.IOVector Int -> Int -> (Int -> Int) -> IO ()
_modify v i f = do
  x <- VUM.read v i
  VUM.write v i (f x)

-- main
main :: IO ()
main = do
  (n, k) <- getAB
  print =<< solver n k

-- io
getI :: BSC8.ByteString -> Maybe (Int, BSC8.ByteString)
getI = fmap (Arrow.second BSC8.tail) . BSC8.readInt
getAB :: IO (Int, Int)
getAB = (\vec -> (vec VU.! 0, vec VU.! 1)) . VU.unfoldrN 2 getI <$> BSC8.getLine

-- primes
pSpin :: Num int => int -> [int] -> [int]
pSpin x (y:ys) = x : pSpin (x + y) ys

type PWheel int      = ([int], [int])
data PQueue int
  = Emtabley
  | Fork [int] [PQueue int]
type Composites int = (PQueue int, [[int]])

pEnqueue :: Ord int => [int] -> PQueue int -> PQueue int
pEnqueue ns = pMerge (Fork ns [])

pMergeAll :: Ord int => [PQueue int] -> PQueue int
pMergeAll []       = Emtabley
pMergeAll [x]      = x
pMergeAll (x:y:qs) = pMerge (pMerge x y) (pMergeAll qs)

pDequeue :: Ord int => PQueue int -> ([int], PQueue int)
pDequeue (Fork ns qs) = (ns, pMergeAll qs)

pMerge :: Ord int => PQueue int -> PQueue int -> PQueue int
pMerge Emtabley y    = y
pMerge x Emtabley    = x
pMerge x y
  | prio x <= prio y = join x y
  | otherwise        = join y x
  where
    prio (Fork (n:_) _) = n
    join (Fork ns qs) q = Fork ns (q:qs)

pDiscard :: Ord int => int -> Composites int -> Composites int
pDiscard n ns
  | n == m    = pDiscard n ms
  | otherwise = ns
  where
    (m, ms) = pSplitComposites ns

pSplitComposites :: Ord int => Composites int -> (int, Composites int)
pSplitComposites (Emtabley, xs:xss) = pSplitComposites (Fork xs [], xss)
pSplitComposites (queue, xss@((x:xs):yss))
  | x < z     = (x, pDiscard x (pEnqueue xs queue, yss))
  | otherwise = (z, pDiscard z (pEnqueue zs queue', xss))
  where
    (z:zs, queue') = pDequeue queue

pSieveComps :: (Ord int, Num int) => int -> [int] -> Composites int -> [[int]]
pSieveComps cand ns@(m:ms) xs
  | cand == comp = pSieveComps (cand+m) ms ys
  | cand <  comp = pSpin cand ns : pSieveComps (cand + m) ms xs
  | otherwise    = pSieveComps cand ns ys
  where
    (comp, ys) = pSplitComposites xs

pComposites :: (Ord int, Num int) => int -> [int] -> Composites int
pComposites p ns = (Emtabley, map comps (pSpin p ns: pSieve p ns))
  where
    comps xs@(x:_) = map (x*) xs

pSieve :: (Ord int, Num int) => int -> [int] -> [[int]]
pSieve p ns@(m:ms) = pSpin p ns : pSieveComps (p+m) ms (pComposites p ns)

pCancel :: Integral int => int -> int -> int -> [int] -> [int]
pCancel 0 _ _ _ = []
pCancel m p n (x:ys@(y:zs))
  | nx `mod` p > 0 = x : pCancel (m - x) p nx ys
  | otherwise      = pCancel m p n (x+y:zs)
  where
    nx = n + x

pNext :: Integral int => PWheel int -> PWheel int
pNext (ps@(p:_), xs) = (py:ps, pCancel (product ps) p py ys)
  where
    (y:ys) = cycle xs
    py = p + y

pWheel :: Integral int => Int -> PWheel int
pWheel n = iterate pNext ([2], [1]) !! n
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
  ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
--  ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----

wheelSieve :: Integral int => Int -> [int]
wheelSieve k = reverse ps ++ map head (pSieve p (cycle ns))
  where
    (p:ps,ns) = pWheel k

primeFactors :: Integral int => int -> [int]
primeFactors n = factors n (wheelSieve 6)
  where
    factors 1 _      = []
    factors m (p:ps)
      | m < p * p = [m]
      | r == 0    = p : factors q (p:ps)
      | otherwise = factors m ps
      where
        (q, r) = quotRem m p

primes :: Integral int => [int]
primes = wheelSieve 6

isPrime :: Integral int => int -> Bool
isPrime n
  | n > 1 = primeFactors n == [n]
  | otherwise = False
0