# Reactive Bananaで学ぶリアクティブ・プログラミング（４）

### ６．時間

Reactive Bananaでは時間は連続的であるが、ここで説明しているモデルでは、時間は離散的である。

モデルでは、時間は0で始まる自然数を用いて、次の様に定めている。

-- | Natural numbers (poorly represented).
type Nat = Int

-- | The FRP model used in this library is actually a model with continuous time.
--
-- However, it can be shown that this model is observationally
-- equivalent to a particular model with (seemingly) discrete time steps,
-- which is implemented here.
-- The main reason for doing this is to be able to handle recursion correctly.
-- Details will be explained elsewhere.
type Time = Nat -- begins at t = 0


Prelude> :load "Music.hs"
[1 of 2] Compiling Model            ( Model.hs, interpreted )
[2 of 2] Compiling Main             ( Music.hs, interpreted )
Ok, modules loaded: Model, Main.
*Main> play
E {unE = [Just So,Nothing,Just Mi,Just Fa,Just So,Nothing,Just La,Nothing,Just So,Nothing,Just Mi,Just Fa,Just So,Nothing,Just Do5,Nothing,Just La,Nothing,Just So,Nothing,Just Mi,Nothing,Nothing,Just Do,Just Re,Nothing,Nothing,Nothing,Nothing,Nothing,Just Rest,Nothing,Just So,Nothing,Just La,Just So,Just Mi,Nothing,Just So,Nothing,Just Do5,Nothing,Just Re5,Just Do5,Just La,Nothing,Just Do5,Nothing,Just So,Nothing,Just Mi5,Nothing,Just Re5,Nothing,Nothing,Just So,Just Do5,Nothing,Nothing,Nothing,Nothing,Nothing,Just Rest,Nothing]}


これは、時間0ではソを打鍵し、時間1では何もせず、時間2ではミを打鍵し、時間3ではファを打鍵し、時間4ではソを打鍵することを表している。

### ７．振舞い

イベントplayを実行することで、即ち、ピアノの鍵盤を打つことで、一つの曲が得られる。リアクティブ・プログラミングでは、時間とともに変わっていくこのような性質を振舞い（ビヘイビア）と呼んでいる。

-- | Behavior is modeled by an /infinite/ list of values.
-- It is isomorphic to @Time -> a@.
newtype Behavior a = B { unB :: [a] } deriving (Show)


ピアノで鍵盤をたたくと、曲となって音が流れる。ここで、一つの制約をすることにする。即ち、次の鍵盤が打鍵されるまで、直前に打鍵された音階が続くものとする。また、Restは休止音符を表しているが、これが来ると無音となることにする。

stepper :: a -> Event a -> Moment (Behavior a)
stepper i e = M $\time -> B$ replicate 1 $step i (unE e) !! time where step i ~(x:xs) = i : step next xs where next = case x of Just i -> i Nothing -> i  stepperの関数において、iは初期値である。eはイベントである。 上記で、Momentというデータ型を使用しているが、これはある時間での値を教えてくれる。次のように定義されている。 newtype Moment a = M { unM :: Time -> a }  それでは、stepperを用いて、playが奏でる曲musicを次のように定義する。初期値は音の出ない鍵盤を打つこと,すなわち、Restとする。 music = stepper Rest play  時間は、８分音符が一単位となっているので、それぞれの時間でどのような音が奏でられているかを調べると次のようになる。 *Main> :load "Music.hs" [1 of 2] Compiling Model ( Model.hs, interpreted ) [2 of 2] Compiling Main ( Music.hs, interpreted ) Ok, modules loaded: Model, Main. *Main> unM music 0 B {unB = [Rest]} *Main> *Main> unM music 1 B {unB = [So]} *Main> unM music 2 B {unB = [So]} *Main> unM music 3 B {unB = [Mi]} *Main> unM music 4 B {unB = [Fa]} *Main> unM music 5 B {unB = [So]} *Main> unM music 6 B {unB = [So]} *Main> unM music 7 B {unB = [La]} *Main> unM music 8 B {unB = [La]} *Main> unM music 9 B {unB = [So]} *Main> unM music 10 B {unB = [So]} *Main> unM music 11 B {unB = [Mi]} *Main> unM music 12 B {unB = [Fa]} *Main> unM music 13 B {unB = [So]} *Main> unM music 14 B {unB = [So]} *Main> unM music 15 B {unB = [Do5]} *Main> unM music 16 B {unB = [Do5]} *Main> unM music 17 B {unB = [La]} *Main> unM music 18 B {unB = [La]} *Main> unM music 19 B {unB = [So]} *Main> unM music 20 B {unB = [So]} *Main> unM music 21 B {unB = [Mi]} *Main> unM music 22 B {unB = [Mi]} *Main> unM music 23 B {unB = [Mi]} *Main> unM music 24 B {unB = [Do]} *Main> unM music 25 B {unB = [Re]} *Main> unM music 26 B {unB = [Re]} *Main> unM music 27 B {unB = [Re]} *Main> unM music 29 B {unB = [Re]} *Main> unM music 30 B {unB = [Re]} *Main> unM music 31 B {unB = [Rest]} *Main> unM music 32 B {unB = [Rest]}  時間１にはソ、時間１にもソ、時間１にはミ、時間１にはファが奏でられていることが分かる。 ### ８．プログラム プログラムを掲載すると次のようになる。 import Model data Scale = Do | Re | Mi | Fa | So | La | Si | Do5 | Re5 | Mi5 | Fa5 | So5 | La5 | Si5 | Rest deriving (Show, Read, Eq, Ord) score1 = [ Just So, Nothing, Just Mi, Just Fa, Just So, Nothing, Just La, Nothing] score2 = [ Just So, Nothing, Just Mi, Just Fa, Just So, Nothing, Just Do5, Nothing] score3 = [ Just La, Nothing, Just So, Nothing, Just Mi, Nothing, Nothing, Just Do] score4 = [ Just Re, Nothing, Nothing, Nothing, Nothing, Nothing, Just Rest, Nothing] score5 = [ Just So, Nothing, Just La, Just So, Just Mi, Nothing, Just So, Nothing] score6 = [ Just Do5, Nothing, Just Re5, Just Do5, Just La, Nothing, Just Do5, Nothing] score7 = [ Just So, Nothing, Just Mi5, Nothing, Just Re5, Nothing, Nothing, Just So] score8 = [ Just Do5, Nothing, Nothing, Nothing, Nothing, Nothing, Just Rest, Nothing] play = E$ score1 ++ score2 ++ score3 ++ score4 ++ score5 ++ score6 ++ score7 ++ score8

music = stepper Rest play


また、モデルのプログラムは、元々のものに、stepperの関数が変えてあるが次のようになる。

{-----------------------------------------------------------------------------
reactive-banana
------------------------------------------------------------------------------}
{-# LANGUAGE RecursiveDo #-}
module Model (
-- * Synopsis
-- | Model implementation for learning and testing.

-- * Overview
-- $overview -- * Core Combinators -- ** Event and Behavior Nat, Time, Event(..), Behavior(..), interpret, -- ** First-order module Control.Applicative, never, unionWith, filterJust, apply, -- ** Moment and accumulation Moment(..), accumE, stepper, -- ** Higher-order valueB, observeE, switchE, switchB, ) where import Control.Applicative import Control.Monad import Control.Monad.Fix {-$overview

This module reimplements the key FRP types and functions from the module
"Reactive.Banana.Combinators" in a way that is hopefully easier to understand.
Thereby, this model also specifies the semantics of the library.
Of course, the real implementation is much more efficient than this model here.

To understand the model in detail, look at the source code!
(If there is no link to the source code at every type signature,
then you have to run cabal with --hyperlink-source flag.)

This model is /authoritative/:
Event functions that have been constructed using the same combinators
/must/ give the same results when run with the @interpret@ function
from either the module "Reactive.Banana.Combinators"
or the module "Reactive.Banana.Model".
This must also hold for recursive and partial definitions
(at least in spirit, I'm not going to split hairs over @_|_@ vs @\\_ -> _|_@).

-}

{-----------------------------------------------------------------------------
Event and Behavior
------------------------------------------------------------------------------}
-- | Natural numbers (poorly represented).
type Nat = Int

-- | The FRP model used in this library is actually a model with continuous time.
--
-- However, it can be shown that this model is observationally
-- equivalent to a particular model with (seemingly) discrete time steps,
-- which is implemented here.
-- The main reason for doing this is to be able to handle recursion correctly.
-- Details will be explained elsewhere.
type Time = Nat -- begins at t = 0

-- | Event is modeled by an /infinite/ list of 'Maybe' values.
-- It is isomorphic to @Time -> Maybe a@.
--
-- 'Nothing' indicates that no occurrence happens,
-- while 'Just' indicates that an occurrence happens.
newtype Event a = E { unE :: [Maybe a] } deriving (Show)

-- | Behavior is modeled by an /infinite/ list of values.
-- It is isomorphic to @Time -> a@.
newtype Behavior a = B { unB :: [a] } deriving (Show)

interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> [Maybe b]
interpret f as =
take (length as) . unE . (\m -> unM m 0) . f . E $(as ++ repeat Nothing) {----------------------------------------------------------------------------- First-order ------------------------------------------------------------------------------} instance Functor Event where fmap f (E xs) = E (fmap (fmap f) xs) instance Functor Behavior where fmap f (B xs) = B (fmap f xs) instance Applicative Behavior where pure x = B$ repeat x
(B f) <*> (B x) = B $zipWith ($) f x

never :: Event a
never = E $repeat Nothing unionWith :: (a -> a -> a) -> Event a -> Event a -> Event a unionWith f (E xs) (E ys) = E$ zipWith combine xs ys
where
combine (Just x) (Just y) = Just $f x y combine (Just x) Nothing = Just x combine Nothing (Just y) = Just y combine Nothing Nothing = Nothing filterJust :: Event (Maybe a) -> Event a filterJust = E . fmap join . unE apply :: Behavior (a -> b) -> Event a -> Event b apply (B fs) = E . zipWith (\f mx -> fmap f mx) fs . unE {----------------------------------------------------------------------------- Moment and accumulation ------------------------------------------------------------------------------} newtype Moment a = M { unM :: Time -> a } instance Functor Moment where fmap f = M . fmap f . unM instance Applicative Moment where pure = M . const (<*>) = ap instance Monad Moment where return = pure (M m) >>= k = M$ \time -> unM (k $m time) time instance MonadFix Moment where mfix f = M$ mfix (unM . f)

-- Forget all event occurences before a particular time
forgetE :: Time -> Event a -> [Maybe a]
forgetE time (E xs) = drop time xs

{-
stepper :: a -> Event a -> Moment (Behavior a)
stepper i e = M $\time -> B$ replicate time i ++ step i (forgetE time e)
where
step i ~(x:xs) = i : step next xs
where next = case x of
Just i  -> i
Nothing -> i
-}
stepper :: a -> Event a -> Moment (Behavior a)
stepper i e = M $\time -> B$ replicate 1 $step i (unE e) !! time where step i ~(x:xs) = i : step next xs where next = case x of Just i -> i Nothing -> i -- Expressed using recursion and the other primitives -- FIXME: Strictness! accumE :: a -> Event (a -> a) -> Moment (Event a) accumE a e1 = mdo let e2 = ((\a f -> f a) <$> b) apply e1
b <- stepper a e2
return e2

{-----------------------------------------------------------------------------
Higher-order
------------------------------------------------------------------------------}
valueB :: Behavior a -> Moment a
valueB (B b) = M $\time -> b !! time observeE :: Event (Moment a) -> Event a observeE = E . zipWith (\time -> fmap (\m -> unM m time)) [0..] . unE switchE :: Event (Event a) -> Moment (Event a) switchE es = M$ \t -> E $replicate t Nothing ++ switch (unE never) (forgetE t (forgetDiagonalE es)) where switch (x:xs) (Nothing : ys) = x : switch xs ys switch (x: _) (Just xs : ys) = x : switch (tail xs) ys forgetDiagonalE :: Event (Event a) -> Event [Maybe a] forgetDiagonalE = E . zipWith (\time -> fmap (forgetE time)) [0..] . unE switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a) switchB b e = diagonalB <$> stepper b e

diagonalB :: Behavior (Behavior a) -> Behavior a
diagonalB = B . zipWith (\time xs -> xs !! time) [0..] . map unB . unB