Haskell 中 Sundaram 的高效 (O(n^2)) 筛

Question

There are many answers on SO explaining how to implement the Sieve of Sundaram in Haskell but they're all... really inefficient?

All solutions that I have seen work like this:

1. Figure out the numbers <= n to exclude
2. Filter these from [1..n]
3. Modify the remaining numbers * 2 + 1

Here for example is my implementation that finds all primes between 1 and 2n+2 :

sieveSundaram :: Integer -> [Integer]
sieveSundaram n = map (\x -> 2 * x + 1) $ filter (flip notElem toRemove) [1..n]
  where toRemove = [i + j + 2*i*j | i <- [1..n], j <- [i..n], i + j + 2*i*j <= n]

The problem I have with this, is that filter has to traverse the entire toRemove list for every element of [1..n] and thus this has complexity O(n^3) whereas a straightforward iterative implementation has complexity O(n^2). How can I achieve that in Haskell?

Answer 1

As per the comments, base should not be considered a complete standard library for Haskell. There are several key packages that every Haskell developer knows and uses and would consider part of Haskell's de facto standard library.

By "straightforward iterative implementation", I assume you mean marking and sweeping an array of flags? It would be usual to use a Vector or Array for this. (Both would be considered "standard".) An O(n^2) Vector solution looks like the following. Though it internally uses a mutable vector, the bulk update operator (//) hides this fact, so you can write it in a typical Haskell immutable and stateless style:

import qualified Data.Vector as V

primesV :: Int -> [Int]
primesV n = V.toList                           -- the primes!
  . V.map (\x -> (x+1)*2+1)                    -- apply transformation
  . V.findIndices id                           -- get remaining indices
  . (V.// [(k - 1, False) | k <- removals n])  -- scratch removals
  $ V.replicate n True                         -- everyone's allowed

removals n = [i + j + 2*i*j | i <- [1..n], j <- [i..n], i + j + 2*i*j <= n]

Another possibility that's a little more straightforward is IntSet which is basically a set of integers with O(1) insertion/deletion and O(n) ordered traversal. (This is like the HashSet suggested in the comments, but specialized to integers.) This is in the containers packages, another "standard" package that's actually bundled with the GHC source, even though it's distinct from base . It gives an O(n^2) solution that looks like:

import qualified Data.IntSet as I

primesI :: Int -> [Int]
primesI n = I.toAscList               -- the primes!
  . I.map (\x -> x*2+1)               -- apply transformation
  $ I.fromList [1..n]                 -- integers 1..n ...
    I.\\ I.fromList (removals n)      -- ... except removals

Note that another important performance improvement is to use a better removals definition that avoids filtering all n^2 combinations. I believe the following definition produces the same list of removals:

removals :: Int -> [Int]
removals n = [i + j + 2*i*j | j <- [1..(n-1) `div` 3], i <- [1..(n-j) `div` (1+2*j)]]

and does so in what I believe is O(n log(n)). If you use it with either primesV or primesI above, it's the bottleneck, so the resulting overall algorithm should be O(n log(n)), I think.

Answer 2

The question doesn't define what is meant by inefficient. The OP seems to be hung up on using a Haskell Lazy List solution, and that will be inefficient from the outset, as operations on lists are sequential and have a high constant overhead in requiring a memory allocation per element containing many "plumbing" parts internally to implement possible laziness.

As I mentioned in the comments, the original definition of the Sieve of Sundaram is obscure and includes many redundant operations due to oversubscribing the ranges representing odd numbers; it can be greatly simplified as described there.

However, even after minimizing the SoS's inefficiencies and if using List's is the way one wants to go: as the OP identifies, simple repeated filtering across the list isn't efficient because there will be many repeated operations per List element as per the following revised OP's code:

sieveSundaram :: Int -> [Int]
sieveSundaram n = map (\x -> 2 * x + 3) $ filter (flip notElem toRemove) [ 0 .. lmt ]
  where lmt = (n - 3) `div` 2
        sqrtlmt = (floor(sqrt(fromIntegral n)) - 3) `div` 2
        mkstrtibp i = ((i + i) * (i + 3) + 3, i + i + 3)
        toRemove = concat [ let (si, bp) = mkstrtibp i in [ si, si + bp .. lmt ]
                            | i <- [ 0 .. sqrtlmt ] ]

main :: IO ()
main = print $ sieveSundaram 1000

As there are O(n log n) values in the improved concatenated toRemove list and all of them must be scanned for all of the odd values to the sieving limit, the asymptotic complexity of this is O(n^2 log n) , which answers the question but isn't very good.

The fastest List prime filtering technique is to lazily merge the tree of generated composite culling lists (instead of just concatenating it) and then generate an output list of all the odd numbers that aren't in the merged composites ( in increasing order so as to avoid scanning the whole list every time). This isn't so efficient using a linear merge, but we can use a infinite tree-like merge that will only cost an extra factor of log n , which when multiplied by the O(n log n) complexity of the number of cull values of the correct Sieve of Sundaram gives a combined complexity of O(n log^2 n) , which is considerably less than the previous implementation.

This merging works because each successive composite culling List starts from the square of the last odd number increased by two, so the first values of the culling sequence List's for each base value in the overall List of List's are already in increasing order; thus, simple merge sorting of the List of List's doesn't race and is quite easy to implement:

primesSoS :: () -> [Int]   
primesSoS() = 2 : sel 3 (_U $ map(\n -> [n * n, n * n + n + n..]) [ 3, 5.. ]) where
  sel k s@(c:cs) | k < c     = k : sel (k+2) s  -- ~= ([k, k + 2..] \\ s)
                 | otherwise =     sel (k+2) cs --      when null(s\\[k, k + 2..]) 
  _U ((x:xs):t) = x : (merge xs . _U . pairs) t -- tree-shaped folding big union
  pairs (xs:ys:t) = merge xs ys : pairs t
  merge xs@(x:xs') ys@(y:ys') | x < y     = x : merge xs' ys
                              | y < x     = y : merge xs  ys'
                              | otherwise = x : merge xs' ys'

cLIMIT :: Int
cLIMIT = 1000

main :: IO ()
main = print $ takeWhile (<= cLIMIT) $ primesSoS()

Of course, one must ask the question "Why the Sieve of Sundaram?" as when the cruft of the original SoS formulation is removed ( see the Wikipedia article ), it becomes obvious that that only difference between the SoS and the Odds-Only Sieve of Eratosthenes is that the SoS doesn't filter the base culling odd numbers for only those that are prime as the Odds-Only SoE does. The following code does the recursive feed back of only the found base primes:

primesSoE :: () -> [Int]   
primesSoE() = 2 : _Y ((3:) . sel 5 . _U . map (\n -> [n * n, n * n + n + n..])) where
  _Y g = g (_Y g)  -- = g (g (g ( ... )))   non-sharing multistage fixpoint combinator
  sel k s@(c:cs) | k < c     = k : sel (k+2) s  -- ~= ([k, k + 2..] \\ s)
                 | otherwise =     sel (k+2) cs --      when null(s\\[k, k + 2..]) 
  _U ((x:xs):t) = x : (merge xs . _U . pairs) t -- tree-shaped folding big union
  pairs (xs:ys:t) = merge xs ys : pairs t
  merge xs@(x:xs') ys@(y:ys') | x < y     = x : merge xs' ys
                              | y < x     = y : merge xs  ys'
                              | otherwise = x : merge xs' ys'

cLIMIT :: Int
cLIMIT = 1000

main :: IO ()
main = print $ takeWhile (<= cLIMIT) $ primesSoE()

The fixpoint _Y combinator takes care of the recursion and the rest is identical. This version reduces the complexity by one log n factor so now the asymptotic complexity is O(n log n log log n) .

If one really wants efficiency, one doesn't use List's but rather mutable arrays. The following code implements the SoS to a fixed range using a built-in bit-packed array:

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.ST ( runST )
import Data.Array.Base ( newArray, unsafeWrite, unsafeFreezeSTUArray, assocs )

primesSoSTo :: Int -> [Int] -- generate a list of primes to given limit...
primesSoSTo limit
  | limit < 2 = []
  | otherwise = runST $ do
      let lmt = (limit - 3) `div` 2 -- limit index!
      oddcmpsts <- newArray (0, lmt) False -- indexed true is composite
      let getbpndx i = (i + i + 3, (i + i) * (i + 3) + 3) -- index -> bp, si0
          cullcmpst i = unsafeWrite oddcmpsts i True -- cull composite by index
          cull4bpndx (bp, si0) = mapM_ cullcmpst [ si0, si0 + bp .. lmt ]
      mapM_ cull4bpndx
            $ takeWhile ((>=) lmt . snd) -- for bp's <= square root limit
                        [ getbpndx i | i <- [ 0.. ] ] -- all odds!
      oddcmpstsf <- unsafeFreezeSTUArray oddcmpsts -- frozen in place!
      return $ 2 : [ i + i + 3 | (i, False) <- assocs oddcmpstsf ]

cLIMIT :: Int
cLIMIT = 1000

main :: IO ()
main = print $ primesSoSTo cLIMIT

with asymptotic complexity of O(n log n) and the following code does the same for the Odds-Only SoE:

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.ST ( runST )
import Data.Array.Base ( newArray, unsafeWrite, unsafeFreezeSTUArray, assocs )

primesSoETo :: Int -> [Int] -- generate a list of primes to given limit...
primesSoETo limit
  | limit < 2 = []
  | otherwise = runST $ do
      let lmt = (limit - 3) `div` 2 -- limit index!
      oddcmpsts <- newArray (0, lmt) False -- when indexed is true is composite
      oddcmpstsf <- unsafeFreezeSTUArray oddcmpsts -- frozen in place!
      let getbpndx i = (i + i + 3, (i + i) * (i + 3) + 3) -- index -> bp, si0
          cullcmpst i = unsafeWrite oddcmpsts i True -- cull composite by index
          cull4bpndx (bp, si0) = mapM_ cullcmpst [ si0, si0 + bp .. lmt ]
      mapM_ cull4bpndx
            $ takeWhile ((>=) lmt . snd) -- for bp's <= square root limit
                        [ getbpndx i | (i, False) <- assocs oddcmpstsf ]
      return $ 2 : [ i + i + 3 | (i, False) <- assocs oddcmpstsf ]

cLIMIT :: Int
cLIMIT = 1000

main :: IO ()
main = print $ primesSoETo cLIMIT

with asymptotic efficiency of O(n log log n) .

Both of these last versions are perhaps a hundred times times faster than their List equivalents due to reduced constant factor execution time in mutable array operations rather than list operations as well as the reduction of a log n factor in the asymptotic complexity.