[Haskell-cafe] Re: Progress on shootout entries
Jan-Willem Maessen
jmaessen at alum.mit.edu
Tue Jan 3 22:07:02 EST 2006
I was surprised to learn that indexed insertion:
permutations (x:xs) =
[insertAt n x perms | perms <- permutations xs,
n <- [0..length xs] ]
insertAt :: Int -> a -> [a] -> [a]
insertAt 0 y xs = y:xs
insertAt n y (x:xs) = x:(insertAt (n-1) y xs)
was faster than the usual version of permutation based on "inserts":
permutations (x:xs) =
[insertAt n x perms | perms <- permutations xs,
n <- [0..length xs] ]
insertAt 0 y xs = y:xs
insertAt n y (x:xs) = x:(insertAt (n-1) y xs)
However, try these on for size. The non-strict "flop", which
traverses its input exactly once, is the most surprising and made by
far the biggest difference:
findmax :: [[Int]] -> Int
findmax xss = fm xss 0
where fm [] mx = mx
fm (p:ps) mx = fm ps $! (countFlops p `max` mx)
countFlops :: [Int] -> Int
countFlops as = cf as 0
where cf (1:_) flops = flops
cf xs@(x:_) flops = cf (flop x xs) $! (flops+1)
flop :: Int -> [Int] -> [Int]
flop n xs = rs
where (rs,ys) = fl n xs ys
fl 0 xs ys = (ys, xs)
fl n (x:xs) ys = fl (n-1) xs (x:ys)
On Jan 3, 2006, at 8:01 PM, Kimberley Burchett wrote:
> I took a quick crack at optimizing fannkuch.hs. I got it down from
> 33s to 1.25s on my machine, with N=9. That should put it between
> forth and ocaml(bytecode) in the shootout page. The main changes I
> made were using Int instead of Int8, foldl' to accumulate the max
> number of folds, a custom flop function rather than a combination
> of reverse and splitAt, and a simpler definition for permutations.
>
> http://kimbly.com/code/fannkuch.hs
>
> Kimberley Burchett
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list