Writerモナドの使い道 計算の経過を得る

1から10まで足し算するコードを考えてみよう。関数型言語では高階関数を使ってすっきり表現できる。
ただ、このコードには欠点がある。最後の結果求めるには十分だが、足し算の経過を見たいときどうしてよいか分からない。

import Data.List(foldl')

main = do
  print $ sum' [1..10]

sum' :: Num a => [a] -> a
sum' xs = foldl' (+) 0 xs

手続き型言語で書かれたコードだったら、一行追加するだけで良いかもしれない。
では関数型言語ではどうするのか?

function sum2 (xs) {
    var r = 0;
    for(var i in xs)
    {
    r += xs[i];
    console.log("r: " + r) // この行を追加すればOK
    }
    return r;
}

方法1. IOモナドを使う

(+) の IOモナド対応版(addIO)を作り、foldl を foldM に変えれば、addIO内でputStrLnが使えるようになる。ただ、これだと純粋な関数ではなくなり、IOを引きずっている箇所でしか利用できない。

main = do
  print =<< sumIO [1..10]

sumIO :: (Num a, Show a) => [a] -> IO a
sumIO xs = foldM addIO 0 xs

addIO :: (Num a, Show a) =>  a -> a -> IO a
addIO p1 p2 = putStrLn ("r: " ++ show r) >> return r
  where
    r = p1 + p2

方法2. trace を使う

Haskell には純粋な関数内での計算をデバッグ出力する関数が用意されている。trace は 第一引数を標準出力に表示し、第二引数と同じものに評価される関数だ。場合によってはこれで十分だろう。ただ、経過の値を他の計算でも利用したいとき、標準出力に表示されてしまったものを利用することはできない。

import Data.List(foldl')
import Debug.Trace

main = do
  print $ sumT [1..10]
  
sumT :: (Num a, Show a) => [a] -> a
sumT xs = foldl' addT 0 xs

addT :: (Num a, Show a) => a -> a -> a
addT p1 p2 = trace ("r: " ++ show r) r
  where
    r = p1 + p2
  

方法3. Writerモナド を使う

そこでWriterモナド登場。WriterモナドはIOモナドと違い純粋関数内で実行でき、コードに下記のように手を加えることで、結果にいたるまでの過程の値を最後にリストとして得ることが出来る。

import Control.Monad.Writer

main = do
  print $ sumW [1..10]

sumW :: (Num a) => [a] -> (a,[a])
sumW xs = runWriter $ foldM addW 0 xs
          
-- 戻り値の型に細工をするとWriterモナド対応の関数になる
addW :: (Num a) => a -> a -> Writer [a] a
-- tell で経過を保存、returnで次の計算に結果を渡す
addW p1 p2 = tell [r] >> return r
  where
    r = p1 + p2

全部のせておく。

import Data.List(foldl')
import Debug.Trace
import Control.Monad.Writer

main = do
  print $ sum' [1..10]
  print $ sumW [1..10]
  print $ sumT [1..10]
  print =<< sumIO [1..10]


sum' :: Num a => [a] -> a
sum' xs = foldl' (+) 0 xs



sumIO :: (Num a, Show a) => [a] -> IO a
sumIO xs = foldM addIO 0 xs

addIO :: (Num a, Show a) =>  a -> a -> IO a
addIO p1 p2 = putStrLn ("r: " ++ show r) >> return r
  where
    r = p1 + p2



sumT :: (Num a, Show a) => [a] -> a
sumT xs = foldl' addT 0 xs

addT :: (Num a, Show a) => a -> a -> a
addT p1 p2 = trace ("r: " ++ show r) r
  where
    r = p1 + p2
  


sumW :: (Num a) => [a] -> (a,[a])
sumW xs = runWriter $ foldM addW 0 xs
          
addW :: (Num a) => a -> a -> Writer [a] a
addW p1 p2 = tell [r] >> return r
  where
    r = p1 + p2

window.onload = function() {
    console.log(sum1([1,2,3,4,5,6,7,8,9,10]));
    console.log(sum2([1,2,3,4,5,6,7,8,9,10]));
}

function sum1 (xs) {
    var r = 0;
    for(var i in xs)
    {
    r += xs[i];
    }
    return r;
}

function sum2 (xs) {
    var r = 0;
    for(var i in xs)
    {
    r += xs[i];
    console.log("r: " + r)
    }
    return r;
}