fork download
copy 
  1. {-# OPTIONS_GHC -O2 #-}
  2.  
  3. {-        original          tweaked          nested-feed         array-based
  4.           (3*p,p)           (p*p,2*p)           JBwoVL             abPSOx
  5.           6Uv0cL          2x speed-up        3x+ speed-up
  6.                 n^                n^                  n^                  n^
  7. 100K:  0.78s             0.38s               0.13s              0.065s    
  8. 200K:  2.02s   1.37      0.97s   1.35        0.29s   1.16       0.13s    1.00
  9. 400K:  5.05s   1.32      2.40s   1.31        0.70s   1.27       0.29s    1.16
  10. 800K: 12.37s   1.29                     1M:  2.10s   1.20       0.82s    1.13
  11.  2M:                                                            1.71s    1.06
  12.  4M:                                                            3.72s    1.12
  13. 10M:                                                            9.84s    1.06 
  14.     overall in the tested range:
  15.                1.33                                  1.21                1.09
  16.     -}
  17.  
  18. module Main where   -- initial code from from stackoverflow.com/a/42122559
  19.                     -- by stackoverflow.com/users/2144669/david-eisenstat
  20. type Nat = Int   
  21.  
  22. data Heap = Leaf !Nat !Nat
  23.           | Branch !Nat !Heap !Heap
  24.           deriving Show
  25.  
  26. top :: Heap -> Nat
  27. top (Leaf n _) = n
  28. top (Branch n _ _) = n
  29.  
  30. leaf :: Nat -> Heap           -- tweak by stackoverflow.com/users/849891/will-ness:
  31. leaf p = Leaf (p*p + 2*p) (2*p)        -- wn
  32. -- leaf p = Leaf (3 * p) p             -- (original)
  33.  
  34. branch :: Heap -> Heap -> Heap
  35. branch h1 h2 = Branch (min (top h1) (top h2)) h1 h2
  36.  
  37. pop :: Heap -> Heap           -- popAndReinsert, really
  38. pop (Leaf n d) = Leaf (n + d) d          -- wn
  39. -- pop (Leaf n d) = Leaf (n + 2*d) d     -- (original)
  40. pop (Branch _ h1 h2)
  41.   = case compare (top h1) (top h2) of
  42.         LT -> branch (pop h1) h2
  43.         EQ -> branch (pop h1) (pop h2)
  44.         GT -> branch h1       (pop h2)
  45.  
  46. push :: Nat -> Heap -> Heap
  47. push p h@(Leaf _ _)     = branch (leaf p)    h
  48. push p (Branch _ h1 h2) = branch (push p h2) h1
  49.  
  50. primes0 :: [Nat]              -- original definition
  51. primes0
  52.   = let helper n h
  53.           = case compare n (top h) of
  54.                 LT -> n : helper (n + 2) (push n h)
  55.                 EQ ->     helper (n + 2) (pop h)
  56.                 GT ->     helper  n      (pop h)
  57.       in 2 : 3 : helper 5 (leaf 3)
  58.  
  59. primes :: [Nat]   -- nested primes feed chain by stackoverflow.com/users/849891/will-ness
  60. primes            -- for additional 3x+ speedup due to quadratic reduction in memory usage
  61.   = let           -- and noticeable improvement in empirical orders of growth
  62.         helper n h q ps@(p:r)
  63.           | n==q      = helper (n + 2) (push p h) (head r^2) r
  64.           | otherwise = case compare n (top h) of
  65.                 LT -> n : helper (n + 2) h       q ps
  66.                 EQ ->     helper (n + 2) (pop h) q ps
  67.                 GT ->     helper  n      (pop h) q ps
  68.         -- ps = [5,7] ++ helper 11 (leaf 3) 25 ps 
  69.         _Y g = g (_Y g)      -- = g (g (g (g (...)))) = g . g . g . g . ....
  70.       in -- 2 : 3 : ps 
  71.          2 : 3 : _Y (([5,7] ++) . helper 11 (leaf 3) 25)
  72.  
  73. main = do (print $ primes !! 1000000)
Success #stdin #stdout 2.1s 8388607KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
15485867
https://ideone.com/JBwoVL
double-loop the primes heap code from stackoverflow.com/a/42122559
language:
Haskell (ghc 8.4.4)
created:
7 years ago
visibility:
public

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!