Personal tools

Shootout/Recursive

From HaskellWiki

< Shootout(Difference between revisions)
Jump to: navigation, search
(Proposed entry)
(Proposed entry)
Line 41: Line 41:
   
 
<haskell>
 
<haskell>
{-# OPTIONS -O -fglasgow-exts -fbang-patterns -funbox-strict-fields -fexcess-precision -optc-O2 -optc-march=pentium4 -optc-mfpmath=sse -optc-msse2 #-}
+
{-# OPTIONS -fexcess-precision #-}
 
--
 
--
 
-- The Computer Language Shootout
 
-- The Computer Language Shootout
Line 47: Line 47:
 
--
 
--
 
-- Translated from the Clean by Don Stewart
 
-- Translated from the Clean by Don Stewart
  +
--
  +
-- Should be compiled with:
  +
-- -O -fglasgow-exts -optc-march=pentium4
  +
-- -optc-O2 -optc-mfpmath=sse -optc-msse2
 
--
 
--
   
Line 78: Line 82:
 
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
 
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
 
</haskell>
 
</haskell>
 
   
 
== Current entry ==
 
== Current entry ==

Revision as of 04:53, 10 February 2007

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.

Contents

1 Benchmarks

Debian/Linux x86, N=11 ||Entry||Time|| ||Current || 4.948 || ||Unboxed || 4.785 ||

2 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

3 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

4 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)

5 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)