結果

問題 No.103 素因数ゲーム リターンズ
ユーザー poapoapoapoa
提出日時 2020-07-30 18:27:06
言語 Haskell
(9.8.2)
結果
AC  
実行時間 3 ms / 5,000 ms
コード長 4,381 bytes
コンパイル時間 2,932 ms
コンパイル使用メモリ 181,220 KB
実行使用メモリ 7,904 KB
最終ジャッジ日時 2023-09-17 18:57:25
合計ジャッジ時間 4,754 ms
ジャッジサーバーID
（参考情報） 		judge14 / judge15
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 2 ms
7,556 KB
testcase_01 AC 2 ms
7,460 KB
testcase_02 AC 3 ms
7,588 KB
testcase_03 AC 2 ms
7,564 KB
testcase_04 AC 2 ms
7,556 KB
testcase_05 AC 3 ms
7,480 KB
testcase_06 AC 3 ms
7,604 KB
testcase_07 AC 2 ms
7,440 KB
testcase_08 AC 2 ms
7,524 KB
testcase_09 AC 3 ms
7,520 KB
testcase_10 AC 3 ms
7,620 KB
testcase_11 AC 3 ms
7,592 KB
testcase_12 AC 3 ms
7,724 KB
testcase_13 AC 2 ms
7,716 KB
testcase_14 AC 3 ms
7,664 KB
testcase_15 AC 3 ms
7,696 KB
testcase_16 AC 2 ms
7,792 KB
testcase_17 AC 3 ms
7,660 KB
testcase_18 AC 3 ms
7,736 KB
testcase_19 AC 3 ms
7,784 KB
testcase_20 AC 3 ms
7,692 KB
testcase_21 AC 3 ms
7,632 KB
testcase_22 AC 2 ms
7,632 KB
testcase_23 AC 2 ms
7,744 KB
testcase_24 AC 3 ms
7,904 KB
権限があれば一括ダウンロードができます
コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.6.1/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )
[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