Boolean Primes Map (continued)

Shlomi Fish shlomif@vipe.technion.ac.il
Fri, 22 Dec 2000 05:58:56 +0200 (IST)


Well, after some thought, I decided to try re-writing the boolean primes
map program only using a list instead of an array. I came up with this
program:


primes :: Int -> [Int]
primes how_much =  (iterate 2 initial_map) where
	initial_map :: [Bool]
	initial_map = (map (\x -> True) [ 0 .. how_much])
	iterate :: Int -> [Bool] -> [Int]
	iterate p (a:as) | p > mybound = process_map p (a:as)
	                 | a = p:(iterate (p+1) (mymark (p+1) step (2*p) as))
	                 | (not a) = (iterate (p+1) as) where
	                 	step :: Int
	                 	step = if p == 2 then p else 2*p
        mymark :: Int -> Int -> Int -> [Bool] -> [Bool]
        mymark cur_pos step next_pos [] = []
        mymark cur_pos step next_pos (a:as) = 
        	if (cur_pos == next_pos) then
        		False:(mymark (cur_pos+1) step (cur_pos+step) as)
        	else
        		a:(mymark (cur_pos+1) step next_pos as)
	mybound :: Int
	mybound = ceiling(sqrt(fromIntegral(how_much)))
	process_map :: Int -> [Bool] -> [Int]
	process_map cur_pos [] = []
	process_map cur_pos (a:as) | a = cur_pos:(process_map (cur_pos+1) as)
	                           | (not a) = (process_map (cur_pos+1) as)
					
I don't know too much about Haskell yet, so it is possible this program
can be further optimized using some Haskell built-ins.

Now, this program can scale to 100,000 and beyond, as opposed to the array
version which only got until 30,000 or 40,000. It's a pity Haskell doesn't
handle arrays very well, but I guess every language has its faults.

Regards,

	Shlomi Fish


----------------------------------------------------------------------
Shlomi Fish        shlomif@vipe.technion.ac.il 
Home Page:         http://t2.technion.ac.il/~shlomif/
Home E-mail:       shlomif@techie.com

The prefix "God Said" has the extraordinary logical property of 
converting any statement that follows it into a true one.