結果

問題 No.36 素数が嫌い！
コンテスト
ユーザー poapoa
提出日時 2020-08-30 16:30:00
言語 Haskell
(9.10.1)
結果
AC  
実行時間 1,027 ms / 5,000 ms
コード長 3,494 bytes
コンパイル時間 9,678 ms
コンパイル使用メモリ 174,856 KB
実行使用メモリ 9,984 KB
最終ジャッジ日時 2024-11-15 11:19:48
合計ジャッジ時間 14,888 ms
ジャッジサーバーID
（参考情報） 		judge5 / judge3
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 4
other AC * 26
権限があれば一括ダウンロードができます
コンパイルメッセージ
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:73: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."
   |
73 | wheelSieve k = reverse ps ++ map head (pSieve p (cycle ns))
   |                                  ^^^^

Main.hs:96:18: 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."
   |
96 |   where ps = map head . List.group $ primeFactors n
   |                  ^^^^
[2 of 2] Linking a.out

ソースコード

diff # 

import qualified Data.List as List
import           Data.Bool
main :: IO ()
main = readLn >>= putStrLn . bool "NO" "YES" . (>= 3) . length . concat . List.group . primeFactors

-- private
pSpin :: Num int => int -> [int] -> [int]
pSpin x (y:ys) = x : pSpin (x + y) ys
type PWheel int      = ([int], [int])
data PQueue int
  = Empty
  | 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 []       = Empty
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 Empty y    = y
pMerge x Empty    = 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 (Empty, 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 = (Empty, 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
--public
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
composites :: Integral int => [int]
composites = List.unfoldr (\(a1: as@(a2: at), ps@(ph: pt)) -> Just (a1, if a2 == ph then (at, pt) else (as, ps))) ([4..], drop 2 primes)
totient :: Int -> Int
totient n = n `quot` product ps * (product $ map (subtract 1) ps)
  where ps = map head . List.group $ primeFactors n
0