結果

問題 No.36 素数が嫌い！
コンテスト
ユーザー poapoa
提出日時 2020-08-30 23:49:45
言語 Haskell
(9.10.1)
結果
WA  
実行時間 -
コード長 3,036 bytes
コンパイル時間 6,212 ms
コンパイル使用メモリ 179,748 KB
実行使用メモリ 10,752 KB
最終ジャッジ日時 2024-11-15 16:00:11
合計ジャッジ時間 3,498 ms
ジャッジサーバーID
（参考情報） 		judge1 / judge3
このコードへのチャレンジ
（要ログイン）
ファイルパターン 結果
sample AC * 4
other AC * 25 WA * 1
権限があれば一括ダウンロードができます
コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )
[2 of 2] Linking a.out

ソースコード

diff # 

import           Control.Monad
import           Control.Monad.ST
import           Data.Bool
import qualified Data.Bits                     as Bits
import qualified Data.Array.ST                 as ArrST
import qualified Data.Array.Unboxed            as ArrU

sieveUA :: Int -> ArrU.UArray Int Bool
sieveUA top = ArrST.runSTUArray $ do
    let m = (top-1) `div` 2
        r = floor . sqrt $ fromIntegral top + 1
    sieve <- ArrST.newArray (1,m) True
    forM_ [1..r `div` 2] $ \i -> do
      isPrime <- ArrST.readArray sieve i
      when isPrime $ do
        forM_ [2*i*(i+1), 2*i*(i+2)+1..m] $ \j -> do
          ArrST.writeArray sieve j False
    return sieve

primesToUA :: Int -> [Int]
primesToUA top = 2 : [i*2+1 | (i,True) <- ArrU.assocs $ sieveUA top]

main :: IO ()
main = readLn >>= putStrLn . solver


solver :: Int -> String
solver n = bool "NO" "YES" $ func1 n

func1 :: Int -> Bool
func1 n = iter n 0 ps
  where
    ps = primesToUA 1000000
    iter res p []      = p >= 3 || (p == 2 && millerRabin p) 
    iter i j (l:ls)
      | i <  2         = j >= 3
      | j >= 3         = True
      | i `mod` l == 0 = iter (func2 i l) (j + func3 i l) ls
      | otherwise      = iter i j ls

func2 :: Int -> Int -> Int
func2 n mo
  | n `mod` mo == 0 = func2 (n `div` mo) mo
  | otherwise       = n

func3 :: Int -> Int -> Int
func3 n mo = iter n mo 0
  where
    iter i j k
      | i `mod` j == 0 = iter (i `div` j) j (k + 1)
      | otherwise      = k

millerRabin :: Int -> Bool
millerRabin n
  |  n <= 1 = False
  |  n == 2
  || n == 3
  || n == 5
  || n == 7 = True
  |  even n = False
  |  otherwise = mrCheck $ fromIntegral n

powMod :: Integer -> Integer -> Integer -> Integer
powMod b e m = loop 1 (b `mod` m) e
  where
    loop res base pxe
      | pxe <= 0 = res
      | otherwise =
        let res'  = if pxe `mod` 2 == 1 then (res * base) `mod` m else res
            pxe'  = Bits.shift pxe (-1)
            base' = (base * base) `mod` m
        in loop res' base' pxe'

factoringPowers :: Integer -> (Integer, Integer)
factoringPowers n = loop (n - 1) 0
  where
    loop d s
      | even d    = loop (d `div` 2) (s + 1)
      | otherwise = (s, d)

mrCheck :: Integer -> Bool
mrCheck p
  | p < 2047                = loop [2]
  | p < 9080191             = loop [31,73]
  | p < 4759123141          = loop [2,7,61]
  | p < 1122004669633       = loop [2,13,23,1662803]
  | p < 2152302898747       = loop [2,3,5,7,11]
  | p < 341550071728321     = loop [2,3,5,7,11,13,17]
  | p < 3825123056546413051 = loop [2,3,5,7,11,13,17,19,23]
  | p < 9223372036854775808 = loop [2,325,9375,28178,450775,9780504,1795265022]
  | otherwise               = loop [ 2 .. min (p - 1) (floor $ 2 * (log p')^(2 :: Int)) ]
  where
    p' = fromIntegral p :: Double
    (s, d) = factoringPowers p
    loop [] = True
    loop (a:as)
      | (powMod a d p) /= 1 && powLoop 0 = False
      | otherwise = loop as
      where
        powLoop r
          | r < s     = (powMod a (2 ^ r * d) p) /= (p - 1)  && powLoop (r + 1)
          | otherwise = True
0