fork download
copy 
  1. {-# OPTIONS_GHC -O2 -fno-cse #-}
  2.  
  3. module Main where
  4.  
  5. main = do
  6.   m <- getLine
  7.   putStr $ m ++ "-th prime: "
  8.   print $ tmwprimes !! (read m - 1)
  9.  
  10. tmwprimes :: [Int]
  11. tmwprimes = 2:3:5:7:primes'   -- tree-merged | primes-multiples removal
  12.    where                     --             | with 2-3-5-7 WHEEL
  13.     primes'  = roll 11 wheel `minus` (fst.tfold unionSP)
  14.                  [([p*p],[p*q|q<-rollFrom p]) | p <- primes_]
  15.     primes_  = h ++ t `minus` (fst.tfold unionSP)
  16.                  [([p*p],[p*q|q<-rollFrom p]) | p <- primes_]
  17.       where (h,t) = splitAt 6 (11:rollFrom 11)          -- avoid sharing
  18.  
  19.     tfold f xs = go (pairs xs)
  20.       where go (a:b:c:ys) = f a (f b c) `f` go (pairs ys)
  21.             pairs (a:b:ys) = f a b : pairs ys
  22.  
  23.     unionSP (a:as,bs)   v   = (a:x,y)  where (x,y)=unionSP (as,bs) v
  24.     unionSP u@([],b:bs) v@(c:cs,ds) = case compare b c of
  25.                        LT ->  (b:x,y)  where (x,y)=unionSP ([],bs) v 
  26.                        EQ ->  (b:x,y)  where (x,y)=unionSP ([],bs) (cs,ds) 
  27.                        GT ->  (c:x,y)  where (x,y)=unionSP u       (cs,ds)
  28.     unionSP ([],bs) ([],ds) = ([] ,union bs ds)
  29.  
  30.     rollFrom n = go wheelNums wheel
  31.       where m = (n-11) `mod` 210
  32.             go (x:xs) (w:ws) | x==m = roll (n+w) ws 
  33.                              | True = go xs ws
  34.     wheelNums  = roll 0 wheel         -- [0,2,6,8,12,18, ...] 
  35.     roll       = scanl (+)
  36.     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:
  37.                  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
  38.  
  39.     union a@(x:xs) b@(y:ys) = case compare x y of 
  40.                                 LT -> x: union xs b 
  41.                                 EQ -> x: union xs ys
  42.                                 GT -> y: union a  ys
  43.     union a        b        = if null a then b else a
  44.  
  45.     minus a@(x:xs) b@(y:ys) = case compare x y of 
  46.                                 LT -> x: xs `minus` b
  47.                                 EQ ->    xs `minus` ys
  48.                                 GT ->    a  `minus` ys
  49.     minus a        b        = a
Success #stdin #stdout 5.18s 5780KB
comments (?)
stdin
copy 
1000000

500k:  2.22s-4.8MB            7368787
1mln:  5.12s-5.8MB  n^1.21   15485863
2mln: 11.84s-5.8MB  n^1.21   32452843
stdout
copy 
1000000-th prime: 15485863
https://ideone.com/FU52u
language:
Haskell (ghc 8.4.4)
created:
12 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!