結果

問題 No.103 素因数ゲーム リターンズ
ユーザー poapoapoapoa
提出日時 2020-07-30 18:21:44
言語 Haskell
(9.8.2)
結果
WA  
実行時間 -
コード長 4,379 bytes
コンパイル時間 2,377 ms
コンパイル使用メモリ 184,340 KB
実行使用メモリ 8,056 KB
最終ジャッジ日時 2023-09-17 16:13:00
合計ジャッジ時間 4,049 ms
ジャッジサーバーID
（参考情報） 		judge15 / judge11
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 3 ms
7,608 KB
testcase_01 WA -
testcase_02 AC 3 ms
7,524 KB
testcase_03 WA -
testcase_04 AC 3 ms
7,568 KB
testcase_05 AC 3 ms
7,592 KB
testcase_06 AC 3 ms
7,508 KB
testcase_07 AC 2 ms
7,424 KB
testcase_08 AC 3 ms
7,512 KB
testcase_09 WA -
testcase_10 AC 3 ms
7,516 KB
testcase_11 WA -
testcase_12 WA -
testcase_13 AC 3 ms
7,768 KB
testcase_14 AC 3 ms
7,696 KB
testcase_15 AC 3 ms
7,704 KB
testcase_16 WA -
testcase_17 AC 3 ms
7,712 KB
testcase_18 WA -
testcase_19 AC 3 ms
7,972 KB
testcase_20 WA -
testcase_21 AC 3 ms
7,688 KB
testcase_22 AC 3 ms
7,744 KB
testcase_23 AC 2 ms
7,788 KB
testcase_24 WA -
権限があれば一括ダウンロードができます
コンパイルメッセージ
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 n = List.foldl1' Bits.xor $ map (flip mod 3 . length) $ List.group $ primeFactors n
_func2 :: VU.Vector Int -> Int
_func2 = VU.foldl1' (Bits.xor . _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