Shootout/Recursive
A ShootoutEntry for the recursive benchmark
The spec is as follows:
Each program should use the same nave recursive-algorithms to calculate
3 simple numeric functions: ackermann, fibonnaci and tak.
Ack(x,y)
x = 0 = y+1
y = 0 = Ack(x-1,1)
otherwise = Ack(x-1, Ack(x,y-1))
Fib(n)
n < 2 = 1
otherwise = Fib(n-2) + Fib(n-1)
Tak(x,y,z)
y < x = Tak(Tak(x-1.0,y,z),Tak(y-1.0,z,x),Tak(z-1.0,x,y))
otherwise = z
For this benchmark, the fibonnaci and tak implementations should either
provide separate functions - one for integer calculation and one for
double calculation - or provide a function that uses integer calculation
with integer parameters and double calculation with double parameters.
So the trick is that we need to be polymorphic on Double and Int for fib and tak.
Benchmarks
Debian/Linux x86, N=11
Entry | Time |
Current | 4.948 |
Unboxed | 4.785 |
Proposed entry
Fixes gcc.
{-# OPTIONS -fexcess-precision #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Translated from the Clean by Don Stewart
--
-- Should be compiled with:
-- -O -fglasgow-exts -optc-march=pentium4
-- -optc-O2 -optc-mfpmath=sse -optc-msse2
--
import System
import Numeric
main = do
n <- getArgs >>= readIO . head
let m = n-1
a = 27 + fromIntegral n
putStr $
line "Ack" [3,n] (ack 3 n) show ++
line "Fib" [a] (fib a :: Double) (\n -> showFFloat (Just 1) n []) ++
line "Tak" [3*m,2*m,m] (tak (3*m) (2*m) m :: Int) show ++
line "Fib" [3] (fib 3 :: Int) show ++
line "Tak" [3,2,1] (tak 3 2 1 :: Double) show
where
line pre a r f = pre ++ "(" ++ csv f a "" ++ "): " ++ f r ++ "\n"
csv f [a] s = s ++ f a
csv f (a:b) s = s ++ f a ++ "," ++ csv f b s
ack :: Int -> Int -> Int
ack 0 n = n+1
ack m 0 = ack (m-1) 1
ack m n = ack (m-1) (ack m (n-1))
fib :: (Num a, Ord a) => a -> a
fib n = if n >= 2 then fib (n-1) + fib (n-2) else 1
tak :: (Num a, Ord a) => a -> a -> a -> a
tak x y z = if y < x then tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y) else z
Current entry
{-# OPTIONS -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Translated from the Clean by Don Stewart
--
import System
import Numeric
main = do
n <- getArgs >>= readIO . head
let m = n-1
a = 27 + fromIntegral n
putStr $
line "Ack" [3,n] (ack 3 n) show ++
line "Fib" [a] (fib a :: Double) (\n -> showFFloat (Just 1) n []) ++
line "Tak" [3*m,2*m,m] (tak (3*m) (2*m) m :: Int) show ++
line "Fib" [3] (fib 3 :: Int) show ++
line "Tak" [3,2,1] (tak 3 2 1 :: Double) show
where
line pre a r f = pre ++ "(" ++ csv f a "" ++ "): " ++ f r ++ "\n"
csv f [a] s = s ++ f a
csv f (a:b) s = s ++ f a ++ "," ++ csv f b s
ack :: Int -> Int -> Int
ack 0 n = n+1
ack m 0 = ack (m-1) 1
ack m n = ack (m-1) (ack m (n-1))
fib :: (Num a, Ord a) => a -> a
fib n = if n >= 2 then fib (n-1) + fib (n-2) else 1
tak :: (Num a, Ord a) => a -> a -> a -> a
tak x y z = if y < x then tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y) else z
Old entry
I didn't think the code was fast enough. Careful inspection of the Core revealed some funny constructs. So I rewrote the heavily called loops the way I wanted them. Result, around 5% faster.
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Haskell Wiki page for Shootout entries - http://haskell.org/hawiki/ShootoutEntry
-- Contributed by Don Stewart
--
-- Compilation:
-- ghc -o d D.hs -O2 -fexcess-precision -optc-O3 -optc-ffast-math -fglasgow-exts
-- -fexcess-precision is important. ack and fibr have been carefully unboxed.
--
import System; import Text.Printf; import GHC.Exts
main = do (n@(I# i),a@(D# d)) <- getArgs >>= readIO . head >>= \n -> return (n,27+fromIntegral n)
let (m3,m2,m) = (m*3, m*2, n-1)
putStrLn $ "Ack(3," ++ show n ++ "): " ++ show (I# (ack 3# i))
printf "Fib(%f): %f\n" a (D# (fibr d))
putStrLn $ "Tak("++show m3++","++show m2++","++show m++"): "++
show (tak m3 m2 m)
putStrLn $ "Fib(3): " ++ show (fib 3 :: Int)
putStrLn $ "Tak(3.0,2.0,1.0): " ++ show (tak 3 2 1 :: Double)
ack x y = if x ==# 0# then y +# 1# else ack (x -# 1#) (if y ==# 0# then 1# else ack x (y -# 1#))
fib n = if n < 2 then 1 else fib (n-2) + fib (n-1)
fibr n = if n <## 2.0## then 1.0## else fibr (n -## 2.0##) +## (fibr (n-## 1.0##))
tak x y z = if y >= x then z else tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y)
Current entry
Currently ranked: [(cpu, 6th), (mem, 4th), (loc, 1st)]
Taken from existing ackermann and takfp entries, with a standard fib. -O2 -optc-O3 -fexcess-precision
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Based on code contributed by:
-- Bryn Keller, Don Stewart, Einar Karttunen and Greg Buchholz
--
-- ghc -o d D.hs -O2 -optc-O3 -fexcess-precision
--
-- -fexcess-precision is important
--
-- fib and tak are polymorphic in their arguments. The type signatures ensure
-- that arguments and result types match, as per the spec.
--
import System; import Text.Printf
main = do (n,m,a) <- getArgs >>= readIO . head >>= \n -> return (n,n-1,27 + fromIntegral n)
let (m3,m2) = (m*3, m*2)
putStrLn $ "Ack(3," ++ show n ++ "): " ++ show (ack 3 n)
printf "Fib(%f): %f\n" a (fib a :: Double)
putStrLn $ "Tak("++show m3++","++show m2++","++show m++"): "++show (tak m3 m2 m :: Int)
putStrLn $ "Fib(3): " ++ show (fib 3 :: Int)
putStrLn $ "Tak(3.0,2.0,1.0): " ++ show (tak 3.0 2.0 1.0 :: Double)
ack :: Int -> Int -> Int
ack 0 y = y+1
ack x y = ack (x-1) $ if y == 0 then 1 else ack x (y-1)
fib :: (Ord a, Num a) => a -> a
fib n = if n < 2 then 1 else fib (n-2) + fib (n-1)
tak x y z = if y >= x then z else tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y)