結果

問題 No.103 素因数ゲーム リターンズ
ユーザー poapoapoapoa
提出日時 2020-07-30 18:21:44
言語 Haskell
(9.8.2)
結果
WA  
実行時間 -
コード長 4,379 bytes
コンパイル時間 5,623 ms
コンパイル使用メモリ 213,632 KB
実行使用メモリ 5,376 KB
最終ジャッジ日時 2024-07-04 11:06:53
合計ジャッジ時間 6,339 ms
ジャッジサーバーID
（参考情報） 		judge1 / judge3
このコードへのチャレンジ
（要ログイン）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 1 ms
5,248 KB
testcase_01 WA -
testcase_02 AC 2 ms
5,376 KB
testcase_03 WA -
testcase_04 AC 1 ms
5,376 KB
testcase_05 AC 1 ms
5,376 KB
testcase_06 AC 2 ms
5,376 KB
testcase_07 AC 2 ms
5,376 KB
testcase_08 AC 1 ms
5,376 KB
testcase_09 WA -
testcase_10 AC 1 ms
5,376 KB
testcase_11 WA -
testcase_12 WA -
testcase_13 AC 2 ms
5,376 KB
testcase_14 AC 1 ms
5,376 KB
testcase_15 AC 2 ms
5,376 KB
testcase_16 WA -
testcase_17 AC 2 ms
5,376 KB
testcase_18 WA -
testcase_19 AC 2 ms
5,376 KB
testcase_20 WA -
testcase_21 AC 1 ms
5,376 KB
testcase_22 AC 1 ms
5,376 KB
testcase_23 AC 2 ms
5,376 KB
testcase_24 WA -
権限があれば一括ダウンロードができます
コンパイルメッセージ
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:112: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."
    |
112 | 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 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