bitterharvest’s diary

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

Reactive-bananaの紹介(5)

6. TwoCounters

前回の記事では、upとdownで増減する一つのカウンタを扱ったが、今回は、二つのカウンタを扱うことにする。upとdownのボタンの他にswitchというボタンを用いてカウンタを切替える。

6.1 ユーザ・インタフェース

例によって、ユーザ・インタフェースから始める。upとdownとswitchのボタンと、二つのテキストフィールドを必要とするので、次のようになる。

    f       <- frame [text := "Two Counters"]
    bup     <- button f [text := "Up"]
    bdown   <- button f [text := "Down"]
    bswitch <- button f [text := "Switch Counters"]
    out1    <- staticText f []
    out2    <- staticText f []
    
    set f [layout := margin 10 $
            column 5 [row 5 [widget bup, widget bdown, widget bswitch],
                      grid 5 5 [[label "First Counter:" , widget out1]
                               ,[label "Second Counter:", widget out2]]]]

初期画面はこのようになる。
f:id:bitterharvest:20151202120442p:plain

6.2 イベントに

ボタンをイベントにする必要があるので、次のようにする。

            eup     <- event0 bup     command
            edown   <- event0 bdown   command
            eswitch <- event0 bswitch command

Reactive-bananaのイベントついて説明を加えておく。Reactive-bananaでは、イベントは時間と値をタプルにしたリストとして次のように定義されている。

type Event a = [(Time, a)}

図で表すと次のような感じである。
f:id:bitterharvest:20151202090157p:plain

ここで注意して欲しいのは、Reactive-bananaはHaskellの一員であることから、無限の長さを持つリストが許されることである。これはイベントが無限に続いていてもよいことになる。また、遅延評価が働くので、必要なところまで値が求められ、その後は必要になるときまで待っているということになる。このことをイベントに当てはめて解釈すると、イベントは過去から未来までずっと続いているものとみなすことができる。そして、過去のイベントはすでに評価され、現在のイベントは今まさに評価されていて、未来のイベントはその時が来るまで評価が待たされると解釈できる。イベントが過去から未来まで続く一つのリストだということは、プログラムを記述するときの、大きな進歩の一つとみてよい。直感的には、ホモトピー理論と結びついて、面白いことが起こりそうだなと期待できるが、その話はいつかすることにして、話を元に戻すことにする。

6.3 カウンタの選択

今回のプログラムで一番厄介そうなのは、switchのボタンでカウンタを切替える場面である。切り替えによってどのカウンタが選択されたかを判定しなければならないが、プログラムでは次のようにしている。

最初は、一番目のカウンタが選ばれていることにする。そして、これが選ばれているかどうかについてはブール値で表すこととする。即ち、一番目のカウンタが選ばれていれば「真」、そうでなければ「偽」とする。switchのボタンが押されるごとにnotの関数を発行する。これを、一番目のカウンタが選択されているかどうかを表しているブール値に、適応する。これにより、選択されているかどうかの判定は、ボタンが押されるごとに反転することとなる。

ボタンを押す行為はイベントを起こすことであるが、Reactive-bananaはイベントをリストで表していた。プログラムでは、eswitchがこれに相当する。プログラムを読むときは、eswitchには、過去に押された記録も、現在押されたという事実も、将来押されるかもしれないという予想も含めて、これらのことがリストになっている。そこで、このリストから、ボタンが押された時は関数notが生じるようにしたい。

今、ボタンが押されたことをebで表すことにすると、これをnotに変えるのは、constという関数を用いればよい。constは二つの引数をとり、二番目の引数の値によらず、一番目の引数の値を返すものである。

const not eb

constで少し遊んでみよう。

Prelude> let eb = 1
Prelude> let k = const not eb
Prelude> k True
False
Prelude> k False
True

二番目の引数の値をとりたいのであれば、次のようにconst idを用いる。

Prelude> const id not eb
1

さて、今回の場合は、リストであるので、次のようにする。

fmap (const not) eswitch

これは次のように書き換えることができる。

(fmap . const) not eswitch

fmap . constは中置関数<$で置き換えると次のようになる。

not <$ eswitch

関数notのリストをカウンタ選択の初期値Trueに次から次へと適応させるためには次のようにすればよい。

accumB True $ not <$ eswitch

従って、最初のカウンタが選ばれているかどうかは次のプログラムから得ることができる。

            (firstcounter :: Behavior Bool)
                <- accumB True $ not <$ eswitch

なお、<$はfmap . constの中置関数であったが、<$>はfmapの中置関数である。

6.4 イベント処理の準備

振舞いをイベントに変える関数に<@>と<@がある。

関数<@>はaをbに変えるような振る舞いにおいて、イベントaをもらった時にイベントbに変える。
これは、例を挙げて説明したほうが分かりやすい。<@>の型シグネチャは次のようになっている。

(<@>) :: Behavior (a -> b) -> Event a -> Event b

振舞いは、あるピアノ曲を弾いているとでも想定してもらおう。演奏者は楽譜を読んで、鍵盤をたたいている。楽譜での音符に出くわすがaに相当し、それに対応した鍵盤をたたくがbに相当する。従って、上の記述は、あるピアノ曲を弾こうとしているときに、音符が並んでいる楽譜をもらい、それに従って、たたく鍵盤のリストを出力していることに相当する。

一方、<@の型シグネチャは次のようになっている。

(<@) :: Behavior b -> Event a -> Event b

<@はbという振る舞いから、イベントaをもらった時にイベントbに変える。
下図で、右側が振舞い、左側がイベントである。
f:id:bitterharvest:20151130193531p:plain
この振舞いとイベントを<@で結ぶと、下図に示すように、イベントが生じたときの振舞いの値がイベントとなる。
f:id:bitterharvest:20151130193858p:plain
なお、<@>と<@はモジュールReactive.Banana.Combinatorsで用意されている関数である。

6.5 カウンタの操作

カウンタは二つあるので、タプルを用意して、左側が一番目の、右側が二番目のカウンタの値を表すものとする。

カウンタの値を増やすものとしてincrementという関数を次のように用意する。

increment left _ (x,y) = if left then (x+1,y) else (x,y+1)

この関数は、3個の引数をとる。一番目の引数はどのカウンタが選択されているかを示す。二番目の引数は無視してもらい、三番目の引数は現在のカウンタの値を示す。この関数が呼ばれた時、一番目のカウンタが選択されているとき、即ち、leftが真のとき、タプルの左側が一つ増やされる。そうでないときは右である。

さて、この関数は、upボタンが押された時、カウンタの数を増やす関数だと見なすことにする。このためには、二番目の引数をupボタンが押されたかどうかを示す引数ということにする。ボタンが押されたことだけが意味があるので、値を無視することにすると、引数は_となる。

さて、<@>を用いて、incrementから、ボタンが押された時に、その時のカウンタの値をイベントとして出力するようにしよう。これは、次のようにすればよい。

increment <$> firstcounter <@> eup

一つ減じるものについては同様にdecrementという関数を用意する。

decrement left _ (x,y) = if left then (x-1,y) else (x,y-1)

現在のカウンタの値は、incrementしたものとdecrementしたものとを時間に沿って一緒にすればよい。従って、次のようになる(<@>を用いていること、即ち、fmapを用いていることに注意してほしい。これはBehaviorというモナドでの演算のためである)。

unions [ increment <$> firstcounter <@> eup , decrement <$> firstcounter <@> edown ]

カウンタの初期値を(0,0)にして、プログラムを完成させると次のようになる。

            (counters :: Behavior (Int, Int))
                <- accumB (0,0) $ unions
                    [ increment <$> firstcounter <@> eup
                    , decrement <$> firstcounter <@> edown
                    ]
            let
                increment left _ (x,y) = if left then (x+1,y) else (x,y+1)
                decrement left _ (x,y) = if left then (x-1,y) else (x,y-1)

6.6 プログラム全体

プログラムは、このホームページにあるが、転載する。短いプログラムだが、なかなかタフなプログラムであるとともに、記述能力の高さに感心させられる。

{-----------------------------------------------------------------------------
    reactive-banana-wx
    
    Example: Two Counters.
------------------------------------------------------------------------------}
{-# LANGUAGE ScopedTypeVariables #-}
    -- allows pattern signatures like
    -- do
    --     (b :: Behavior Int) <- stepper 0 ...
{-# LANGUAGE RecursiveDo #-}
    -- allows recursive do notation
    -- mdo
    --     ...

import Graphics.UI.WX hiding (Event)
import Reactive.Banana
import Reactive.Banana.WX

{-----------------------------------------------------------------------------
    Main
------------------------------------------------------------------------------}
main :: IO ()
main = start $ do
    f       <- frame [text := "Two Counters"]
    bup     <- button f [text := "Up"]
    bdown   <- button f [text := "Down"]
    bswitch <- button f [text := "Switch Counters"]
    out1    <- staticText f []
    out2    <- staticText f []
    
    set f [layout := margin 10 $
            column 5 [row 5 [widget bup, widget bdown, widget bswitch],
                      grid 5 5 [[label "First Counter:" , widget out1]
                               ,[label "Second Counter:", widget out2]]]]
    
    let networkDescription :: forall t. MomentIO ()
        networkDescription = mdo

            eup     <- event0 bup     command
            edown   <- event0 bdown   command
            eswitch <- event0 bswitch command
        
            let
            -- do we act on the left button?
            (firstcounter :: Behavior Bool)
                <- accumB True $ not <$ eswitch
        
            -- joined state of the two counters
            (counters :: Behavior (Int, Int))
                <- accumB (0,0) $ unions
                    [ increment <$> firstcounter <@> eup
                    , decrement <$> firstcounter <@> edown
                    ]
            let
                increment left _ (x,y) = if left then (x+1,y) else (x,y+1)
                decrement left _ (x,y) = if left then (x-1,y) else (x,y-1)
    
            sink out1 [text :== show . fst <$> counters]
            sink out2 [text :== show . snd <$> counters]
    
    network <- compile networkDescription    
    actuate network