fork download
copy 
  1. {-# OPTIONS_GHC -O2 -fno-cse #-}
  2. main = getLine >>= print . (primes !!) . (+ (-1)) . read
  3.  
  4. data People a = VIP a (People a) | Crowd [a]
  5.  
  6. mergeP :: Ord a => People a -> People a -> People a
  7. mergeP (VIP x xt) ys                    = VIP x $ mergeP xt ys
  8. mergeP (Crowd xs) (Crowd ys)            = Crowd $ merge  xs ys
  9. mergeP xs@(Crowd (x:xt)) ys@(VIP y yt)  = case compare x y of
  10.     LT -> VIP x $ mergeP (Crowd xt) ys
  11.     EQ -> VIP x $ mergeP (Crowd xt) yt
  12.     GT -> VIP y $ mergeP xs yt
  13.  
  14. merge :: Ord a => [a] -> [a] -> [a]
  15. merge xs@(x:xt) ys@(y:yt) = case compare x y of
  16.     LT -> x : merge xt ys
  17.     EQ -> x : merge xt yt
  18.     GT -> y : merge xs yt
  19.  
  20. diff xs@(x:xt) ys@(y:yt) = case compare x y of
  21.     LT -> x : diff xt ys
  22.     EQ ->     diff xt yt
  23.     GT ->     diff xs yt
  24.  
  25. foldTree :: (a -> a -> a) -> [a] -> a
  26. foldTree f xs = go xs -- (pairs xs)
  27.     where pairs ~(x: ~(y:ys)) = f x y : pairs ys
  28.           go ~(x:zs) = x `f` go (pairs zs)
  29.  
  30. 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:
  31.                  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
  32. roll       = scanl (+)
  33. wheelNums  = roll 0 wheel         -- [0,2,6,8,12,18, ...] 
  34. rollFrom n = go wheelNums wheel
  35.   where m = (n-11) `mod` 210
  36.         go (x:xs) (w:ws) = if x==m then roll (n+w) ws else go xs ws
  37.  
  38. primes :: [Int]
  39. primes    = 2:3:5:7:primes'
  40.   where
  41.     primes' = diff (roll 11 wheel) 
  42.                ( serve . foldTree mergeP . map multiples $ primes_ )
  43.  
  44.     primes_ = h ++ diff t
  45.                ( serve . foldTree mergeP . map multiples $ primes_ )
  46.               where (h,t) = splitAt 6 (roll 11 wheel) 
  47.  
  48.     multiples p = -- vip -- [p*q|q<-[p,p+2..]] -- [p*p,p*p+2*p..]
  49.                   VIP (p*p) $ Crowd [p*q|q<-rollFrom p]
  50.  
  51.     -- vip (x:xs)       = VIP x $ Crowd xs
  52.     serve (VIP x xs) = x:serve xs
  53.     serve (Crowd xs) = xs
stdin
copy 
3000000
compilation info 
[1 of 1] Compiling Main             ( prog.hs, prog.o )
Linking prog ...
stdout
copy 
49979687
https://ideone.com/DLHp2
language:
Haskell (ghc 8.4.4)
created:
13 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!