Difference between revisions of "Shootout/Binary trees"

From HaskellWiki
Jump to: navigation, search
m (category)
(Current)
Line 3: Line 3:
 
Port the Clean entry.
 
Port the Clean entry.
   
== Current ==
+
== Proposed entry ==
  +
  +
Ported to ghc 6.6
  +
  +
<haskell>
  +
{-# OPTIONS -fbang-patterns #-}
  +
  +
--
  +
-- The Great Computer Language Shootout
  +
-- http://shootout.alioth.debian.org/
  +
--
  +
-- Simon Marlow
  +
-- Rewritten by Don Stewart
  +
--
  +
  +
import System
  +
import Data.Bits
  +
import Text.Printf
  +
  +
data Tree = Nil | Node !Int Tree Tree
  +
  +
minDepth = 4
  +
  +
io s n t = printf "%s of depth %d\t check: %d\n" s n t
  +
  +
main = do
  +
maxDepth <- getArgs >>= return . max (minDepth+2) . read . head :: IO Int
  +
  +
let stretch = make 0 (maxDepth+1)
  +
io "stretch tree" (maxDepth+1) (check stretch)
  +
  +
let long = make 0 maxDepth
  +
  +
let vs = depth minDepth maxDepth
  +
mapM_ (\(P m d i) -> io (show m ++ "\t trees") d i) vs
  +
  +
io "long lived tree" maxDepth (check long)
  +
  +
data P = P !Int !Int !Int
  +
  +
depth :: Int -> Int -> [P]
  +
depth !d !m
  +
| d > m = []
  +
| otherwise = P (2*n) d (sumT n d 0) : depth (d+2) m
  +
where
  +
n = 1 `shiftL` (m - d + minDepth)
  +
  +
sumT :: Int -> Int -> Int -> Int
  +
sumT !0 !d !t = t
  +
sumT i d t = sumT (i-1) d (t + a + b)
  +
where a = check (make i d)
  +
b = check (make (-i) d)
  +
  +
make :: Int -> Int -> Tree
  +
make !i !0 = Node i Nil Nil
  +
make i d = Node i (make (i2-1) d2) (make i2 d2)
  +
where
  +
i2 = 2*i
  +
d2 = d-1
  +
  +
check :: Tree -> Int
  +
check Nil = 0
  +
check (Node i l r) = i + check l - check r
  +
</haskell>
  +
  +
== Old entry ==
   
 
Shortest entry in any language, and almost twice as fast as old entry on my box.
 
Shortest entry in any language, and almost twice as fast as old entry on my box.
  +
  +
Was speculatively disqualified.
   
 
<haskell>
 
<haskell>

Revision as of 09:02, 2 February 2007

Proposals

Port the Clean entry.

Proposed entry

Ported to ghc 6.6

{-# OPTIONS -fbang-patterns #-}

--
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Simon Marlow
-- Rewritten by Don Stewart
--

import System
import Data.Bits
import Text.Printf

data Tree = Nil | Node !Int Tree Tree

minDepth = 4

io s n t = printf "%s of depth %d\t check: %d\n" s n t

main = do
    maxDepth <- getArgs >>= return . max (minDepth+2) . read . head :: IO Int

    let stretch = make 0 (maxDepth+1)
    io "stretch tree" (maxDepth+1) (check stretch)

    let long    = make 0 maxDepth

    let vs = depth minDepth maxDepth
    mapM_ (\(P m d i) -> io (show m ++ "\t trees") d i) vs

    io "long lived tree" maxDepth (check long)

data P = P !Int !Int !Int

depth :: Int -> Int -> [P]
depth !d !m
    | d > m     = []
    | otherwise = P (2*n) d (sumT n d 0) : depth (d+2) m
  where
    n = 1 `shiftL` (m - d + minDepth)

sumT :: Int -> Int -> Int -> Int
sumT !0 !d !t = t
sumT i d t    = sumT (i-1) d (t + a + b)
    where a = check (make i    d)
          b = check (make (-i) d)

make :: Int -> Int -> Tree
make !i !0 = Node i Nil Nil
make  i  d = Node i (make (i2-1) d2) (make i2 d2)
    where
        i2 = 2*i
        d2 = d-1

check :: Tree -> Int
check Nil          = 0
check (Node i l r) = i + check l - check r

Old entry

Shortest entry in any language, and almost twice as fast as old entry on my box.

Was speculatively disqualified.

{-# OPTIONS_GHC -fglasgow-exts -O2 -optc-O3 -funbox-strict-fields #-}
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- Simon Marlow
-- Shortened by Don Stewart

import System; import Text.Printf; import Monad

data Tree = Nil | Node !Int Tree Tree

min' = 4 :: Int

main = do max' <- getArgs >>= return . max (min'+2) . read . head
          printf "stretch tree of depth %d\t check: %d\n" (max'+1) (itemCheck $ make 0 (max'+1))
          depthLoop min' max'
          printf "long lived tree of depth %d\t check: %d\n" max' (itemCheck $ make 0 max')

depthLoop d m = when (d <= m) $ do
    printf "%d\t trees of depth %d\t check: %d\n" (2*n) d (sumLoop n d 0)
    depthLoop (d+2) m 
    where n = 2^(m - d + min')

sumLoop 0 d acc = acc
sumLoop k d acc = c `seq` sumLoop (k-1) d (acc + c + c')
    where (c,c')  = (itemCheck (make k d), itemCheck (make (-1*k) d))

make i (0::Int) = i `seq` Nil
make i  d       = Node i (make ((2*i)-1) (d-1)) (make (2*i) (d-1))

itemCheck Nil = 0
itemCheck (Node x l r) = x + itemCheck l - itemCheck r

Old Entry

{-# OPTIONS -O3 -optc-O3 #-}
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- contributed by Einar Karttunen

import System

data Tree = Node  Int Tree Tree | Nil

main = do [n] <- getArgs
          let max' = max (min'+2) (read n)
          showItemCheck (max'+1) (make 0 (max'+1)) "stretch tree of depth "
          let longlived = make 0 max'
          depthLoop min' max'
          showItemCheck max' longlived "long lived tree of depth "

min' :: Int
min' = 4

showItemCheck d a s = putStrLn (s++show d++"\t check: "++show (itemCheck a))

showCheck i d check = putStrLn (show (2*i)++"\t trees of depth "++show d++"\t check: "++show check)


depthLoop d m | d > m = return ()
depthLoop d m         = showCheck n d (sumLoop n d 0) >> depthLoop (d+2) m
              where n = 2^(m - d + min')



sumLoop :: Int -> Int -> Int -> Int
sumLoop 0 d acc = acc
sumLoop k d acc = c `seq` sumLoop (k-1) d (acc + c + c')
    where c  = itemCheck (make k d)
          c' = itemCheck (make (-1*k) d)

make :: Int -> Int -> Tree
make i 0 = Nil
make i d = Node i (make ((2*i)-1) (d-1)) (make (2*i) (d-1))

itemCheck Nil = 0
itemCheck (Node x l r) = x + itemCheck l - itemCheck r