[Haskell-cafe] Another optimization question
anton muhin
antonmuhin at gmail.com
Sun May 18 12:09:40 EDT 2008
On Sat, May 17, 2008 at 10:40 PM, Daniel Fischer
<daniel.is.fischer at web.de> wrote:
> However, more than can be squished out of fiddling with these versions could
> be gained from a better algorithm.
Just for fun and there probably should be better implementation for
the same idea:
module Main where
data Tree a = Nil | Tree { el :: a, lft :: Tree a, rgt :: Tree a }
deriving (Eq, Ord, Show)
fromDistinctAscListN :: Int -> [a] -> ([a], Tree a)
fromDistinctAscListN 0 xs = (xs, Nil)
fromDistinctAscListN n xs = let ((e:xs'), l) = fromDistinctAscListN (n
- 1) xs in
let (xs'', r) = fromDistinctAscListN (n - 1) xs' in (xs'', Tree { el
= e, lft = l, rgt = r })
branch :: Ord a => a -> a -> (a -> b) -> (a -> b) -> (a -> b) -> b
branch x y lt eq gt = case (compare x y) of
LT -> lt x
EQ -> eq x
GT -> gt x
dispatch :: Ord a => a -> a -> (a -> Bool) -> (a -> Bool) -> Bool
dispatch x y lt gt = branch x y lt (const True) gt
member :: Ord a => a -> Tree a -> Bool
member _ Nil = False
member x t = dispatch x (el t) (`member` (lft t)) (`member` (rgt t))
type Forest a = [(a, Tree a)]
memberOfForest :: Ord a => a -> Forest a -> Bool
memberOfForest x ((y, t):fs) = dispatch x y (`member` t) (`memberOfForest` fs)
fromDistAscList :: [a] -> Forest a
fromDistAscList l = go 0 l where
go n xs = let ((x:xs'), t) = fromDistinctAscListN n xs in (x, t):go
(n + 1) xs'
primes :: [Int]
primes = [1..]
primes' = fromDistAscList primes
isPrime :: Int -> Bool
isPrime = (`memberOfForest` primes')
main = print $ length (filter isPrime [1..5000])
yours,
anton.
More information about the Haskell-Cafe
mailing list