結果

問題 No.106 素数が嫌い！2
ユーザー poapoapoapoa
提出日時 2020-07-31 11:25:25
言語 Haskell
(9.8.2)
結果
AC  
実行時間 63 ms / 5,000 ms
コード長 4,456 bytes
コンパイル時間 12,514 ms
コンパイル使用メモリ 207,904 KB
実行使用メモリ 24,288 KB
最終ジャッジ日時 2024-07-06 01:30:10
合計ジャッジ時間 13,528 ms
ジャッジサーバーID
（参考情報） 		judge2 / judge5
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 22 ms
15,976 KB
testcase_01 AC 2 ms
6,812 KB
testcase_02 AC 1 ms
6,944 KB
testcase_03 AC 1 ms
6,940 KB
testcase_04 AC 24 ms
15,844 KB
testcase_05 AC 48 ms
24,288 KB
testcase_06 AC 59 ms
23,296 KB
testcase_07 AC 58 ms
23,424 KB
testcase_08 AC 6 ms
8,832 KB
testcase_09 AC 6 ms
8,832 KB
testcase_10 AC 59 ms
23,424 KB
testcase_11 AC 25 ms
14,720 KB
testcase_12 AC 63 ms
22,656 KB
testcase_13 AC 1 ms
5,376 KB
testcase_14 AC 1 ms
5,376 KB
testcase_15 AC 2 ms
5,376 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
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 # 

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