１０．Wave
クリスマスは過ぎてしまったが、今年もまた、いろいろなところでイルミネーションを楽しむことができた。今回の話題は、飾り立てたイルミネーションには豪華さでは到底及ばないが、技術的な深みでは凌駕していると思われる光のウェイブが伝搬するプログラムの紹介である。
このプログラムでは、15個のランプが用意されている。ランプは通常は黒であるが、点灯すると赤になる。また、光のウェイブ（点灯したランプが移動していく）を左あるいは右から発生させる二つのボタンが用意されている。
例えば、右のボタンを押すと、右隅から点灯したランプが左側に移動してゆく。この時、同時に点灯しているランプは連続した4個である（もちろん、点灯したランプが隅にあるときは、端で欠けた分だけ少なくなる）。
ボタンはいつ押しても構わない。一回押すと、光のウェイブが一度だけ生じる。もし、光のウェイブが発生しているときにボタンを押すと、このイベントは記憶され、今のウェイブが終了したときに、これに応じた新たなウェイブが生じる。もし、ウェイブの間にボタンが複数回押された場合でも、押された順番に従って、光のウェイブが順番に生じる。
画面は以下に示すようなものとなる。
１０．１ プログラムの構成
このプログラムは、実は、かなり手が込んでいる。読み解くのにかなりの時間を必要としたが、ファンクショナル・リアクティブ・プログラミング(FRP)の面白さがいろいろあって有意義なプログラムであった。
まずは、プログラムがどのように構成されているかを説明しよう。最初に光のウェイブについて考える。光のウェイブは両方向あるが、左側から右に伝搬していくものを考えると、次のようになる。
1.定められた時間だけ、左端のランプを点灯する。
2.定められた時間だけ、左端の二つのランプを点灯する。
3.定められた時間だけ、左端の三つのランプを点灯する。
4.定められた時間だけ、左端の四つのランプを点灯する。
5.定められた時間だけ、左端から数えて2番目から5番目までの四つのランプを点灯する。
6.定められた時間だけ、左端から数えて3番目から6番目までの四つのランプを点灯する。
.....
15.定められた時間だけ、左端から数えて12番目から15番目までの四つのランプを点灯する。
16.定められた時間だけ、左端から数えて13番目から15番目までの三つのランプを点灯する。
17.定められた時間だけ、左端から数えて14番目から15番目までの二つのランプを点灯する。
18.定められた時間だけ、左端から数えて15番目のランプを点灯する。
上記一つ一つを点滅パターンと呼ぶことにする。1から19までの点滅パターンを、このままの順番で、リストにしたものをウェイブ・リストと呼ぶことにする（これは、右側から伝搬するものについても同様に作成できる）。
今、上記の定められた時間を点灯時間と呼ぶことにすると、点灯時間ごとに、ウェイブ・リストから点滅パターンを順番に呼び出してきて、実行すれば、希望しているウェイブが得られることがわかる。
また、光のウェイブを要求するボタンが押されたときは、ウェイブリストを作成して、上記の操作を行えばよい。また、光のウェイブが実行されているときに、ボタンが押されたならば、現在のウェイブ・リストに新たに作られたウェイブ・リストをつければよい。
１０．２ イベント・ネットワークの構築
最初に、ランプの数lightCount、点灯するランプの数waveLength、点灯時間、この場合はその半分の時間dtを、定数で用意する。
lightCount :: Int lightCount = 15 -- number of lights that comprise the wave waveLength :: Int waveLength = 4 -- number of lights that are lit at once dt :: Int dt = 70 -- half the cycle duration
入力
例によって、描画のためのフレームfを用意する。
f <- frame [text := "Waves of Light"]
次に、ウェイブの発生を要求するボタンを二つ（一つは左からのウェイブ、他は右から）用意する。
left <- button f [text := "Left"] right <- button f [text := "Right"]
次にランプを15個用意する。
lights <- replicateM lightCount $ staticText f [text := "•"]
次にこれらをフレームの中に物理的に納める。
set f [layout := margin 10 $ column 10 [row 5 [widget left, widget right], row 5 $ map widget lights] ]
またタイマーを必要とするので、これも用意する。タイマーの間隔は1ミリ秒である。
t <- timer f []
イベント・グラフ
ボタンが押された時にイベントを発火させるイベント・グラフは、例によって、次のようになる。
eLeft <- event0 left command eRight <- event0 right command
次に、点滅パターンをイベントとして取り出すイベント・グラフを考える。前の説明で、ウェイブ・リストの話をしたが、これについてもう少し説明を加える。ウェイブ・リストでは、先頭にある点滅パターンがイベントとなる。この時、このパターンはウェブリストから取り除かれる。この点灯は2*dt時間続く。これが過ぎるとタイマーによって新たなイベントが発生し、次の点滅パターン（この時はこれがウェイブ・リストの先頭にある）がイベントとして取り出される。
点滅パターンは次のようになっている。
1.に対しては、[(f 1, True)]
2.に対しては、[(f 2, True)]
3.に対しては、[(f 3, True)]
4.に対しては、[(f 4, True)]
5.に対しては、[(f 5, True),(f 1, False)]
6.に対しては、[(f 6, True),(f 2, False)]
...
15.に対しては、[(f 15, True),(f 11, False)]
16.に対しては、[(f 12, False)]
17.に対しては、[(f 13, False)]
18.に対しては、[(f 14, False)]
19.に対しては、[(f 15, False)]
ここで、fの次の数字はインデックスである。fは左から数えるのか、右から数えるのかを示す。左のボタンを押したときは左から数えることになる。右のボタンについても同様である。
点滅パターンをイベントとして発生する関数は、後で定義するが、schduleQueueである。これは、タイマーとボタンが押されたことにより生じるイベントを引数に持つ。プログラムは次のようになっている。
eWave <- scheduleQueue t $ unionWith (++) (waveLeft <$ eLeft ) (waveRight <$ eRight)
出力
ここで得たいのは、それぞれのランプの振舞いである。ランプはついたり消えたりするが、これがランプの振舞いとなる。そこで、これまでに説明してきたウェイブ・リストを受け取った時に、ランプがどのような振舞うかを記述しよう。話を簡単にするために、システムがスタートして少し経った後のt=1の時に最初の点滅パターンを実行し、t=2の時に次の点滅パターンを実行したとする。この時、6番目のランプは、t=6で点灯し、t=10で消灯となる。stepperの関数を用いると、以下の図になる。
上記の説明をプログラムで表すと次のようになる。
-- animate the lights forM_ [1 .. lightCount] $ \k -> do let bulb = lights !! (k-1) colorize True = red colorize False = black bBulb <- stepper False $ snd <$> filterE ((== k) . fst) eWave sink bulb [ color :== colorize <$> bBulb ]
ここまでのプログラムをまとめると以下のようになる。
{----------------------------------------------------------------------------- reactive-banana-wx Example: Emit a wave of lights. Demonstrates that reactive-banana is capable of emitting timed events, even though it has no built-in notion of time. ------------------------------------------------------------------------------} {-# LANGUAGE ScopedTypeVariables #-} -- allows pattern signatures like -- do -- (b :: Behavior Int) <- stepper 0 ... {-# LANGUAGE RecursiveDo #-} -- allows recursive do notation -- mdo -- ... import Control.Monad import qualified Data.List as List import Data.Ord import Graphics.UI.WX hiding (Event) import Reactive.Banana import Reactive.Banana.WX {----------------------------------------------------------------------------- Main ------------------------------------------------------------------------------} lightCount :: Int lightCount = 15 -- number of lights that comprise the wave waveLength :: Int waveLength = 4 -- number of lights that are lit at once dt :: Int dt = 70 -- half the cycle duration main :: IO () main = start $ do -- create window and widgets f <- frame [text := "Waves of Light"] left <- button f [text := "Left"] right <- button f [text := "Right"] lights <- replicateM lightCount $ staticText f [text := "•"] set f [layout := margin 10 $ column 10 [row 5 [widget left, widget right], row 5 $ map widget lights] ] -- we're going to need a timer t <- timer f [] let networkDescription :: MomentIO () networkDescription = do eLeft <- event0 left command eRight <- event0 right command -- event describing all the lights eWave <- scheduleQueue t $ unionWith (++) (waveLeft <$ eLeft ) (waveRight <$ eRight) -- animate the lights forM_ [1 .. lightCount] $ \k -> do let bulb = lights !! (k-1) colorize True = red colorize False = black bBulb <- stepper False $ snd <$> filterE ((== k) . fst) eWave sink bulb [ color :== colorize <$> bBulb ] network <- compile networkDescription actuate network
１０．３ ウェイブ・リスト
ここでは、ウェイブ・リストを作成するプログラムwaveがどのようになっているかを説明する。
waveでは、それぞれの点滅パターンに対して、いつ実行されるのかについての情報を付加することとする。
k番目のランプについて考えることにする。このランプが点灯されるのは、このウェイブの処理が始まってからk*2*dt時間後である。ここで、2*dtは一つの点滅パターンが実行される時間、即ち、この間での点灯時間である。ランプが消されるのは、点灯してからwavelength個の点滅パターンが経過した後なので、(k+wavelength)*2*dtであるが、点灯とのイベントと一緒になるのを避けるため、点灯のサイクルから半分遅らせて、dt+(k+wavelength)*2*dtとする。
これより、点灯と消灯の点滅パターンに、実行時間の情報を付したものは、次のようになる。
ons = [(k*2*dt, (f k, True)) | k <- [1..lightCount]] offs = [(dt+(waveLength+k)*2*dt, (f k, False)) | k <- [1..lightCount]] sink bulb [ color :== colorize <$> bBulb ]
これを早い方から順番にマージしたものは次のようになる。
merge xs ys = List.sortBy (comparing fst) $ xs ++ ys
並べ替えが済んだので、実行時間を絶対的なものではなく、直前に実行されるイベントとの差をとるようにする。差を求める関数はdeltasとする。
deltas xs = zipWith relativize (0 : map fst xs) xs where relativize dt1 (dt2,x) = (dt2-dt1, x)
これらをまとめるとwaveのプログラムとなる。
type Index = Int type Action = (Index, Bool) -- describe wave pattern as a listwave :: (Index -> Index) -> [(Duration, Action)] wave f = deltas $ merge ons offs where merge xs ys = List.sortBy (comparing fst) $ xs ++ ys deltas xs = zipWith relativize (0 : map fst xs) xs where relativize dt1 (dt2,x) = (dt2-dt1, x) ons = [(k*2*dt, (f k, True)) | k <- [1..lightCount]] offs = [(dt+(waveLength+k)*2*dt, (f k, False)) | k <- [1..lightCount]]
なお、waveの引数fはウェイブの方向を示す。
左からのボタンが押された時は、以下のリストが出力される。
[(2*dt,(f 1, True)),(2*dt,(f 2, True)),(2*dt,(f 3, True)),(2*dt,(f 4, True)),(2*dt,(f 5, True)),(dt,(f 1, False)),(dt,(f 6, True)),(dt,(f 2, False)), ..... (dt,(f 15, True)),(dt,(f 11, False)),(2*dt,(f 12, False)),(2*dt,(f 13, False)),(2*dt,(f 14, False)),(2*dt,(f 15, False))]
左から始める場合と右側から始める場合があるが、これは次の関数waveLeft,waveRightで対応できる。
waveLeft :: [(Duration, Action)] waveLeft = wave id waveRight :: [(Duration, Action)] waveRight = wave (\k -> lightCount - k + 1)
１０．４ スケジューリング
さて、最後になったが、点滅パターンをどのようにスケジューリングしているかを見ることとする。この関数の名前は、scheduleQueueである。これは、ウェイブを起こすボタンを押すとwaveからの出力をリストでもらう。リストの要素（例えば、(dt,(f 6, True))）は、待ち時間（dt）と点灯（(f 6, True))）パターンのリストとなっている。また、タイマーを、待ち時間が完了したことを知らせるアラームとして使うことができる。
まず、ボタンが押された場合を考える。
この時、スケジューリングされているものがなければ、即ち、処理すべき点滅パターンがない時は、waveからの出力をそのまま、スケジューリングのリストにする。そして、リストの最初の要素から待ち時間を取り出し、アラームをセットする。
すでにスケジューリングされているものが存在しているときには、その最後に、waveからの出力されたリストをそれにつなぐ。
プログラムで表すと次のようになる。
add ys [] = (wait (fst $ head ys), ys) add ys xs = (idle, xs ++ ys)
次に、タイマーが鳴った時の処理を考える。これは、スケジューリングされているリストの最初の点滅パターンを実行する。これと同時に次の準備をする。もし、これに続く要素がない場合には何もしない。これに続く要素があれば、その待ち時間を取り出し、タイマーを設定し、呼び出されるのを待つ。プログラムでは次のようになる。
remove (_:[]) = (stop, []) remove (_:xs) = (wait (fst $ head xs), xs)
wait,stop,idleはアラームの設定にかかわるので、次のようにする。
wait dt = set t [ enabled := True, interval := dt ] stop = set t [ enabled := False ] idle = return ()
これを用いると、次の待ち時間と実行を持っている点滅パターンのリストとのタプルは次のように求めることができる。
(eSetNewAlarmDuration, bQueue)
<- mapAccum [] $ unionWith const (remove <$ eAlarm) (add <$> e)
let
-- change queue and change timer
remove (_:[]) = (stop, [])
remove (_:xs) = (wait (fst $ head xs), xs)
add ys [] = (wait (fst $ head ys), ys)
add ys xs = (idle, xs ++ ys)
wait dt = set t [ enabled := True, interval := dt ]
stop = set t [ enabled := False ]
idle = return ()
また、アラームが鳴った時は最初の要素を取り出すが、その時の処理は次のようになる。
eout = fmap (snd . head) $ bQueue <@ eAlarm
これより、scheduleQueueのプログラムは次のようになる。
type Duration = Int -- in milliseconds type Queue a = [(Duration, a)] -- [(time to wait, occurrence to happen)] type Enqueue a = Queue a -- Schedule events to happen after a given duration from their occurrence -- However, new events will *not* be scheduled before the old ones have finished. scheduleQueue :: Timer -> Event (Enqueue a) -> MomentIO (Event a) scheduleQueue t e = mdo liftIO $ set t [ enabled := False ] eAlarm <- event0 t command -- (Queue that keeps track of events to schedule -- , duration of the new alarm if applicable) (eSetNewAlarmDuration, bQueue) <- mapAccum [] $ unionWith const (remove <$ eAlarm) (add <$> e) let -- change queue and change timer remove (_:[]) = (stop, []) remove (_:xs) = (wait (fst $ head xs), xs) add ys [] = (wait (fst $ head ys), ys) add ys xs = (idle, xs ++ ys) wait dt = set t [ enabled := True, interval := dt ] stop = set t [ enabled := False ] idle = return () -- Return topmost value from the queue whenever the alarm rings. -- The queue is never empty when the alarm rings. eout = fmap (snd . head) $ bQueue <@ eAlarm reactimate eSetNewAlarmDuration return eout
