Prime numbers miscellaneous

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

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

data Wheel = Wheel Integer [Integer]

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

w0 = Wheel 1 [1]

nextSize (Wheel n rs) p =
  Wheel (p*n) [r' | k <- [0..(p-1)], r <- rs,
                      let r' = n*k+r, r' `mod` p /= 0]

mkWheel ds = foldl nextSize w0 ds

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

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)

primes = [n | n<-[2..], not $ elem n [j*k | j<-[2..n-1], k<-[2..min j (n`div`j)]]]
 
primes = nubBy (((==0).).rem) [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 = 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) []  
                   (fix $ \rs-> [3,5..n] : [t `minus` [p*p, p*p+2*p..] | (p:t)<- rs])
 
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 = 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 : fix ( (3:) . minus [5,7..]        -- unbounded Sieve of Eratosthenes
                          . foldi (\(x:xs) ys-> x:union xs ys) [] 
                              . map (\p->[p*p, p*p+2*p..]) )