Shootout/SumFile
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]
{-# 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.
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
--
-- 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