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. primes :: [Int]
  7. primes = 2:3:5:7: gaps 11 wheel (join $ roll 11 wheel primes')
  8.  where
  9.    primes' = 11:13:17:19:23:29:31: gaps 37 (drop 7 wheel) 
  10.                                 (join $ roll 11 wheel primes')
  11.  
  12.    gaps k (w:t) cs@(VIP c u) | k==c  = gaps (k+w) t u 
  13.                              | True  = k : gaps (k+w) t cs     -- k<c
  14.  
  15.    roll k ws@(w:t) ps@(p:u)  | k==p  = vips (scanl (\c d->c+p*d) (p*p) ws)
  16.                                          : roll (k+w) t u 
  17.                              | True  = roll (k+w) t ps         -- k<p 
  18.  
  19.    join (xs:ys:zs:t) = unionP xs (unionP ys zs)               -- ~(ys:zs:t) w/VIPs causes memory leak
  20.                                       `unionP` join (pairs t) -- strict pat must have more defined primes'
  21.    pairs (xs:ys:t)   = unionP xs ys : pairs t
  22.  
  23.    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:
  24.            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
  25.  
  26.    union a@(x:xs) b@(y:ys) = case compare x y of
  27.       LT -> x: union xs b
  28.       EQ -> x: union xs ys
  29.       GT -> y: union a  ys
  30.  
  31.    vips (x:t) = VIP x $ Crowd t
  32.  
  33.    unionP :: Ord a => People a -> People a -> People a
  34.    unionP (VIP x  t) ys                  = VIP x $ unionP t ys
  35.    unionP (Crowd xs) (Crowd ys)          = Crowd $ union xs ys
  36.    unionP xs@(Crowd (x:t)) ys@(VIP y w)  = case compare x y of
  37.       LT -> VIP x $ unionP (Crowd t) ys
  38.       EQ -> VIP x $ unionP (Crowd t) w
  39.       GT -> VIP y $ unionP xs        w
  40.  
  41. {-
  42. Tree Merged Multiples Re-moval:  O(n^1.24) speed, O(1) space:
  43.  
  44. --- simple_tfold ---- two-feed ------ wheel ------ 3/2 tfold -- gaps/roll 
  45. 1M 4.09s _47.8MB -- 3.28s 4.7MB -- 1.95s 5.8MB -- 1.90s 4.8MB -- 1.38s ---
  46. 2M 9.86s 111.2MB -- 7.66s 4.7MB -- 4.68s 5.8MB -- 4.48s 4.8MB -- 3.25s ---
  47. 3M ------------------------------------------------------------- 5.40s ---
  48. 4M                                                               7.66-4.7
  49. 5M                                                              10.16-4.7
  50. 6M                                                              12.71-4.7
  51.                              ********
  52.     vips/minus   vips~gaps   vips/gaps
  53. 1M   1.95-4.8    1.41-5.8    1.46-4.8
  54. 2M   4.53-4.8    3.51-10.9   3.36-4.8
  55. 3M   7.45-4.8    5.70-12.9   5.55-4.8
  56. 4M  10.71-4.8                7.92-4.8
  57. 5M  13.98-4.8               10.40-4.8
  58. 6M                          12.99-4.8
  59. -}
stdin
copy 
4000000
compilation info 
[1 of 1] Compiling Main             ( prog.hs, prog.o )
Linking prog ...
stdout
copy 
67867967
https://ideone.com/R3TBr
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!