[Haskell-cafe] Re: FASTER primes
Will Ness
will_n48 at yahoo.com
Fri Jan 8 13:45:47 EST 2010
Daniel Fischer <daniel.is.fischer <at> web.de> writes:
>
>
> The below code is now a well-behaved memory citizen (3MB for the 100
millionth prime, about the same as the PQ code). It still is considerably
slower than the PQ code.
> In terms of MUT times as reported by +RTS -sstderr - as well as (MUT+GC)
times - (measured once for prime No. 5*10^5, 10^6, 2*10^6, 4*10^6, 10^7 to get
a rough tendency), it seems to scale a wee bit better than any of the other
tfold versions I created, but a little worse than the PQ versions.
> The relation of MUT times isn't too bad, but the GC times are rather abysmal
(30-40%).
>
> ----------------------------------------------------------------------
> data People a = P { vips :: [a], dorks :: [a] }
>
> celebrate :: a -> People a -> People a
> celebrate x p = P (x:vips p) (dorks p)
>
> primes :: forall a. Integral a => () -> [a]
> primes () = 2:3:5:7:11:13:primes'
> where
> primes' = roll 17 wheel13 `minus` compos primes'''
primes'' = 17:19:23:29:31:rollFrom 37 `minus` compos primes''
> primes''' = 17:19:23:29:31:37:rollFrom 41 `minus` compos primes''
>
> pmults :: a -> People a
> pmults p = case map (*p) (rollFrom p) of
> (x:xs) -> P [x] xs
>
> multip :: [a] -> [People a]
> multip ps = map pmults ps
>
> compos :: [a] -> [a]
compos = vips . smartfold mergeSP . multip
>
>
> smartfold f = tfold f . pairwise f
>
> tfold f (a:b:c:xs) = (a `f` (b `f` c)) `f` smartfold f xs
>
> pairwise f (x:y:ys) = f x y : pairwise f ys
>
> mergeSP :: Integral a => People a -> People a -> People a
> mergeSP p1@(P a _) p2 = P (a ++ vips mrgd) (dorks mrgd)
> where
> mrgd = spMerge (dorks p1) (vips p2) (dorks p2)
> spMerge l1 [] l3 = P [] (merge l1 l3)
> spMerge ~l1@(x:xs) l2@(y:ys) l3 = case compare x y of
> LT -> celebrate x (spMerge xs l2 l3)
> EQ -> celebrate x (spMerge xs ys l3)
> GT -> celebrate y (spMerge l1 ys l3)
>
> ----------------------------------------------------------------------
>
Hi Daniel,
Is it so that you went back to my fold structure? Was it better for really big
numbers of primes?
I had the following for ages (well, at least two weeks) but I thought it was
slower and took more memory (that was _before_ the 'no-share' and 'feeder'
stuff). I can see the only difference in that you've re-written spMerge in a
tail-recursive style with explicitly deconstructed parts; mine was relying on
the compiler (8-L) to de-couple the two pipes and recognize that the second
just passes along the final result, unchanged.
The two versions seem to me to be _exactly_ operationally equivalent. All this
searching for the code better understood by the compiler is _*very*_
frustrating, as it doesn't reflect on the semantics of the code, or even the
operational semantics of the code. :-[
Weren't the P's supposed to disappear completely in the compiled code? Aren't
types just a _behavioral_ definitions??? Aren't we supposed to be able to
substitute equals for equals dammit??
Is this the state of our _best_ Haskell compiler????
module Primes8 where
import Data.Monoid
data (Ord a) => SplitList a = P [a] [a]
instance (Ord a) => Monoid (SplitList a) where
mempty = P [] []
-- {x | x::SplitList a} form a monoid under mappend
mappend (P a b) ~(P c d) = let P bc b' = spMerge b c
in P (a ++ bc) (merge b' d)
where
spMerge :: (Ord a) => [a] -> [a] -> SplitList a
spMerge u@(x:xs) w@(y:ys) = case compare x y of
LT -> P (x:c) d where (P c d) = spMerge xs w
EQ -> P (x:c) d where (P c d) = spMerge xs ys
GT -> P (y:c) d where (P c d) = spMerge u ys
spMerge u [] = P [] u
spMerge [] w = P [] w
mconcat ms = fold mappend (pairwise mappend ms)
where
fold f (a: ~(b: ~(c:xs)))
= (a `f` (b `f` c)) `f` fold f (pairwise f xs)
pairwise f (x:y:ys) = f x y:pairwise f ys
primes :: Integral a => () -> [a]
primes () = 2:3:5:7:primes'
where
primes' = [11,13] ++ drop 2 (rollFrom 11) `minus` comps
mults = map (\p-> P [p*p] [p*n | n<- tail $ rollFrom p]) $ primes'
P comps _ = mconcat mults
More information about the Haskell-Cafe
mailing list