bitterharvest’s diary

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

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

子供の頃に喉から手が出るほどに欲しかったものを多くの人は覚えているだろう。それも自分の小遣いでは到底手が届かないほど高値のものを切望したのではないだろうか。デパートと言われるものが全盛だった頃、おもちゃ売り場は何とも楽しい場所だった。その中でも、動く鉄道模型は人気の場所だった。ジオラマという言葉はまだ使われていなかったので、なんと呼ばれていたのかは今となっては分からないが、線路を切り替えて機関車を思い通りに走らせることができるレイアウトはいつも子供たちで一杯だった。

そんな子供の時の夢をかなえるために、2年がかりでジオラマを作成した。孫にも一部手伝わせて、この夏やっと完成した。とりあえず、動画を楽しんで頂こう。

路線は外側の新幹線と内側のローカル線だ。線路は9mmの幅しかないけれども、4両編成の新幹線が脱線することもなく走行してくれる。新幹線も線路も精巧にできているのだなあと感心する。ジオラマは右側が里山、中央が都会、左側が下町という設定だ。広い場所を必要とするので、夏休み中だけ家族に公開している。

3.5 銀行のATMを完成させる

それでは、利息の計算まで含めてプログラムを完成することにしよう。状態の方は、利率\(i\)と現在高\(c\)のタプル\((i,c)\)となる。また、入力は、預金高\(d\)と前回の預け入れからの期間\(p\)のタプル\((d,p)\)となる。銀行口座を開設する関数\(initdep\)は入力の部分を新しいタプルに変えるだけなので次のようになる。

initdep :: (Floating a, Floating b, Floating c, Floating d) => (c, d) -> State (c, d) (a, b)
initdep (i,c) =  put (i,c) >>= \_ -> return (0,0)

それでは預金の関数\(deposit\)を作成しよう。これも、入力と状態のところを新しいタプルに変えるだけなので、次のようになる。

deposit :: (Floating a, Floating b) => (b, b) -> State (b, b) (a,a)
deposit (d,p) =  get >>= \(i,s) -> put ((i,s + d + i ** p)) >>= \_ -> return (0,0)

利用してみよう。開設時の預金額を500とし、利率を1.001としよう。そして5期間経過した後に30預金したとしよう。これは、開設時の関数\(initdep\)と預金の関数\(deposit\)を合成すればよいので次のようになる。

f = (\a -> initdep a) >=> (\_ -> deposit (30,5))
*Main> runState (f (1.001, 500)) (0,0) 
((0.0,0.0),(1.001,531.005010010005))

うまく動いているようだ。さらに、4期間経過した後に20預金したとしよう。これはさらに預金の関数\(deposit\)を合成すればよいので次のようになる。

*Main> g = (\a -> initdep a) >=> (\_ -> deposit (30,5)) >=> (\_ -> deposit (20,4))
*Main> runState (g (1.001, 500)) (0,0) 
((0.0,0.0),(1.001,552.009016014006))

大丈夫のようだ。
それでは、引出の関数\(withdraw\)を作成しよう。これは預金が加算であったのに対し、減算となるので次のようになる。

withdraw :: (Floating a, Floating b) => (b, b) -> State (b, b) (a,a)
withdraw (d,p) =  get >>= \(i,s) -> put ((i,s - d + i ** p)) >>= \_ -> return (0,0)

それでは、さらに6期間経過した後で50引出したとしよう。同じように次のようになる。

*Main> h = (\a -> initdep a) >=> (\_ -> deposit (30,5)) >=> (\_ -> deposit (20,4)) >=> (\_ -> withdraw (50,6))
*Main> runState (h (1.001, 500)) (0,0) 
((0.0,0.0),(1.001,503.015031034021))

これで基本的な部分は終了である。

\(initdep,deposit,withdraw\)がコマンドのように利用されているのが分かることと思う。これを強調するには糖衣構文を作成して、利用するとよい。Haskellでは\(do\)という構文が用意されている。
また、上記のプログラムをより洗練するためには、金額は通常は正の整数なのでそのための処理も加える必要がある。これについては、読者の方で試みて欲しい。

プログラムの全体は次のようになっている。

(>=>) :: (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 :: (Floating a, Floating b) => (b, b) -> State (b, b) (a,a)
deposit (d,p) =  get >>= \(i,s) -> put ((i,s + d + i ** p)) >>= \_ -> return (0,0)

withdraw :: (Floating a, Floating b) => (b, b) -> State (b, b) (a,a)
withdraw (d,p) =  get >>= \(i,s) -> put ((i,s - d + i ** p)) >>= \_ -> return (0,0)

initdep :: (Floating a, Floating b, Floating c, Floating d) => (c, d) -> State (c, d) (a, b)
initdep (i,c) =  put (i,c) >>= \_ -> return (0,0)