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

Submitted

{-# 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)