fork download
  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) [email protected](VIP c u) | k==c = gaps (k+w) t u
  13. | True = k : gaps (k+w) t cs -- k<c
  14.  
  15. roll k [email protected](w:t) [email protected](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
4000000
compilation info
[1 of 1] Compiling Main             ( prog.hs, prog.o )
Linking prog ...
stdout
67867967