import qualified Data.List as List import Data.Bool main :: IO () main = readLn >>= putStrLn . bool "NO" "YES" . (>= 3) . length . concat . List.group . primeFactors -- private pSpin :: Num int => int -> [int] -> [int] pSpin x (y:ys) = x : pSpin (x + y) ys type PWheel int = ([int], [int]) data PQueue int = Empty | Fork [int] [PQueue int] type Composites int = (PQueue int, [[int]]) pEnqueue :: Ord int => [int] -> PQueue int -> PQueue int pEnqueue ns = pMerge (Fork ns []) pMergeAll :: Ord int => [PQueue int] -> PQueue int pMergeAll [] = Empty pMergeAll [x] = x pMergeAll (x:y:qs) = pMerge (pMerge x y) (pMergeAll qs) pDequeue :: Ord int => PQueue int -> ([int], PQueue int) pDequeue (Fork ns qs) = (ns, pMergeAll qs) pMerge :: Ord int => PQueue int -> PQueue int -> PQueue 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 => PWheel int -> PWheel 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 -> PWheel int pWheel n = iterate pNext ([2], [1]) !! n --public 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 composites :: Integral int => [int] composites = List.unfoldr (\(a1: as@(a2: at), ps@(ph: pt)) -> Just (a1, if a2 == ph then (at, pt) else (as, ps))) ([4..], drop 2 primes) totient :: Int -> Int totient n = n `quot` product ps * (product $ map (subtract 1) ps) where ps = map head . List.group $ primeFactors n