結果

問題 No.2 素因数ゲーム
コンテスト
ユーザー poapoa
提出日時 2020-07-23 23:31:42
言語 Haskell
(9.10.1)
結果
AC  
実行時間 3 ms / 5,000 ms
コード長 3,706 bytes
コンパイル時間 5,321 ms
コンパイル使用メモリ 173,056 KB
実行使用メモリ 5,376 KB
最終ジャッジ日時 2024-06-23 22:39:14
合計ジャッジ時間 6,357 ms
ジャッジサーバーID
（参考情報） 		judge3 / judge4
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
other AC * 31
権限があれば一括ダウンロードができます
コンパイルメッセージ
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:86: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."
   |
86 | wheelSieve k = reverse ps ++ map head (sieve p (cycle ns))
   |                                  ^^^^
[2 of 2] Linking a.out

ソースコード

diff #
raw source code 

import qualified Data.Bits           as Bits
import qualified Data.List           as List
-------------------------------------------------------------------------------
-- primes
-------------------------------------------------------------------------------
spin :: Num int => int -> [int] -> [int]
spin x (y:ys) = x : spin (x+y) ys

type Wheel int      = ([int], [int])
data Queue int
  = Empty
  | Fork [int] [Queue int]
type Composites int = (Queue int, [[int]])

enqueue :: Ord int => [int] -> Queue int -> Queue int
enqueue ns = merge (Fork ns [])

mergeAll :: Ord int => [Queue int] -> Queue int
mergeAll []       = Empty
mergeAll [x]      = x
mergeAll (x:y:qs) = merge (merge x y) (mergeAll qs)

dequeue :: Ord int => Queue int -> ([int], Queue int)
dequeue (Fork ns qs) = (ns, mergeAll qs)

merge :: Ord int => Queue int -> Queue int -> Queue int
merge Empty y    = y
merge x Empty    = x
merge 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)

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

splitComposites :: Ord int => Composites int -> (int, Composites int)
splitComposites (Empty, xs:xss) = splitComposites (Fork xs [], xss)
splitComposites (queue, xss@((x:xs):yss))
  | x < z     = (x, discard x (enqueue xs queue, yss))
  | otherwise = (z, discard z (enqueue zs queue', xss))
  where
    (z:zs, queue') = dequeue queue

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

composites :: (Ord int, Num int) => int -> [int] -> Composites int
composites p ns = (Empty, map comps (spin p ns: sieve p ns))
  where
    comps xs@(x:_) = map (x*) xs

sieve :: (Ord int, Num int) => int -> [int] -> [[int]]
sieve p ns@(m:ms) = spin p ns : sieveComps (p+m) ms (composites p ns)

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

next :: Integral int => Wheel int -> Wheel int
next (ps@(p:_), xs) = (py:ps, cancel (product ps) p py ys)
  where
    (y:ys) = cycle xs
    py = p + y

wheel :: Integral int => Int -> Wheel int
wheel n = iterate next ([2], [1]) !! n
---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
  ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ---- ----
wheelSieve :: Integral int => Int -> [int]
wheelSieve k = reverse ps ++ map head (sieve p (cycle ns))
  where
    (p:ps,ns) = wheel 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

-------------------------------------------------------------------------------
-- primes
-------------------------------------------------------------------------------

main :: IO ()
main = do
  n <- readLn :: IO Int
  if (solve n) == 0
    then putStrLn "Bob"
    else putStrLn "Alice"

solve :: (Int -> Int)
solve = List.foldl1' Bits.xor . map length . List.group . primeFactors
0