Personal tools

Shootout/SumFile

From HaskellWiki

< Shootout
Revision as of 17:25, 5 November 2007 by Gwern (Talk | contribs)

Jump to: navigation, 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

Contents

1 Proposed

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

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


2 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

3 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 Data.List
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) (\e -> return Nothing)
 
addLine :: Int -> IO ()
addLine the_sum = do maybe_line <- maybeGetLine
                     case maybe_line of
                       Nothing   -> putStrLn $ show the_sum
                       Just line -> do
                         let Just(num, _) = C8.readInt line
                         addLine $! num + the_sum
 
main = addLine 0

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

5 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 #-}

6 Old code

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

6.2 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

6.3 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

6.4 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

6.5 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 #-}

6.6 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'

6.7 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


6.8 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

6.9 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'#

6.10 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

6.11 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

6.12 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