{-# OPTIONS_GHC -O2 -fno-cse #-} main = getLine >>= print . (primes !!) . (+ (-1)) . read data People a = VIP a (People a) | Crowd [a] mergeP :: Ord a => People a -> People a -> People a mergeP (VIP x xt) ys = VIP x $ mergeP xt ys mergeP (Crowd xs) (Crowd ys) = Crowd $ merge xs ys mergeP xs@(Crowd (x:xt)) ys@(VIP y yt) = case compare x y of LT -> VIP x $ mergeP (Crowd xt) ys EQ -> VIP x $ mergeP (Crowd xt) yt GT -> VIP y $ mergeP xs yt merge :: Ord a => [a] -> [a] -> [a] merge xs@(x:xt) ys@(y:yt) = case compare x y of LT -> x : merge xt ys EQ -> x : merge xt yt GT -> y : merge xs yt diff xs@(x:xt) ys@(y:yt) = case compare x y of LT -> x : diff xt ys EQ -> diff xt yt GT -> diff xs yt foldTree :: (a -> a -> a) -> [a] -> a foldTree f xs = go xs -- (pairs xs) where pairs ~(x: ~(y:ys)) = f x y : pairs ys go ~(x:zs) = x `f` go (pairs zs) wheel = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2: 4:8:6:4:6:2:4:6:2:6:6:4:2:4:6:2:6:4:2:4:2:10:2:10:wheel roll = scanl (+) wheelNums = roll 0 wheel -- [0,2,6,8,12,18, ...] rollFrom n = go wheelNums wheel where m = (n-11) `mod` 210 go (x:xs) (w:ws) = if x==m then roll (n+w) ws else go xs ws primes :: [Int] primes = 2:3:5:7:primes' where primes' = diff (roll 11 wheel) ( serve . foldTree mergeP . map multiples $ primes_ ) primes_ = h ++ diff t ( serve . foldTree mergeP . map multiples $ primes_ ) where (h,t) = splitAt 6 (roll 11 wheel) multiples p = -- vip -- [p*q|q<-[p,p+2..]] -- [p*p,p*p+2*p..] VIP (p*p) $ Crowd [p*q|q<-rollFrom p] -- vip (x:xs) = VIP x $ Crowd xs serve (VIP x xs) = x:serve xs serve (Crowd xs) = xs