高効率コードを書くのは難しいのか

Haskell でのパフォーマンスチューニングを読ませていただいた。
リンク先の英語のページは英語なので(…)読んでいないが、
まぁ、コードで雰囲気は伝わってきた。

http://shootout.alioth.debian.org/lang/ghc/wc.ghc.html

いかにもご大層である。
Haskellでこれだけ長いとちょっと気合を入れないと読むのがつらいが、
読んでみるとまぁ、そんなに大したことをしているわけではなくてホッとした。
要するに、hGetArrayを用いてIOUArrayにbufSize(ここでは4096)ごとに
入力を行い、そのそれぞれで一文字づつ文字種を調べて
行数、単語数、文字数を"正格的"に計算していっている。
isspaceを自分で定義しているのはご愛嬌。
Data.CharのisSpaceを使うよりも多少速くなるようだ。


それで、このようなことを行うとどうしてもあれ位コードが長くなってしまうのだが、
やっぱりこれは感心しないと思うのだ。
これではどうみてもC言語や何かで普通に書いていることをわざわざ
ややこしく書いているようにしか見えない。
(しかも、それでもCに速度で勝てていないわけだし…)


上のコードは確かに速い。うちで実行したら、およそ300msecで計算できた。
私が7月27日あたりで書いた全く直截的なコード、

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

これが5秒ぐらい。(しかもメモリを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)

これが2秒強。(メモリはそんなに食わず)
適当に書いたコードとがりがりにチューンしたコードが10倍以上
開いてしまっている。メモリ使用量もほとんど致命的ともいえる。
とはいうものの、直截的に書いて高速に実行されて欲しい…。
例えば、300msecとまでは言わずとも、もうちょっと遅くて、
圧倒的に簡単なコード…みたいなのがあればいいなと。


そんなことを考えつつ適当にコードを書いていたらこんなものが出来た。

import System.IO
import Data.List
import Data.Char

main = do
  (_,nl,nw,nc) <- foldF wc (True,0,0,0) stdin
  putStrLn $ concat $ intersperse " " $ map show [nl,nw,nc]

wc :: (Bool,Int,Int,Int) -> Char -> (Bool,Int,Int,Int)
wc (prev,nl,nw,nc) c =
  nnl `seq` nnw `seq` nnc `seq` (cur,nnl,nnw,nnc)
  where
    cur = isSpace c
    nnl = incIf nl (c=='\n')
    nnw = incIf nw (prev && not cur)
    nnc = nc + 1
    incIf n b = if b then n+1 else n

foldF :: (a -> Char -> a) -> a -> Handle -> IO a
foldF f init h = loop init where
  loop st = do
    eof <- hIsEOF h
    if eof
      then return st
      else do
        c <- hGetChar h
        loop $! f st c

短くもないし簡潔でもないが…。
つまるところ、アイデアは"チューニングしないといけない"部分を
分離できないだろうか。というだけのことで。
foldFというのはfoldのFile版の意味で、Handleの中身で
foldをするような関数として定義した。
ここでは1文字づつ読みながら計算するようになっている。
で、foldFが頑張れば、適当にさらさらと書いたファイルアクセスプログラムが
無難な速度で動いてくれないかなと。


しかし、やはり問題はそんなに簡単ではなくて、Haskellでの
正格性評価の扱いのために、上でのwcという関数にも
煩雑な部分を持ち込まざるを得なかった。


$!という関数は、

f $! x = x `seq` f x

と定義されているようだが、このseqというのが曲者である。
seqの定義は、http://www.sampou.org/haskell/report-revised-j/basic.html この辺によると

seq _|_ b = _|_
seq a b = b (aが_|_じゃないとき)

このように定義されているらしい。
_|_というのはHaskellの記号ではなく、
論理学に出てくる⊥を表している…のだと思う。
Haskellにおいて⊥が何か分からないが、例外か何か、
正常に停止しない計算などという意味だろう。

div a 0 = _|_
div a b = ....

等、概念的には。
要するに、seqは正格性だナンだと言って、
実際のところ⊥かどうかしか見ていない(…ようだ)。
これで、何がいけないのかというと、
上のコードで、

loop $! f st c

このあたり、ここはloopを"値呼び出し"したいのである。
stの型が単純な型(整数など)なら良いのだが、
上では4つ組みである。
4つ組みだとここの評価は、
例えば、st=(True,0,0,0) c='\n'ならば、
先のコードでwcが

wc (prev,nl,nw,nc) c =
  (cur,incIf nl (c=='\n'),incIf nw (prev && not cur),nc + 1)
  where
    cur = isSpace c

このようなseqなしのコードだった場合、

loop $! f st c
=> let x = f st c in x `seq` loop x
=> let x =
     let (prev,nl,nw,nc)=st c=c in
     (cur,incIf nl (c=='\n'),incIf nw (prev && not cur),nc + 1)
     where
       cur = isSpace c
   in x `seq` loop x
=> let x =
     let (prev,nl,nw,nc)=st c=c in
     (cur,incIf nl (c=='\n'),incIf nw (prev && not cur),nc + 1)
     where
       cur = isSpace c
   in if x==_|_ then _|_ else loop x

(グラフ簡約をテキスト表現するの難しいなぁ…)
ここで、次に発生するのはxと_|_の比較であるが、
xは中身は何か分からないが、なんだか4つ組みであることが判明している。
要するにこの時点で_|_だと判断して、評価が打ち切られ、
結局中身は評価されない。


最初のころseqは最初の引数を標準形まで簡約してから第二引数を
返すとか思っていて、はまりまくったのを思い出した…。
とりあえず、タプルの中身は遅延してしまうので、
計算が進むにつれ式が大きくなっていく。
具体的にはwcにseqを入れないとメモリ128バイトを食いつぶして
計算不能になってしまった。


それで、…なんだったかな…。
結局wcのほうにもseqを突っ込まざるを得ないと。
まぁしかし、wcはそれほど煩雑なコードにならずに済んでいるのではないかなぁと思う。
(seqがいる/いらない、という判別は相変わらず難しいかもしれない。
それ自体が難しい、というよりも慎重に考えないと、どこか一つでもミスると
遅延評価によりメモリ消費が大変なことになってしまうというのが厳しいのか。
いずれにせよあんまり望ましくない傾向なのは確かだろう。)


それで、これの実行速度であるが、大体5秒ぐらいかかっている。
foldFのコードが一文字づつ処理するナイーブなものになっているためか、
あんまり速くない。ここさえ頑張れば速くなる、というのが目的だったので
ここを速くしてみる。

foldF :: (a -> Char -> a) -> a -> Handle -> IO a
foldF f init h = do
  buf <- newArray_ (0,bufSize-1) :: IO (IOUArray Int Word8)
  let loop i n st
        | i==n = do
            n <- hGetArray h buf bufSize
            if n==0 then return st
              else loop 0 n st
        | otherwise = do
            c <- liftM (toEnum.fromEnum) (unsafeRead buf i)
            loop (i+1) n $! f st c
  loop 0 0 init

  where bufSize = 4096

ぎちぎちチューンのやつと同じく、IOUArrayを使った。
これで600msecほどになった。
さほどコードに違いは無いはずなのに2倍ほどの速度差が出るというのは
分かれていることにより結構オーバーヘッドがかかるのだろうか。
しかし、これで(foldFを書かないとすると…)大体当初の目論見は
果たせたということにしておけるか。


ところで、Haskellでこれだけ頑張ってもCとかで半分眠りながら書いたようなコード
よりも遅かったりするんだよなぁ…。などと考えたり
いや本当にそうなのか?とか考えたりして、結局実際に試してみることにした。
まずC++で。(最近素のCは全然いじってないなぁ)

#include 
#include 
using namespace std;

int main()
{
  int nl=0,nw=0,nc=0;
  bool prev=true;
  char c;
  while(cin.get(c)){
    bool cur=isspace(c);
    nl+=c=='\n'?1:0;
    nw+=(prev&&!cur)?1:0;
    nc++;
    prev=cur;
  }
  cout<

これがふらふらと何にも考えないで書いたコード。
それで適当に実行してみたのだが…
これ、想像していたよりも遥かに効率の悪いことが判明した。
なんと5秒以上もかかった。
これならふらふらと適当に書いたHaskellコードと実行速度に
大差はない。
cinがよろしくないのだろうか。あるいはg++が良くないのか。

http://shootout.alioth.debian.org/lang/g++/wc.g++.html

さすがにこれをもってきて実行すると0.3秒ぐらいで計算できた。
しかし、これもチューニングされたHaskellコードと大体同じである。
まさか、HaskellC++なみの速度なのだろうか。


C++が不甲斐無い?成績だったのでCでも書いてみた。

#include 
#include 

int main()
{
  int nl=0,nw=0,nc=0,c,prev=1;
  while((c=getchar() )!=EOF){
    int cur=isspace(c);
    nl+=c=='\n';
    nw+=prev&&!cur;
    nc++;
    prev=cur;
  }
  printf("%d %d %d\n",nl,nw,nc);
}

これが適当に書いたコードである。
C++は不甲斐無かったが、やはりCは速くて
こんな適当なコードが0.4秒ぐらいだった。

http://shootout.alioth.debian.org/lang/gcc/wc.gcc.html

Cのチューニングされたバージョン。
これまたやっぱりCは違った。わずか60msecで完了した。


しかしまぁ、CにしてもC++にしてもチューニングされたやつは
別に分かりやすいコードではなくて、
バッファを使うために本質的でないコードがかなり含まれている。
Haskellで同じことをやろうとすると、これに加えて
正格性評価の問題が絡むので無用にややこしく感じられるのかもしれない。
いずれも工夫次第…なのだろうか。