[Haskell-cafe] Progress on shootout entries

[Chris Kuklewicz]

Krasimir Angelov wrote:
> 2006/1/3, Chris Kuklewicz <haskell at list.mightyreason.com>:
> 
>> And finially, the haskel entry for
>>http://shootout.alioth.debian.org/benchmark.php?test=fannkuch&lang=all
>> is currently the *slowest* entry out of 28 languages.  It is 813x
>>slower than the c-code, 500x slower than OCaml.  Should be easy to make
>>it faster...
> 
> 
> In this particular case the flop function is very slow.
> 
> flop :: Int8 -> [Int8] -> Int8
> flop acc (1:xs) = acc
> flop acc list@(x:xs) = flop (acc+1) mangle
>     where   mangle = (reverse front) ++ back
>             (front,back) = splitAt (fromIntegral x) list
> 
> 
> It can be optimized using a new mangle function:
> 
> mangle :: Int -> [a] -> [a]
> mangle m xs = xs'
>   where
>     (rs,xs') = splitAt m xs rs
> 
>     splitAt :: Int -> [a] -> [a] -> ([a], [a])
>     splitAt 0    xs  ys = (xs,ys)
>     splitAt _    []  ys = ([],ys)
>     splitAt m (x:xs) ys = splitAt (m - 1) xs (x:ys)
> 
> The mangle function transforms the list in one step while the original
> implementation is using reverse, (++) and splitAt. With this function
> the new flop is:
> 
> flop :: Int8 -> [Int8] -> Int8
> flop acc (1:xs) = acc
> flop acc list@(x:xs) = flop (acc+1) (mangle (fromIntegral x) list)

You seem to have also discovered the fast way to flop.

This benchmarks exactly as fast as the similar entry assembled by
Bertram Felgenhauer using Jan-Willem Maessen's flop code:

> import System (getArgs)
> import Data.List (foldl', tails)
> 
> rotate n (x:xs) = rot' n xs where
>     rot' 1 xs     = x:xs
>     rot' n (x:xs) = x:rot' (n-1) xs
> 
> permutations l = foldr perm' [l] [2..length l] where
>     perm' n l = l >>= take n . iterate (rotate n)
> 
> 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)
> 
> steps :: Int -> [Int] -> Int
> steps n (1:_)    = n
> steps n ts@(t:_) = (steps $! (n+1)) (flop t ts)
> 
> main = do
>     args <- getArgs
>     let arg = if null args then 7 else read $ head args
>     mapM_ (putStrLn . concatMap show) $ take 30 $ permutations [1..arg]
>     putStr $ "Pfannkuchen(" ++ show arg ++ ") = "
>     putStrLn $ show $ foldl' (flip (max . steps 0)) 0 $ permutations [1..arg]

[ This is on the wiki, and is 80-90 times faster than the old entry ]

I have not been able to make this run any faster by tweaking it.  It is
easily one of the nicest lazy Haskell-idiom entries on the whole
shootout.  It does not have to use IO or ST or unboxed anything or even
arrays to perform well in small space.

* Replacing the foldl' with the more legible foldl' max 0 $ map (steps
0) is a very very tiny speed loss
* Going to Word8 instead of Int does not improve speed or save space
* Using Control.Monad.fix explicitly is speed neutral:
> flopF :: Int -> [Int] -> [Int]
> flopF n xs = fst $ fix (flop' n xs) where
>  -- flop' :: Int -> [Int] -> ([Int],[Int]) -> ([Int],[Int])
>     flop' 0 xs     ~(_,ys) = (ys,xs)
>     flop' n (x:xs) ~(rs,ys) = flop' (n-1) xs (rs,(x:ys))

-- 
Chris