fork(1) download
  1. {-# OPTIONS_GHC -O2 #-}
  2. {-# LANGUAGE MonoLocalBinds #-}
  3. import Control.Monad (forM_, when)
  4. import Control.Monad.ST
  5. import Control.Arrow -- based on Daniel Fischer's code from
  6. import Data.Array.ST -- stackoverflow.com/a/15026238/849891
  7. import Data.Array.Unboxed -- here changed to work with odds only
  8. import Data.Array.Base
  9.  
  10. primeSieve :: Int -> UArray Int Bool
  11. primeSieve top = runSTUArray $ do
  12. let m = (top-1) `div` 2
  13. a <- newArray (0,m) True -- one extra at start: '1'
  14. let r = (`div` 2) . floor . sqrt $ fromIntegral top + 1
  15. mark step idx
  16. | m < idx = return ()
  17. | otherwise = do
  18. unsafeWrite a idx False -- unsafe: idx from start
  19. mark step (idx+step)
  20. sift i
  21. | r < i = return a -- ((2*i+1)^2-1)`div`2 = 2*i*(i+1)
  22. | otherwise = do
  23. prim <- unsafeRead a i
  24. when prim $ mark (2*i+1) (2*i*(i+1))
  25. sift (i+1)
  26. sift 1
  27.  
  28. -- Return primes from sieve as list:
  29. primesTo :: Int -> [Int]
  30. primesTo top = 2 : drop 1 [2*p + 1 | (p,True) <- assocs $ primeSieve top]
  31.  
  32. main :: IO ()
  33. -- print . ( length &&& last) $ primesTo 20000000
  34. main = do
  35. let a = primeSieve 2050000000
  36. (0,t) = bounds a
  37. x = (+1).(*2).head.filter (a!) $ [t,t-1..1] -- top prime
  38. n = length [ () | (p,True) <- assocs a]
  39. print (n, x)
  40.  
  41. -- see also: ideone.com/0DfTcI, ideone.com/ltpuCC,
  42. -- stackoverflow.com/questions/15024067/whats-the-ideal
  43. -- -implementation-for-the-sieve-of-eratosthenes-between-lists-arr
  44. {-
  45.   this,STUA/odds: j24jxV rhj9ub.SA() fapob(C++)
  46.  (1270607,19999999) 0.19s-8.3M
  47.  (6000001,104395303) 1.28s-9.4M 7.54s-9.4M 0.79s-2.7M (1.6x)
  48.  (8000000,141650939) 1.79s-9.4M n^1.17 10.61-9.3M 1.11s-2.7M (1.6x)
  49.  (18000000,334214459) 4.76s-9.3M n^1.21 (5.9x) 2.89s-2.7M (1.6x)
  50.   1bln 9.45s-2.7M
  51.  
  52. 2018-06-15: j24jxV (KwZNc) fapob
  53.   1.5x slower 6m-0.40s- 9.3M (2.63s-10MB) 0.27s- 8.9MB
  54.   1.6x slower 18m-1.79s-23.2M (9.69s-24MB) 1.11s-22.9MB
  55.   1.55x 100556393-12.43s-128M 7.96s-128M
  56.   than C++ (6.5..5.5x slower than j24jxV)
  57. -}
Success #stdin #stdout 12.43s 127984KB
stdin
Standard input is empty
stdout
(100556393,2049999979)