Shootout/SumFile

From HaskellWiki
Jump to navigation Jump to search

A Shootout Entry for the sum-file benchmark.

Each program should be implemented the same way - the same way as this Icon program. The sum-file benchmark measures line-oriented I/O and string conversion.

Each program should:

   * read integers from stdin, one line at a time
   * print the sum of those integers

Correct output for this 6KB input file is:

   500

Programs should use built-in line-oriented I/O functions rather than custom-code. No line will exceed 128 characters, including newline. Reading one line at a time, the programs should run in constant space. Ideally, we could get this benchmark up to the first rank; Clean is the current number one language for this benchmark, at 2.74 seconds[1], and anything Clean can do Haskell should be able to do as well!

Those guys tell us these benchmarks don't favor C and then impose a limit on line length? What's the purpose of that if not to allow the use of C's getline() primitive (in both senses of the word)? And if we're picky, all submitted programs are incorrect, as they assume the sum fits into a machine word, but this assumption is unwarranted. This again favors C, which lacks arbitrary precision integers. -- UdoStenzel


Proposed entry: 2

{-# OPTIONS -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- A lazy bytestring solution
--

import qualified Data.ByteString.Lazy.Char8 as S

main = print . go 0 =<< S.getContents
  where
    go !n !s = case S.readInt s of -- lazily reads current line
                    Nothing     -> n
                    Just (k,t)  -> go (n+k) (S.tail t)

Proposed entry: 1

{-# OPTIONS -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Vasile Gaburici, refactored heavily by Don Stewart
-- Real line-oriented I/O
--

import qualified Data.ByteString.Char8 as S
import Control.Exception as E
import Control.Monad
import Data.Maybe
import System.Exit

main = go 0
  where
    go !n = do
        s <- E.handle (const (return Nothing)) (liftM return S.getLine)
        case s of
            Nothing -> print n
            Just t  -> go (n+k) where Just (k,_) = S.readInt t

Rejected

Copies far less on each chunk boundary. Gains around 10% speed for lt 10M input.

This entry was ruled illegal. Doesn't use line oriented IO.

<!-- This may need to be updated - Data.ByteString.Base no longer exists, for example. -->
{-# OPTIONS -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
--
import Data.Char
import Data.ByteString.Base
import qualified Data.ByteString.Char8      as S
import qualified Data.ByteString.Lazy.Char8 as L

main = print . new 0 . L.toChunks =<< L.getContents

new  i []      = i
new !i (s:t:ts) | S.last s /= '\n' = new (add i s') ts'
  where
    (s',r)  = S.breakEnd (=='\n') s
    (r',rs) = S.break    (=='\n') t
    ts'     = S.concat [r,r',S.singleton '\n'] : unsafeTail rs : ts
new  i (s: ss) = new (add i s) ss

--
-- now jump into the fast path
--
add !i !s    | S.null s  = i
             | x == '-'  = sub i 0 xs
             | otherwise = pos i (parse x) xs
  where (x,xs) = uncons s

sub !i !n !t | y == '\n'  = add (i-n) ys
             | otherwise  = sub i n' ys
  where (y,ys) = uncons t
        n'     = parse y + 10 * n

pos !i !n !t | y == '\n' = add (i+n) ys
             | otherwise = pos i n' ys
  where (y,ys) = uncons t
        n'     = parse y + 10 * n

parse c  = ord c - ord '0'

uncons s = (w2c (unsafeHead s), unsafeTail s)

Elegant, and moderately efficient

{-# OPTIONS -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
--
-- An elegant fold . unfold.
--

import Data.List
import qualified Data.ByteString.Lazy.Char8 as L

main = print . foldl' (+) 0 . unfoldr parse =<< L.getContents

parse !s | Just (n,t) <- L.readInt s = Just (n, L.tail t)
         | otherwise                 = Nothing

Current

The current legal Haskell submission is #2; it takes about 16 seconds and is somewhere around the 24th rank

{-# OPTIONS -fglasgow-exts -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Vasile Gaburici
--
-- Real line-oriented I/O
--

import qualified Data.ByteString.Char8 as C8
import System.IO.Error as Err

maybeGetLine :: IO (Maybe C8.ByteString)
maybeGetLine =  Err.catch (do line <- C8.getLine
                              return $ Just line) (\_ -> return Nothing)

addLine :: Int -> IO ()
addLine the_sum = do maybe_line <- maybeGetLine
                     case maybe_line of
                       Nothing   -> print the_sum
                       Just line -> do
                         let Just(num, _) = C8.readInt line
                         addLine $! num + the_sum

main :: IO ()
main = addLine 0

Old current

This uses the fast, strict loop from the illegal/strict entry, but a chunk-wise lazy reader from the current lazy bytestring entry. It is the most efficient entry in any language, but it was rejected: "NOT ACCEPTED: should use built-in line-oriented I/O functions rather than custom-code"[2]

Submitted.

{-# OPTIONS -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
--
import Data.Char
import Data.ByteString.Base
import qualified Data.ByteString.Char8      as S
import qualified Data.ByteString.Lazy.Char8 as L

main = print . new 0 . L.toChunks =<< L.getContents

new  i []      = i
new !i (!s:t:ts) | S.last s /= '\n' = new (add i s') ts'
  where
    (s',r) = S.breakEnd (=='\n') s
    ts'    = (S.append r t) : ts
new  i (s: ss) = new (add i s) ss

--
-- now jump into the fast path
--
add !i !s    | S.null s  = i
             | x == '-'  = sub i 0 xs
             | otherwise = pos i (parse x) xs
  where (x,xs) = uncons s

sub !i !n !t | y == '\n'  = add (i-n) ys
             | otherwise  = sub i n' ys
  where (y,ys) = uncons t
        n'     = parse y + 10 * n

pos !i !n !t | y == '\n' = add (i+n) ys
             | otherwise = pos i n' ys
  where (y,ys) = uncons t
        n'     = parse y + 10 * n

parse c  = ord c - ord '0'

uncons s = (w2c (unsafeHead s), unsafeTail s)

Legal, but too slow

Runs ok on my box, and beats the strict version for n>50M, but runs some 8x slower on the shootout.

{-# OPTIONS -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
--
-- Lazily reads lines on demand.
--
-- Based on older versions by Greg Buchholz, 
-- Mirko Rahn, Chris Kuklewicz and David Himmelstrup
--
import Data.Char
import qualified Data.ByteString.Lazy.Char8 as B

main = print . new 0 =<< B.getContents

new !i !s
    | B.null s  = i
    | x == '-'  = sub i 0 xs
    | otherwise = add i (parse x) xs
    where (x,xs) = uncons s

sub !i !n !t | y == '\n'  = new (i-n) ys
             | otherwise  = sub i n'  ys
  where (y,ys) = uncons t
        n'     = parse y + 10 * n

add !i !n !t | y == '\n' = new (i+n) ys
             | otherwise = add i n'   ys
  where (y,ys) = uncons t
        n'     = parse y + 10 * n

parse c  = ord c - ord '0'

uncons !s = (B.head s, B.tail s)
{-# INLINE uncons #-}

Old code

Very very fast but illegal

ByteString translation, with careful attention to Core.

submitted 02/02/07

This is very very fast, but illegal.

{-# OPTIONS -O -fbang-patterns #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- Contributed by Don Stewart
-- Based on older versions by Greg Buchholz, 
-- Mirko Rahn, Chris Kuklewicz and David Himmelstrup
--
import Data.Char
import Data.ByteString.Base
import qualified Data.ByteString.Char8 as B

main = print . new 0 =<< B.getContents

new !i s
    | B.null s  = i
    | x == '-'  = sub i 0 xs
    | otherwise = add i (parse x) xs

    where (x,xs) = uncons s

sub !i !n t | y == '\n'  = new (i-n) ys
            | otherwise  = sub i n' ys
  where (!y,ys) = uncons t
        n'      = parse y + 10 * n

add !i !n t | y == '\n' = new (i+n) ys
            | otherwise = add i n' ys
  where (!y,ys) = uncons t
        n'      = parse y + 10 * n

parse c  = ord c - ord '0'

uncons s = (w2c (unsafeHead s), unsafeTail s)

Cute

--
-- Contributed by Don Stewart
--

import qualified Data.ByteString.Char8 as B
import Data.List

main = print . sum . unfoldr parse =<< B.getContents

parse !x | Just (n,y) <- B.readInt x = Just (n,B.tail y)
         | otherwise                 = Nothing

A Lazy ByteString Entry

found here

--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org
--
-- compile with : ghc -O Sumcol.hs -o sumcol
--
-- Contributed by Bryan Donlan
-- Modified by Spencer Janssen

import qualified Data.ByteString.Lazy.Char8 as BS

main = print . sum' 0 . BS.lines =<< BS.getContents
    where
        sum' n [] = n
        sum' n (x:xs) = sum' (n + readInt x) xs
        readInt bs =
            case BS.readInt bs of
                Just (i, _) -> i

Another ByteString Entry

$ time ./sum-file < file.txt 
500

real    0m0.030s
user    0m0.005s
sys     0m0.009s

Note the -O2 pragma is not required (the build system passes it by default) and just hurts compression.

{-# OPTIONS -O2 #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- contributed by: Ian Henderson
-- compile with: ghc -O2 -o sum-file sum-file.hs
--

import qualified Data.ByteString.Char8 as B
import Data.Char

main = print . sum . map parseInt . B.lines =<< B.getContents

parseInt bs = case B.head bs of '-' -> -parseNat (B.tail bs)
                                _   ->  parseNat bs

parseNat = B.foldl' (\n c -> n * 10 + ord c - ord '0') 0

Possible Entry

Todo: Use ByteStrings. An example of a faster entry using the new Data.ByteString library.

{-# OPTIONS -cpp #-}

--
-- 'sums' benchmark from the great language shootout 
--

import System.IO
import qualified Data.ByteString as B
import Data.ByteString (ByteString,unsafeTail,unsafeIndexWord8)
import Data.Char    -- seems to help!

#define STRICT2(f) f a b | a `seq` b `seq` False = undefined

main = print . go 0 =<< B.getContents

STRICT2(go)
go i ps
    | B.null ps = i
    | x == 45   = neg 0 xs
    | otherwise = pos (parse x) xs
    where
        (x, xs) = (ps `unsafeIndexWord8` 0, unsafeTail ps)

        STRICT2(neg)
        neg n qs | x == 10     = go (i-n) xs
                 | otherwise   = neg (parse x + (10 * n)) xs
                 where (x, xs) = (qs `unsafeIndexWord8` 0, unsafeTail qs)

        STRICT2(pos)
        pos n qs | x == 10   = go (i+n) xs
                 | otherwise = pos (parse x + (10 * n)) xs
                 where (x, xs) = (qs `unsafeIndexWord8` 0, unsafeTail qs)

parse w = fromIntegral (w - 48) :: Int
{-# INLINE parse #-}

Fastest string entry

This compiles to the same code as the Submitted Entry. Additionally, the shootout includes {- -} style comments in the line count! So don't submit code with such comments.

-O2 -optc-O3

--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- compile with : ghc fastest.hs -o fastest
--
-- contributed by Greg Buchholz
-- Modified by Mirko Rahn, Don Stewart, Chris Kuklewicz and Lemmih
--
import Data.Char

main = print . new 0 =<< getContents

new i []       = i
new i ('-':xs) = neg 0 xs
    where neg n ('\n':xs) = new (i - n) xs
          neg n (x   :xs) = neg (parse x + (10 * n)) xs
new i (x:xs) = pos (parse x) xs
    where pos n ('\n':xs) = new (i + n) xs
          pos n (x   :xs) = pos (parse x + (10 * n)) xs

parse c = ord c - ord '0'

A shorter version of the original entry

{-# OPTIONS -O2 -optc-O3 #-}
--
-- The Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- compile with : ghc -O2 -o SumF SumF.hs
-- To get better performance set default heap size to 10MB
-- i.e. invoke as : ./SumF +RTS -H10M <input_file.txt
-- contributed by Greg Buchholz
-- modified by Mirko Rahn and Don Stewart
--

import Char

main = getContents >>= print . accP 0 0

accP b t  []       =       b+t
accP b t ('\n':xs) = accP (b+t) 0                        xs
accP b t ('-' :xs) = accN  b       t                     xs
accP b t (x   :xs) = accP  b      (t*10+ord(x)-ord('0')) xs

accN b t  []       =       b-t
accN b t ('\n':xs) = accP (b-t) 0                        xs
accN b t (x   :xs) = accN  b      (t*10+ord(x)-ord('0')) xs


Submitted Entry

Currently ranked 7th, behind D, Clean, C and C++.

A version of Don's and Chris' using -funbox-strict-fields instead of explicit Int#. Runs about 10% faster than the original entry.

{-# OPTIONS -O2 -funbox-strict-fields #-}
{-
   The Computer Language Shootout
   http://shootout.alioth.debian.org/

   compile with : ghc --make fastest.hs -o fastest

   contributed by Greg Buchholz
   modified by Mirko Rahn
   modified by Don Stewart and Chris Kuklewicz, 5-6 Jan 2006
-}
import GHC.Base

data I = I !Int

main = print . new (I 0) =<< getContents 

new (I i) []       = i
new (I i) ('-':xs) = neg (I 0) xs
    where neg (I n) ('\n':xs) = new (I (i - n)) xs
          neg (I n) (x   :xs) = neg (I (parse x + (10 * n))) xs
new (I i) (x:xs) = pos (I (parse x)) xs
    where pos (I n) ('\n':xs) = new (I (i + n)) xs
          pos (I n) (x   :xs) = pos (I (parse x + (10 * n))) xs

parse c = ord c - ord '0'

A box around a (unboxed) strict Int? How is that smart? --Lemmih

The -funbox-strict-fields causes it to be converted to Int# without writint I# -# +# ==# everywhere -- Chris

"data I = I !Int" gives "data I = I Int#" which is exactly the same as "data Int = I# Int#". Fortunately, GHC is able to compile both 'I' and 'Int' away. --Lemmih

Chris Kuklewicz

I tried IOUArray, mallocArray, and in the end came back to to original entry, but slightly optimized with unboxed Int# so it runs ~10% faster:

{-# OPTIONS -fglasgow-exts -O2 #-}
{-
   The Computer Language Shootout
   http://shootout.alioth.debian.org/

   compile with : ghc -O2 -o SumF SumF.hs

   To get better performance set default heap size to 10MB
   i.e. invoke as : ./SumF +RTS -H10M <input_file.txt

   contributed by Greg Buchholz
   modified by Mirko Rahn
   modified by Chris Kuklewicz, 5 Jan 2006
-}
import GHC.Base

main = print . sumFile =<< getContents
    where sumFile = (\rest -> newLine rest 0#)

newLine [] rt = (I# rt)
newLine ('-':rest) rt = negLine rest 0#
    where negLine ('\n':rest) soFar = newLine rest (rt -# soFar) 
          negLine ( x  :rest) soFar = negLine rest (parse x +# (10# *# soFar))
newLine (x:rest) rt = posLine rest (d2i x)
    where posLine ('\n':rest) soFar = newLine rest (rt +# soFar)
          posLine ( x  :rest) soFar = posLine rest (parse x +# (10# *# soFar))

parse (C# c) = (ord# c) -# z
    where (I# z) = ord '0'

Yes, this is nice and fast. Here's a tiny bit of refactoring. -- Don

import GHC.Base

main = print . new 0# =<< getContents

new i []       = (I# i)
new i ('-':xs) = neg 0# xs
    where neg n ('\n':xs) = new (i -# n) xs
          neg n (x   :xs) = neg (parse x +# (10# *# n)) xs

new i (x:xs)   = pos (parse x) xs
    where pos n ('\n':xs) = new (i +# n) xs
          pos n (x   :xs) = pos (parse x +# (10# *# n)) xs

parse (C# c) = ord# c -# ord# '0'#

Don Stewart

An short alternative (but performance isn't great with the {{{read}}}). However, it's the only 1 line entry in any language, it's very Haskellish, and GHC does an excellent job compiling the foldr into a tight loop. The Int constraint doesn't seem to change performance much, but causes less code to be generated.

main = print . foldr ((+).read) (0::Int) . lines =<< getContents

Since this is an accumulation, wouldn't foldl' work better?

main = print . foldl' (+) (0::Int) . map read . lines =<< getContents

-- UdoStenzel


I tried that tweak and the speed was the same -- ChrisKuklewicz

Other options

main = print . sum . map read . lines =<< getContents
main = print . foldl ((.read).(+)) (0::Int) . lines =<< getContents

-- DonStewart

Ketil Malde

I toyed with the one liner as a starting point, and ended up with this:

import Char
import Data.List

main = getContents >>= print . sum . map (read'. valid) . lines

valid = filter (\x -> x == '-' || x >= '0' && x <= '9')
read' (x:xs) = case x of '-' -> negate $ foldl (\a b -> 10*a+ord b-ord '0') 0 xs
                         _ -> foldl (\a b -> 10*a+ord b-ord '0') 0 (x:xs)

It isn't entirely valid, but as has been pointed out, neither are any of the other entries. Like Chris, I couldn't tell any difference between foldl and foldl', nor did restricting to Ints make any impact. (Other test data may differ)

This is (with -O2) about three times slower than the current best entry, which, if it scales up, will put it in the middle of the pack, close to Ocaml byte code and CMUCL.

An improved version, this uses about 0.6 of the heap (according to -prof). Replacing sum . map with a foldr is the key. Also, why the need for `valid'? -- Don

Right, I didn't bother with heap - and I guess I expected sum to be strict enough (isn't it?) valid`s raison d'tre is the possibility of non-numeric characters (whitespace) in the file. Perhaps the spec excludes that possibility? -k

import Char

main = print . foldr ((+).read') (0::Int) . lines =<< getContents

read' (x:xs) = if x == '-' then negate (sumify xs) else sumify (x:xs)

sumify = foldl (\n b -> ord b - ord '0' + 10 * n) 0

Nice and concise! I'd suggest renaming sumify, but perhaps str2int is better than my read variant? Does the ::Int buy you much? I really like to avoid the overflow bug, even if not relevant for the test data set. -k

Current entry

This entry has rather good performance, though space is a bit high. Currently placed 6th.

import Char( ord )

main :: IO ()
main = getContents >>= print . accP 0 0

accP :: Int -> Int -> String -> Int
accP before this  []       =       before+this
accP before this ('\n':xs) = accP (before+this) 0                        xs
accP before this ('-' :xs) = accN  before       this                     xs
accP before this (x   :xs) = accP  before      (this*10+ord(x)-ord('0')) xs

accN :: Int -> Int -> String -> Int
accN before this  []       =       before-this
accN before this ('\n':xs) = accP (before-this) 0                        xs
accN before this (x   :xs) = accN  before      (this*10+ord(x)-ord('0')) xs