bitterharvest’s diary

A Bitter Harvestは小説の題名。作者は豪州のPeter Yeldham。苦闘の末に勝ちえた偏見からの解放は命との引換になったという悲しい物語

通常のプログラムをHaskellで記述する(4)

プログラムを書いているときに記憶力を疑うことが多い。プログラミングの経験が豊富なのだから、何も参考にすることなく、画面にプログラムを打ち込んでいけるのだろうと思われることも多いし、自分でもそう思っている。しかし、いざプログラムを打ち込む段になると、初歩的なことが記憶になく、手元にある本をめくって調べていることが多い。昨今の国会答弁ではないが「記憶にありません」と脳から言われる。これは、歳を取ったからという訳ではなく、若い時からそうなのだから、どうも脳の機能に関係しているようだ。

かつて、オーストラリアで自動車の免許を取った時に文化の差に唖然とさせられることがあった。日本ではどのような試験といえども、開始時間と終了時間は厳密に決められている。このようなあり方を疑ったこともない。ところが、オーストラリアでは、自動車免許の学科試験は、開始時間が決まっていない。オフィスの開いている時間であればいつ来てくれても結構となっている。そこで、便利なオーストラリアの免許を修得するために、ある日お昼を食べた後、試験会場に向かった。会場に入ると、何人かの人が試験を受けている。講義机に座っている監督官のところに行って問題用紙を受け取り、何時間の試験ですかと聞いた。監督官は、「何時間かけて下さっても結構ですよ。ただし、オフィスが閉まる時間までには提出してください。」と答えた。厳粛さが全く感じられない、開放的な試験に遭遇して、これまで抱いていた試験へのイメージが一変した。

オーストラリアの大学の期末試験もこのような感じである。このような試験を当たり前としているシドニー大学からの留学生が私の講義を受講した。講義中の受け答えからから優秀な学生だろうと想像したが、期末試験は失敗する可能性が高いのではないかと予想した。オーストラリアと異なり、日本の大学の期末試験は時間が限られている。このため、じっくり考えて答えを出すような学生には不利で、短い時間によさそうな答えを見つけられる学生に対して有利になっている。彼にとってはクイズ番組に出ているような感じだろう。案の定、彼の答案には白紙の部分が多かった。時間をかけることができれば、状況は変わっただろうにとこのとき感じた。

短時間で解答する脳と長い時間を必要とする脳について、長いこと疑問を持ち続けていた。しかし、進化心理学の本を読んでこの疑問に対する解を見つけることができた。二重過程理論(Dual Process Theory)と呼ばれるが、人間の脳は二つの異なるプロセスによって処理されている。一つはヒューリスティックな処理で、他の一つは論理的な処理である。ヒューリスティックな処理は、決められた時間の中でもっともらしい解を瞬時に出す。論理的な処理は、時間をかけて正しいと思われる解を理路整然と引き出す。

人間は、命に係わる状況に陥った時には、それを回避するための行動をすぐにとれるように仕組まれている。ヒューリスティックな処理はこのような状況に対応できるための手段だ。朝、近くの川に沿って散歩することを習慣としていて、1年に1回あるかないかだが、蛇に出くわすことがある。予想もしていないことなので、出会った瞬間に反射的に身を引いてしまう。これはヒューリスティックな処理だ。時間をかけて理性的に考えれば、蛇は臆病な動物なのでまず襲ってくることはない。身を引いて側溝に落ちるような行為をしなくてもよいと後で分かるのだが、これは後の祭りだ。

最近話題の将棋の藤井聡太4段は、時間が無くなってからの後半戦が特に強いので、ヒューリスティックな能力に長けているのだろう。たゆまぬ努力が大きく貢献しているようだが天性の部分も大きい。それに反して、長いことプログラミングをしている私は手元に本を置いての作業とは情けない気がする。彼ほどの能力があれば、反射的にプログラムを書けるのにと思うこともしばしばだ。しかし、決められた時間の中で解決しなければならない作業ではないし、プログラムを書くことで新しい発見もするので、論理的な処理を楽しむことにして、銀行のATMのプログラムを完成させることにしよう。

なお、二重過程理論については前回紹介した『モラル・トライブス』に詳しく書かれている。また、網谷祐一著『理性の起源: 賢すぎる、愚かすぎる、それが人間だ』にも簡潔に紹介されている。
f:id:bitterharvest:20170826102352j:plain

11.4 利息のない預金のプログラム

Pythonで実現した銀行のATMのプログラムをHaskellで実現してみよう。取り敢えず、プログラミングの負荷を少なくするために、利息は付かないものとする。即ち、ただ、預金するだけのとても簡単なプログラムを実現することを考えよう。

状態を有するプログラムでは定石になっている状態を得る関数\(get\)と状態を設定する関数\(put\)を定義しておこう。

get = State (\s -> (s,s))
put s = State (\_ -> ((), s))

それぞれの関数はデータ型\(State\)の値である。\(State\)というコンテナで包まれているが、その中身は関数である。それぞれの関数は、\(get\)では状態をタプルで出力し、\(get\)では入力された状態を挿入して出力する。

それでは、銀行のATMのプログラムの作成に移ろう。\( (a,s)\)で\(a\)は預金額、\(s\)は現在高である。

ATMを使おうとしている段階では現在高だけなので\( (0,s)\)である。ATMに現金を投入した瞬間は\( (a,s)\)である。この預金は銀行の方で処理され現在高が\(s\)から\(s+a\)となる。このとき、預金額と現在高のタプルは\( (0,s+a)\)となる。

まず、預金口座を開設することにしよう。この関数をinitdepとしよう。ある程度の金額を預け入れることで始まる。開設後の状態、即ち現在高は預入額となる。また、関数の型シグネチャは\(s \rightarrow State s b\)であることに注意すると次のようになる。

initdep :: (Num s, Num a) => s -> State s a
initdep s =  put s >>= \_ -> return 0

上記のプログラムで開設時の預け入れによって生まれた現在高\(s\)を入力することにより、預金額と現在額の対を作る。この時、預け入れの処理は終了しているので、預金額は0であることに注意。
\(runState\)でこのプログラムを実行してみよう。

*Main> runState (initdep 500) 0
(0,500)

上記のプログラムで0を入力しているが、この値は\(s\)のデータ型と同じものであればどの値でもよい。例えば、100でもよい。

*Main> runState (initdep 500) 100
(0,500)

それではATMで預金するときの関数\(deposit\)を作成してみよう。ここでは、このプログラムは預け入れの処理を銀行側が終了したときの状態を出力することにしよう。すなわち、預け入れ前の現在高を\(s\)とし、預入額を\(d\)とすると、預け入れ処理が済んだ時の現在高が\(s+d\)に変わる。また、\(initdep\)と型シグネチャが同じであることを考慮して関数を作成すると次のようになる。

deposit :: (Num s, Num a) => s -> State s a
deposit d =  get >>= \s -> put (s + d) >>= \_ -> return 0

それでは、開設した後、100預け入れしたプログラムを、\(initdep\)と\(deposit\)とを\(>=>\)で合成して作成する。\(>=>\)の型シグネチャが\(( a -> State \ s \ b) -> ( b -> State \ s \ c) -> (a -> State \ s \ c)\)であることを考慮すると次のようになる。

*Main> f = (\a -> initdep a) >=> (\_ -> deposit 100)
*Main> runState (f 500) 0
(0,600)

500で開設したとして上記のプログラムを実行する。

*Main> runState (f 500) 0
(0,600)

現在高が600になっていることが確認できた。

同様にさらに50預金したとする。プログラムは

g = (\a -> initdep a) >=> (\_ -> deposit 100) >=> (\_ -> deposit 50)

実行してみよう。

*Main> g = (\a -> initdep a) >=> (\_ -> deposit 100) >=> (\_ -> deposit 50)
*Main> runState (g 500) 0
(0,650)

このように、預け入れ行為を行うたびに、\(deposit\)を前のプログラムに合成させればよいことが分かった。

利息が付く場合については次回の記事で説明しよう。そして、ここまでのプログラムのコードを記しておこう。

(>=>) :: (Monad m) => ( a -> m b) -> ( b -> m c) -> (a -> m c)
f >=> g = \a -> let mb = f a
                in mb >>= g

newtype State s a = State (s -> (a,s))

runState :: State s a -> s -> (a, s)
runState (State f) s = f s

get :: State s s
get = State (\s -> (s,s))

put :: s -> State s ()
put s = State (\_ -> ((), s))

instance Functor (State s) where
    fmap f (State g) = State (\s -> let (a, sa) = g s
                                    in ( f a, sa))

instance Applicative (State s) where
    pure a = State (\s -> (a, s))
    (<*>) mf ma = State (\s -> let (a, sa) = runState ma s
                                   (f, sb) = runState mf sa
                               in ( f a, sb))
instance Monad (State s) where
    ma >>= k = State (\s -> let (a, sa) = runState ma s 
                            in runState (k a) sa)
    return a = State (\s -> (a, s))

deposit :: (Num s, Num a) => s -> State s a
deposit d =  get >>= \s -> put (s + d) >>= \_ -> return 0

initdep :: (Num s, Num a) => s -> State s a
initdep s =  put s >>= \_ -> return 0