結果

問題 No.36 素数が嫌い！
ユーザー 情報学生情報学生
提出日時 2019-08-27 12:11:41
言語 Haskell
(9.8.2)
結果
AC  
実行時間 843 ms / 5,000 ms
コード長 3,230 bytes
コンパイル時間 3,891 ms
コンパイル使用メモリ 175,088 KB
実行使用メモリ 12,524 KB
最終ジャッジ日時 2023-08-09 01:56:33
合計ジャッジ時間 7,396 ms
ジャッジサーバーID
（参考情報） 		judge12 / judge13
このコードへのチャレンジ（β）

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 163 ms
11,936 KB
testcase_01 AC 22 ms
11,756 KB
testcase_02 AC 3 ms
6,928 KB
testcase_03 AC 2 ms
7,028 KB
testcase_04 AC 2 ms
6,980 KB
testcase_05 AC 5 ms
9,680 KB
testcase_06 AC 7 ms
10,920 KB
testcase_07 AC 12 ms
11,576 KB
testcase_08 AC 3 ms
6,964 KB
testcase_09 AC 2 ms
6,960 KB
testcase_10 AC 3 ms
7,404 KB
testcase_11 AC 242 ms
12,360 KB
testcase_12 AC 843 ms
12,524 KB
testcase_13 AC 832 ms
12,452 KB
testcase_14 AC 9 ms
11,536 KB
testcase_15 AC 2 ms
6,932 KB
testcase_16 AC 2 ms
6,896 KB
testcase_17 AC 2 ms
6,964 KB
testcase_18 AC 2 ms
6,968 KB
testcase_19 AC 32 ms
11,792 KB
testcase_20 AC 32 ms
11,724 KB
testcase_21 AC 92 ms
11,836 KB
testcase_22 AC 22 ms
11,752 KB
testcase_23 AC 12 ms
11,580 KB
testcase_24 AC 103 ms
11,796 KB
testcase_25 AC 122 ms
11,900 KB
testcase_26 AC 262 ms
12,372 KB
testcase_27 AC 22 ms
11,764 KB
testcase_28 AC 252 ms
12,424 KB
testcase_29 AC 12 ms
11,680 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 # 

main :: IO ()
main = (readLn :: IO Int) >>= putStrLn . solve

solve :: Int -> String
solve n | length (primeFactors n) >= 3  = "YES"
        | otherwise                     = "NO"
primes :: Integral int => [int]
primes = wheelSieve 6
wheelSieve :: Integral int
           => Int    -- ^ number of primes canceled by the wheel
           -> [int]  -- ^ infinite list of primes
wheelSieve k = reverse ps ++ map head (sieve p (cycle ns))
 where (p:ps,ns) = wheel k

isPrime :: Integral int => int -> Bool
isPrime n | n > 1     = primeFactors n == [n]
          | otherwise = False
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
sieve :: (Ord int, Num int) => int -> [int] -> [[int]]
sieve p ns@(m:ms) = spin p ns : sieveComps (p+m) ms (composites p ns)

type Composites int = (Queue int,[[int]])

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
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
discard :: Ord int => int -> Composites int -> Composites int
discard n ns | n == m    = discard n ms
             | otherwise = ns
 where (m,ms) = splitComposites ns
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
spin :: Num int => int -> [int] -> [int]
spin x (y:ys) = x : spin (x+y) ys
type Wheel int = ([int],[int])
wheel :: Integral int => Int -> Wheel int
wheel n = iterate next ([2],[1]) !! n
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
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
data Queue int = Empty | Fork [int] [Queue int]

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


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)
dequeue :: Ord int => Queue int -> ([int], Queue int)
dequeue (Fork ns qs) = (ns,mergeAll qs)

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