結果

問題 No.103 素因数ゲーム リターンズ
コンテスト
ユーザー poapoa
提出日時 2020-07-30 18:27:06
言語 Haskell
(9.10.1)
結果
AC  
実行時間 2 ms / 5,000 ms
コード長 4,381 bytes
コンパイル時間 7,276 ms
コンパイル使用メモリ 213,376 KB
実行使用メモリ 5,376 KB
最終ジャッジ日時 2024-07-04 13:21:07
合計ジャッジ時間 8,091 ms
ジャッジサーバーID
（参考情報） 		judge3 / judge4
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 5
other AC * 20
権限があれば一括ダウンロードができます
コンパイルメッセージ
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:113: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."
    |
113 | 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.Char             as Char
import qualified Data.List             as List
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.Vector.Unboxed   as VU
import qualified Data.Bits             as Bits

getI :: BSC8.ByteString -> Maybe (Int, BSC8.ByteString)
getI = fmap (Arrow.second BSC8.tail) . BSC8.readInt
getAN :: Int -> IO (VU.Vector Int)
getAN n = VU.unfoldrN n getI <$> BSC8.getLine

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

_func :: Int -> Int
_func = List.foldl1' Bits.xor . map (flip mod 3 . length) . List.group . primeFactors

_func2 :: VU.Vector Int -> Int
_func2 = VU.foldl1' Bits.xor . VU.map _func

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

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

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

pMergeAll :: Ord int => [Queue int] -> Queue int
pMergeAll []       = Empty
pMergeAll [x]      = x
pMergeAll (x:y:qs) = pMerge (pMerge x y) (pMergeAll qs)

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

pMerge :: Ord int => Queue int -> Queue int -> Queue 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 => Wheel int -> Wheel 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 -> Wheel 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

-------------------------------------------------------------------------------
-- primes
-------------------------------------------------------------------------------
0