遅延評価の落とし穴

http://www.bagley.org/~doug/shootout/
このページ、言語の比較ページなのであるが、
Haskellのスコアが不当に低いように感じた。
全体のスコアは未実装のテストが有ると大幅に低下してしまうようなのだが、
LOC(コードの長さ)でもあまり芳しくないのはどうしたものかと思った。
いや、全体的には順位が高いのだが、
一部のテストが長くなりすぎている。

それで、適当に長くなっているのを見てみると、
http://www.bagley.org/~doug/shootout/bench/wc/
この「Count Lines/Words/Chars」のコードを見て唖然とさせられた。
勝手に貼っていいのかわからないが…

 -- $Id: wc.ghc,v 1.2 2001/05/24 14:05:53 doug Exp $
 -- http://www.bagley.org/~doug/shootout/
 -- from Brian Gregor

module Main where

 -- compile with:  ghc -O -o wc -package lang wc.hs

import IO
import IOExts
import PackedString

main = do
         -- set buffer to 4k
         hSetBuffering stdin (BlockBuffering (Just 4096))
         -- these are mutable variables
         nL <- newIORef 0
         nW <- newIORef 0
	 nC <- newIORef 0
         (nl,nw,nc) <- countAll nL nW nC
	 putStrLn ( (show nl)++" "++(show nw)++" "++(show nc) )

countAll :: IORef Int -> IORef Int -> IORef Int -> IO (Int,Int,Int)
countAll nL nW nC = do 
         end <- hIsEOF stdin
         nl <- readIORef nL
   	 nw <- readIORef nW
         nc <- readIORef nC
         if (not end) 
            then (do  
              inStr <- hGetLine stdin
              -- using a packed string is a small speed win
              let str = packString inStr
              -- using IORefs makes it easy to force strict
              -- evaluation - how to easily do this without
              -- IORefs?
              writeIORef nL $! (nl + 1)
              writeIORef nW $! (nw + (length (wordsPS str)))
              writeIORef nC $! (nc + 1 + (lengthPS str))
              countAll nL nW nC)
            else  return (nl,nw,nc)

これはひどい。
何でこんなにImperativeに書かれているのだろうか。
このテスト、"same thing"タイプのテストになっていて、
同じことが出来るソースならどんな実装でも良いはずなので、
適当に簡潔に書き直してみた。

main = interact $ \d ->
  tail $ concat $ map ( (" "++).show.($d) ) [length.lines,length.words,length]

二行である。
下のコードで問題になりそうなのは実行速度とメモリ消費量である。
入力は遅延するとはいえ、最終的に全域を3回なめるので
結局完全なリストが保持されてしまう。
入力ファイルは2MB以上あるので、(おとといぐらいの考察より
id:tanakh:20040725)おそらく50MB以上のメモリを消費する。
そこで、実際に実行してみた。

$ ghc -O2 count.hs
$ time ./a.out < Input500
12500 68500 3048000
real    0m5.068s
user    0m0.010s
sys     0m0.020s

これだけでは如何ともなので、
最初のソースでも計測してみる。

$ ghc -O2 count.hs
$ time ./a.out < Input500
12500 68500 3048000

real    0m9.187s
user    0m0.010s
sys     0m0.020s

なんと、2行のソースのほうが実行時間が短い。
じゃあ、やっぱり最初のソースは駄目駄目かというと
メモリを5MBほどしか使わない。
2行のやつは90MB近く消費するのである。

しかし、いくらなんでもあれではなぁ、
ということで、高速で簡潔なコードを模索することにした。

import System.IO

main = do
  (l,w,c) <- count (0,0,0)
  putStrLn $ show l ++ " " ++ show w ++ " " ++ show c

count cs@(l,w,c) = do
  eof <- hIsEOF stdin
  if eof then return cs
    else do
      d <- getLine
      let nw = length $ words d
          nc = length d
      seq nw $ seq nc $ count $! (l+1,w+nw,c+nc)

その結果得られたのがこのコードである(簡潔じゃないけど)。
(このコード、出来上がるまで5時間ぐらいかかったんだけど…)
要するに2行のやつを行ごとの処理に分けただけなのであるが、
これ、

count cs@(l,w,c) = do
  eof <- hIsEOF stdin
  if eof then return cs
    else do
      d <- getLine
      count (l+1,w+(length $ words d),c+(length d))

のような直接的なコードだと駄目である。
遅延してしまうので結局同じぐらいのメモリを食ってしまう。
なので、ところどころに正格性評価を行うための処理を織り込んでいる。

気になる速度とメモリ消費量であるが、

$ ghc -O2 count.hs
$ time ./a.out < Input500
12500 68500 3035500

real    0m2.257s
user    0m0.010s
sys     0m0.020s

こんな感じ。
メモリ消費量は4MBほどである。
これだとコードの長さも12行だし、
うちのマシンの性能とから考えるとスピードでもpython〜bigloo〜se
あたりには食い込めそうである。
pythonレベルといっても、主に入出力+文字列処理なので、
g++の3分の一ほどの速度である。
(gcc/ocamlは相変わらず信じられないほど速いけど)

一つ大きな問題は、
こんな直感的ではない処理をはさまなければならないということか。
Haskellでは大きなデータを扱うのは鬼門のようである…