Personal tools

Prime numbers miscellaneous

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
(One-liners: replace one w/ better variant)
(One-liners: +two new on-liners)
(4 intermediate revisions by one user not shown)
Line 135: Line 135:
 
== One-liners ==
 
== One-liners ==
   
<haskell> primes = [n | n<-[2..], not $ elem n [j*k | j<-[2..n-1], k<-[2..n-1]]]
+
<haskell>primes = [n | n<-[2..], not $ elem n [j*k | j<-[2..n-1], k<-[2..n-1]]]
 
primes = [n | n<-[2..], not $ elem n [j*k | j<-[2..n-1], k<-[2..min j (n`div`j)]]]
 
primes = [n | n<-[2..], not $ elem n [j*k | j<-[2..n-1], k<-[2..min j (n`div`j)]]]
   
Line 141: Line 141:
 
primes = [n | n<-[2..], all ((> 0).rem n) [2..n-1]]
 
primes = [n | n<-[2..], all ((> 0).rem n) [2..n-1]]
 
primes = 2 : [n | n<-[3,5..], all ((> 0).rem n) [3,5..floor.sqrt$fromIntegral n]]
 
primes = 2 : [n | n<-[3,5..], all ((> 0).rem n) [3,5..floor.sqrt$fromIntegral n]]
  +
  +
primes = map (head . head) $ iterate (map tail . tail)
  +
$ scanl1 minus $ scanl1 (zipWith(+)) $ repeat [2..] -- APL-style
  +
primes = concat $ scanl (\a b-> dropWhile (<= last a) b) [2]
  +
$ map (\(x:xs)-> x:takeWhile (< x*x) xs)
  +
$ iterate (\(x:xs)-> minus xs [x*x, x*x+2*x..]) [3,5..]
   
 
primes = 2 : [n | n<-[3..], all ((> 0).rem n) $ takeWhile ((<= n).(^2)) primes]
 
primes = 2 : [n | n<-[3..], all ((> 0).rem n) $ takeWhile ((<= n).(^2)) primes]
Line 153: Line 159:
 
primesTo n = foldl (\r x-> r `minus` [x*x, x*x+2*x..]) (2:[3,5..n])
 
primesTo n = foldl (\r x-> r `minus` [x*x, x*x+2*x..]) (2:[3,5..n])
 
[3,5..floor.sqrt$fromIntegral n]
 
[3,5..floor.sqrt$fromIntegral n]
primesTo n = 2 : foldr (\r z-> if (head r^2) <= n then head r : z else r) []
+
primesTo n = 2 : foldr (\r z-> if (head r^2) <= n then head r : z else r) []
(fix $ \rs-> [3,5..n] : [t `minus` [p*p, p*p+2*p..] | (p:t)<- rs])
+
(iterate (\(p:t)-> minus t [p*p, p*p+2*p..]) [3,5..n])
   
 
primes = 2 : concat (unfoldr (\(xs,p:ps)-> let (h,t)=span (< p*p) xs in
 
primes = 2 : concat (unfoldr (\(xs,p:ps)-> let (h,t)=span (< p*p) xs in
 
Just (h, (filter ((> 0).(`rem`p)) t, ps))) ([3,5..],[3,5..]))
 
Just (h, (filter ((> 0).(`rem`p)) t, ps))) ([3,5..],[3,5..]))
 
primes = 2 : 3 : concat (unfoldr (\(xs,p:ps)-> let (h,t)=span (< p*p) xs in
 
primes = 2 : 3 : concat (unfoldr (\(xs,p:ps)-> let (h,t)=span (< p*p) xs in
Just (h, (t `minus` [p*p, p*p+2*p..], ps))) ([5,7..],tail primes))
+
Just (h, (t `minus` [p*p, p*p+2*p..], ps))) ([5,7..],tail primes))
   
primes = concatMap snd $ iterate (\((n, p:t@(q:_)),_) -> ((n+1,t),
+
primes = 2 : _Y (\ps-> concatMap snd $ iterate (\((fs:ft, x, p:t),_) ->
[x | let lst = take n $ tail primes, x <- [p*p+2, p*p+4 .. q*q-2],
+
((ft,p*p+2,t), [x | x <- [x, x+2 .. p*p-2],
all ((/= 0).rem x) $ lst])) ((1, tail primes), [2,3,5,7])
+
all ((/= 0).rem x) fs])) ((inits ps, 5, ps), [3]) )
   
primes = concatMap snd $ iterate (\((n, p2:t@(q2:_)),_) -> ((n+1,t),
+
primes = 2 : _Y (\ps-> concatMap snd $ iterate (\((fs:ft, x, p:t),_) ->
minus [p2+2, p2+4 .. q2-2] $ foldi union [] [ [o, o+2*i .. q2-1] |
+
((ft,p*p+2,t), minus [x, x+2 .. p*p-2]
i <- take n $ tail primes, let o=p2-rem (p2-i) (2*i)+2*i] ))
+
$ foldi union [] [[o, o+2*i .. p*p-2] | i <- fs,
((1, map (^2) $ tail primes), [2,3,5,7])
+
let o=x+mod(i-x)(2*i)])) ((inits ps, 5, ps), [3]) )
   
 
primes = let { sieve (x:xs) = x : sieve [n | n <- xs, rem n x > 0] } in sieve [2..]
 
primes = let { sieve (x:xs) = x : sieve [n | n <- xs, rem n x > 0] } in sieve [2..]
Line 188: Line 194:
 
</haskell>
 
</haskell>
   
<code>foldi</code> is an infinitely right-deepening tree folding function found [[Fold#Tree-like_folds|here]].
+
<code>foldi</code> is an infinitely right-deepening tree folding function found [[Fold#Tree-like_folds|here]]. <code>minus</code> of course is on the main page [[Prime_numbers#Initial_definition|here]].
   
 
[[Category:Code]]
 
[[Category:Code]]

Revision as of 22:18, 28 March 2014

For a context to this, please see Prime numbers.

Contents

1 Implicit Heap

The following is an original implicit heap implementation for the sieve of Eratosthenes, kept here for historical record. Also, it implements more sophisticated, lazier scheduling. The Prime_numbers#Tree merging with Wheel section simplifies it, removing the People a structure altogether, and improves upon it by using a folding tree structure better adjusted for primes processing, and a wheel optimization.

See also the message threads Re: "no-coding" functional data structures via lazyness for more about how merging ordered lists amounts to creating an implicit heap and Re: Code and Perf. Data for Prime Finders for an explanation of the People a structure that makes it work.

data People a = VIP a (People a) | Crowd [a]
 
mergeP :: Ord a => People a -> People a -> People a
mergeP (VIP x xt) ys                    = VIP x $ mergeP xt ys
mergeP (Crowd xs) (Crowd ys)            = Crowd $ merge  xs ys
mergeP xs@(Crowd (x:xt)) ys@(VIP y yt)  = case compare x y of
    LT -> VIP x $ mergeP (Crowd xt) ys
    EQ -> VIP x $ mergeP (Crowd xt) yt
    GT -> VIP y $ mergeP xs yt
 
merge :: Ord a => [a] -> [a] -> [a]
merge xs@(x:xt) ys@(y:yt) = case compare x y of
    LT -> x : merge xt ys
    EQ -> x : merge xt yt
    GT -> y : merge xs yt
 
diff xs@(x:xt) ys@(y:yt) = case compare x y of
    LT -> x : diff xt ys
    EQ ->     diff xt yt
    GT ->     diff xs yt
 
foldTree :: (a -> a -> a) -> [a] -> a
foldTree f ~(x:xs) = x `f` foldTree f (pairs xs)
    where pairs ~(x: ~(y:ys)) = f x y : pairs ys
 
primes, nonprimes :: [Integer]
primes    = 2:3:diff [5,7..] nonprimes
nonprimes = serve . foldTree mergeP . map multiples $ tail primes
    where
    multiples p = vip [p*p,p*p+2*p..]
 
    vip (x:xs)       = VIP x $ Crowd xs
    serve (VIP x xs) = x:serve xs
    serve (Crowd xs) = xs

nonprimes effectively implements a heap, exploiting lazy evaluation.

2 Prime Wheels

The idea of only testing odd numbers can be extended further. For instance, it is a useful fact that every prime number other than 2 and 3 must be of the form 6k + 1 or 6k + 5. Thus, we only need to test these numbers:

primes :: [Integer]
primes = 2:3:primes'
  where
    1:p:candidates = [6*k+r | k <- [0..], r <- [1,5]]
    primes'        = p : filter isPrime candidates
    isPrime n      = all (not . divides n)
                       $ takeWhile (\p -> p*p <= n) primes'
    divides n p    = n `mod` p == 0
Here,
primes'
is the list of primes greater than 3 and
isPrime
does not test for divisibility by 2 or 3 because the
candidates
by construction don't have these numbers as factors. We also need to exclude 1 from the candidates and mark the next one as prime to start the recursion.

Such a scheme to generate candidate numbers first that avoid a given set of primes as divisors is called a prime wheel. Imagine that you had a wheel of circumference 6 to be rolled along the number line. With spikes positioned 1 and 5 units around the circumference, rolling the wheel will prick holes exactly in those positions on the line whose numbers are not divisible by 2 and 3.

A wheel can be represented by its circumference and the spiked positions.

data Wheel = Wheel Integer [Integer]

We prick out numbers by rolling the wheel.

roll (Wheel n rs) = [n*k+r | k <- [0..], r <- rs]

The smallest wheel is the unit wheel with one spike, it will prick out every number.

w0 = Wheel 1 [1]
We can create a larger wheel by rolling a smaller wheel of circumference
n
along a rim of circumference
p*n
while excluding spike positions at multiples of
p
.
nextSize (Wheel n rs) p =
  Wheel (p*n) [r' | k <- [0..(p-1)], r <- rs,
                      let r' = n*k+r, r' `mod` p /= 0]
Combining both, we can make wheels that prick out numbers that avoid a given list
ds
of divisors.
mkWheel ds = foldl nextSize w0 ds

Now, we can generate prime numbers with a wheel that for instance avoids all multiples of 2, 3, 5 and 7.

primes :: [Integer]
primes = small ++ large
    where
    1:p:candidates = roll $ mkWheel small
    small          = [2,3,5,7]
    large          = p : filter isPrime candidates
    isPrime n      = all (not . divides n) 
                       $ takeWhile (\p -> p*p <= n) large
    divides n p    = n `mod` p == 0

It's a pretty big wheel with a circumference of 210 and allows us to calculate the first 10000 primes in convenient time.

A fixed size wheel is fine, but how about adapting the wheel size while generating prime numbers? See Euler's Sieve, or the functional pearl titled Lazy wheel sieves and spirals of primes for more.

3 Using IntSet for a traditional sieve

module Sieve where
import qualified Data.IntSet as I
 
-- findNext - finds the next member of an IntSet.
findNext c is | I.member c is = c
              | c > I.findMax is = error "Ooops. No next number in set."
              | otherwise = findNext (c+1) is
 
-- mark - delete all multiples of n from n*n to the end of the set
mark n is = is I.\\ (I.fromAscList (takeWhile (<=end) (map (n*) [n..])))
                where
                    end = I.findMax is
 
-- primes - gives all primes up to n 
primes n = worker 2 (I.fromAscList [2..n])
                where
                    worker x is 
                     | (x*x) > n = is
                     | otherwise = worker (findNext (x+1) is) (mark x is)

(doesn't look like it runs very efficiently).


4 One-liners

primes = [n | n<-[2..], not $ elem n [j*k | j<-[2..n-1], k<-[2..n-1]]]
primes = [n | n<-[2..], not $ elem n [j*k | j<-[2..n-1], k<-[2..min j (n`div`j)]]]
 
primes = nubBy (((>1).).gcd) [2..]
primes = [n | n<-[2..], all ((> 0).rem n) [2..n-1]]
primes = 2 : [n | n<-[3,5..], all ((> 0).rem n) [3,5..floor.sqrt$fromIntegral n]]
 
primes = map (head . head) $ iterate (map tail . tail) 
           $ scanl1 minus $ scanl1 (zipWith(+)) $ repeat [2..]  -- APL-style
primes = concat $ scanl (\a b-> dropWhile (<= last a) b) [2]
           $ map (\(x:xs)-> x:takeWhile (< x*x) xs) 
           $ iterate (\(x:xs)-> minus xs [x*x, x*x+2*x..]) [3,5..]
 
primes = 2 : [n | n<-[3..], all ((> 0).rem n) $ takeWhile ((<= n).(^2)) primes]
primes = 2 : 3 : [n | n<-[5,7..],
                      foldr (\p r-> p*p>n || (rem n p>0 && r)) True $ tail primes]
primes = 2 : fix (\xs-> 3 : [n | n<-[5,7..],
                      foldr (\p r-> p*p>n || (rem n p>0 && r)) True xs])
 
primes = map head $ iterate (\(x:xs)-> filter ((> 0).(`rem`x)) xs) [2..]
primes = 2 : unfoldr (\(x:xs)-> Just(x, filter ((> 0).(`rem`x)) xs)) [3,5..]
 
primesTo n = foldl (\r x-> r `minus` [x*x, x*x+2*x..]) (2:[3,5..n]) 
                                [3,5..floor.sqrt$fromIntegral n]
primesTo n = 2 : foldr (\r z-> if (head r^2) <= n then head r : z else r) [] 
                   (iterate (\(p:t)-> minus t [p*p, p*p+2*p..]) [3,5..n])
 
primes = 2 : concat (unfoldr (\(xs,p:ps)-> let (h,t)=span (< p*p) xs in 
                  Just (h, (filter ((> 0).(`rem`p)) t, ps))) ([3,5..],[3,5..]))
primes = 2 : 3 : concat (unfoldr (\(xs,p:ps)-> let (h,t)=span (< p*p) xs in 
                  Just (h, (t `minus` [p*p, p*p+2*p..], ps))) ([5,7..],tail primes))
 
primes = 2 : _Y (\ps-> concatMap snd $ iterate (\((fs:ft, x, p:t),_) ->       
                  ((ft,p*p+2,t), [x | x <- [x, x+2 .. p*p-2],
                   all ((/= 0).rem x) fs])) ((inits ps, 5, ps), [3]) ) 
 
primes = 2 : _Y (\ps-> concatMap snd $ iterate (\((fs:ft, x, p:t),_) ->       
                  ((ft,p*p+2,t),     minus [x, x+2 .. p*p-2] 
                   $ foldi union [] [[o, o+2*i .. p*p-2] | i <- fs, 
                   let o=x+mod(i-x)(2*i)])) ((inits ps, 5, ps), [3]) ) 
 
primes = let { sieve (x:xs) = x : sieve [n | n <- xs, rem n x > 0] } in sieve [2..] 
primes = let { sieve xs (p:ps) = let (h,t)=span (< p*p) xs in 
                                   h ++ sieve (filter ((> 0).(`rem`p)) t) ps } 
           in 2 : 3 : sieve [5,7..] (tail primes)
primes = let { sieve xs (p:ps) = let (h,t)=span (< p*p) xs in 
                                   h ++ sieve (t `minus` [p*p, p*p+2*p..]) ps } 
           in 2 : 3 : sieve [5,7..] (tail primes)
 
primes = 2 : minus [3..] (foldr (\(x:xs)->(x:).union xs) [] 
                              $ map (\x->[x*x, x*x+x..]) primes)
primes = 2 : minus [3,5..] (foldi (\(x:xs)->(x:).union xs) [] 
                              $ map (\x->[x*x, x*x+2*x..]) [3,5..])
primes = 2 : _Y ( (3:) . minus [5,7..]        -- unbounded Sieve of Eratosthenes
                          . foldi (\(x:xs) ys-> x:union xs ys) [] 
                              . map (\p->[p*p, p*p+2*p..]) )
_Y g = g (_Y g)

foldi is an infinitely right-deepening tree folding function found here. minus of course is on the main page here.