状態系モナドの作り方

Haskell モナド

よく言われている事ですが、モナドには副作用を再現する「状態系モナド」（IO、State等）と、値が無い状態や計算の失敗を扱う事ができる「失敗系モナド」（Maybe、List等）の二種類に大別できます。

今回の題材は、「状態系モナド」を扱います。
状態系モナドの代表格と言えばIOですが、IOでは全体像を捉えるのが難しいので、Stateモナドについて考えてみましょう。


(※当方の環境の都合上、ソースファイルからパッケージを直接読み込んでるので表示が少し違うかもしれませんが、あまり気にしないでください。)
State型自体は『s を引数として受け取り、 (a, s)というタプルを返す関数』を保持する型になっています。

*Control.Monad.State> :i State
newtype State s a = State {runState :: s -> (a, s)}
  	-- Defined at Control/Monad/State.hs:97:8-12
instance Monad (State s)
  -- Defined at Control/Monad/State.hs:106:9-23
instance Functor (State s)
  -- Defined at Control/Monad/State.hs:101:9-25
instance MonadFix (State s)
  -- Defined at Control/Monad/State.hs:112:9-26
instance MonadState s (State s)
  -- Defined at Control/Monad/State.hs:115:9-30

ここで a が、Stateの受け渡す値そのものを表し、sは状態を表します。「状態」とはStateモナド内の（手続き言語で言うところの）「グローバル変数」のようなものが一つだけ存在し、この変数に値を「代入」したり取り出したりできるものと考えれば良いでしょう。

Stateモナドの値は、runStateフィールドラベルで取り出せます。State内の値はsを引数に取る関数なので、実質runState関数は二引数関数と考えられます。
実際にはStateモナド m は、状態の初期値を i とした時、「runState m i」のように呼び出せば良いという事です。これは、理屈云々というより、パターンとして覚えてしまったほうが良いでしょう。（そういえば、Arrowも同じようなパターンを使いますね。）

実際に状態に値を「代入」したり、取り出したりするための関数として、getとputが用意されています。

*Control.Monad.State> :i get
class (Monad m) => MonadState s m | m -> s where
  get :: m s
  ...
  	-- Defined at Control/Monad/State.hs:65:1-3
*Control.Monad.State> :i put
class (Monad m) => MonadState s m | m -> s where
  ...
  put :: s -> m ()
  	-- Defined at Control/Monad/State.hs:66:1-3


Stateモナドは、あくまでモナドなので、以上の事を除けば、基本的な書き方はIOモナドの場合と一緒です。

*Control.Monad.State> runState ( return 10 ) 1
(10,1)
*Control.Monad.State> runState ( return 10 >> put 100 ) 1
((),100)
*Control.Monad.State> runState ( get >>= (\x -> put 100 >> return x )) 1
(1,100)

勿論、do構文を使って書くこともできます。

*Control.Monad.State> runState (do{ x <- get; put 100; return x }) 1
(1,100)
*Control.Monad.State> runState (do{ x <- get; y <- return 10; put 100; return (x+y) }) 1
(11,100)

「状態」は、Stateモナド内で呼び出された、別のStateモナドを返す関数にも引き渡されます、つまりStateモナドを返す関数の戻り値は、引数によってい左右され、参照透明性を持たない事になります。
例えば、引数に「状態」を加算するaddState関数を考えます。

*Control.Monad.State> let addState a = do { x <- get; return (x+a) }

この関数は、同じ引数を渡しても、状態によって返す値が異なります。
ghciで少し見辛いですが・・・

*Control.Monad.State> :{
*Control.Monad.State| runState (do {
*Control.Monad.State| put 1;
*Control.Monad.State| x <- addState 100;
*Control.Monad.State| 
*Control.Monad.State| put 10;
*Control.Monad.State| y <- addState 100;
*Control.Monad.State| 
*Control.Monad.State| return $ "x = " ++ (show x) ++ "  y = " ++ (show y)
*Control.Monad.State| }) 0
*Control.Monad.State| :}
("x = 101  y = 110",10)

どちらも、addStateに渡している引数は 100 ですが、それぞれの状態が異なるため、違う値が返却されているのが解ると思います。

次のように、状態を書き換える関数も簡単に書くことができます。

*Control.Monad.State> let putAdd5 a = put (a+5)
*Control.Monad.State> runState (do{ putAdd5 1; x <- get; putAdd5 10; return x }) 0
(6,15)

これは言い換えれば、副作用のある関数です。

このようにStateモナド内では、副作用のある関数、参照透明性を持たない関数を作ったり使ったりする事ができます。（そもそも、getには参照透明性はありませんし、putは副作用があると言えます。）

これは別に、Haskellの純粋さが失われたというわけではありません。
あくまでこれらの影響範囲内はStateモナド内部で、宣言的に「必要に応じて状態をもたせる事ができる」のが、Stateモナドだという事です。

尚、Stateモナドには、runStateの代わりに値や状態のみを返すevalStateやexecState関数、取り出した値や状態を変数に束縛せずに直接書き換える事ができるgetsやputsといった関数もありますが、この場では紹介しません。


前置きが長くなりましたが、ここからが本題です。
確かにStateは汎用的で便利なモナドではあるのですが、

  1. どのような型でも「状態」になり得る
  2. put関数で「状態」を好きな値にすきなように書き換えられてしまう

といった問題があります。

いうなれば、無名のグローバル変数が一つポンと置いてあり「好きに使って良いですよ」という状況なので、プログラマ自身が「状態」そのものに明確なアイデンティティを与え、それを常に考えながらコーディングしなければならないという事です。

自分で「状態系モナド」を作る事ができれば、より安全な形で「状態」を操作できるのでは無いでしょうか。（状態の型や、状態の操作に用いる関数を限定できれば、うんと安全にプログラミングできるはずです。）


というわけで、いつものとおり、Stateモナドの再発明といきましょう。
定義を再掲します。

*Control.Monad.State> :i State
newtype State s a = State {runState :: s -> (a, s)}
  	-- Defined at Control/Monad/State.hs:97:8-12
instance Monad (State s)
  -- Defined at Control/Monad/State.hs:106:9-23
instance Functor (State s)
  -- Defined at Control/Monad/State.hs:101:9-25
instance MonadFix (State s)
  -- Defined at Control/Monad/State.hs:112:9-26
instance MonadState s (State s)
  -- Defined at Control/Monad/State.hs:115:9-30

あえて言うことも無いとは思いますが、Stateモナドは「副作用を起こす」わけでも、「参照透明性が無い」わけでも無く、あくまで「そう見えるように振舞う」という事に注意してください。

今の自分の語彙力で上手く説明できなくてもどかしいのですが、State型の値・・・(s -> (a, s)) という関数の引数として、タプルの二番目の値として・・・水面下で受け渡されているに過ぎません。

State型、そしてStateモナドの定義は次のようになっています。

newtype State s a = State { runState :: s -> (a, s) }

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

このコードについて具体的に説明しようとすると、それだけでまるまる１エントリになってしまう気がするのですが（というか、まだ勉強中です。いずれ書くつもり）、モナドがこのような形になっているおかげで、意識せずとも「状態」の受け渡しが行われるようになっています。

では早速、Stateモナドの再実装である、Sモナドを作ってみます。

newtype S s a = S {runS :: (s -> (a,s)) }
instance Monad (S s) where
  return a = S $ \s -> (a,s)
  m >>= k = S $ \s -> let
    (a,s') = runS m s
    in runS (k a) s'

特にオリジナリティを付け加える必要もありませんし、定義そのままです。

続いて、put関数の再実装であるputS関数、get関数の再実装であるgetS関数をそれぞれ定義します。
Stateモナドのこれらの関数は、モナド変換子も使う関係で、MonadState型クラスに定義されているのですが、今回はそのまま直に書いてしまいましょう。

多態性を考慮してMonadState型クラスのインスタンスにしても良いと思います。

getS = S (\s -> (s,s))
putS s = S (\_ -> ((),s))

実際に手計算してみれば、状態が受け渡されたり書き換えられたりする様子をゆっくり追えるのですが、けっこう大変な（というか大変だった）割にはそれほど得るものは無いのでお勧めはしません。

では、実際に以下のコードの動作を確認してみましょう。

module Main where

newtype S s a = S {runS :: (s -> (a,s)) }
instance Monad (S s) where
  return a = S $ \s -> (a,s)
  m >>= k = S $ \s -> let
    (a,s') = runS m s
    in runS (k a) s'

getS = S (\s -> (s,s))
putS s = S (\_ -> ((),s))

-- 状態モナドを使った計算処理
calc = do
  putS 10
  x <- return 100
  y <- getS
  return (x+y)

-- 動作テスト
main = do
  putStrLn $ "runS  calc = " ++ show (runS calc 0)

実行結果：

$ runghc Main.hs
runS  calc = (110,10)

正しく実行できている事が確認できました。
後は、状況に応じて機能を付け加えたり削ったりすればOKです。


単にStateモナドを再実装しただけでは素っ気無いので、一つ具体例を上げてこのエントリを終わろうと思います。（モナド全般については色々と思うところがあるので、今後ネタが固まり次第書いていくつもりです）

以下は、countup関数が呼ばれるたびに状態をインクリメントしていくCounterモナドです。
正確にcountup関数が呼ばれた回数だけを状態に持ちたいので、putC関数もrunCounterフィールドラベルもエクスポートしていません。その代わり、状態を0で初期化するstartCounter関数を定義してあります。

Counter.hs

module Counter(
  Counter,
  countup,
  getC,
  startCounter
  ) where

--Counterモナド定義
newtype Counter a = Counter {runCounter :: (Int -> (a,Int)) }
instance Monad Counter where
  return a = Counter $ \s -> (a,s)
  m >>= k = Counter $ \s -> let
    (a,s') = runCounter m s
    in runCounter (k a) s'

getC = Counter (\s -> (s,s))
putC s = Counter (\_ -> ((),s))

--状態をインクリメントするcountup関数
countup = do
  x <- getC
  putC (x+1)

--Counterモナド m を初期値 0 から処理する
startCounter m = runCounter m 0

Main.hs

module Main where
import Counter

--テスト用関数定義
test1 :: Counter String 
test1 = do
  countup
  countup
  countup  
  return "test1 success"

test2 :: Counter String 
test2 = do
  test1
  test1
  return "test2 success"

--実行
main :: IO ()
main = do
  putStrLn.show $ startCounter test1
  putStrLn.show $ startCounter test2

実行結果：

$ runghc Main.hs
("test1 success",3)
("test2 success",6)


2012/01/13 追記：
厨二病患者のプログラミング入門 GeneralizedNewtypeDerivingでさよならボイラープレート
http://d.hatena.ne.jp/D_Rascal/20111223/1324646018

GHCで既存のモナドに手を加えるだけならこんな方法も有るみたいです、
ってゆかこっちのほうが確実かも。