{-# OPTIONS_GHC -O2 -fno-cse #-}
data People a = VIP a (People a) | Crowd [a]
primes = 2:3:5:7: gaps 11 wheel (join $ roll 11 wheel primes')
where
primes' = 11:
13:
17:
19:
23:
29:
31: gaps
37 (drop 7 wheel
) (join $ roll 11 wheel primes')
gaps k (w:t) cs@(VIP c u) | k==c = gaps (k+w) t u
| True = k : gaps (k+w) t cs -- k<c
roll k ws@(w:t) ps@(p:u) | k==p = vips (scanl (\c d->c+p*d) (p*p) ws)
: roll (k+w) t u
| True = roll (k+w) t ps -- k<p
join (xs:ys:zs:t) = unionP xs (unionP ys zs) -- ~(ys:zs:t) w/VIPs causes memory leak
`unionP` join (pairs t) -- strict pat must have more defined primes'
pairs (xs:ys:t) = unionP xs ys : pairs t
wheel = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2:
4:8:6:4:6:2:4:6:2:6:6:4:2:4:6:2:6:4:2:4:2:10:2:10:wheel
union a
@(x:xs
) b
@(y:ys
) = case compare x y
of LT -> x: union xs b
EQ -> x: union xs ys
GT -> y: union a ys
vips (x:t) = VIP x $ Crowd t
unionP
:: Ord a
=> People a
-> People a
-> People a
unionP (VIP x t) ys = VIP x $ unionP t ys
unionP (Crowd xs) (Crowd ys) = Crowd $ union xs ys
unionP xs
@(Crowd
(x:t
)) ys
@(VIP y w
) = case compare x y
of LT -> VIP x $ unionP (Crowd t) ys
EQ -> VIP x $ unionP (Crowd t) w
GT -> VIP y $ unionP xs w
{-
Tree Merged Multiples Re-moval: O(n^1.24) speed, O(1) space:
--- simple_tfold ---- two-feed ------ wheel ------ 3/2 tfold -- gaps/roll
1M 4.09s _47.8MB -- 3.28s 4.7MB -- 1.95s 5.8MB -- 1.90s 4.8MB -- 1.38s ---
2M 9.86s 111.2MB -- 7.66s 4.7MB -- 4.68s 5.8MB -- 4.48s 4.8MB -- 3.25s ---
3M ------------------------------------------------------------- 5.40s ---
4M 7.66-4.7
5M 10.16-4.7
6M 12.71-4.7
********
vips/minus vips~gaps vips/gaps
1M 1.95-4.8 1.41-5.8 1.46-4.8
2M 4.53-4.8 3.51-10.9 3.36-4.8
3M 7.45-4.8 5.70-12.9 5.55-4.8
4M 10.71-4.8 7.92-4.8
5M 13.98-4.8 10.40-4.8
6M 12.99-4.8
-}