git.iko.soy/elk
on 63243ca help sign in
elk/libraries/AutomatonV2.elm.hidden
149 lines 5.8 kB history raw
1module AutomatonV2 where
2{-| This library is a way to package up dynamic behavior. It makes it easier to
3dynamically create dynamic components. See the [original release
4notes](/blog/announce/version-0.5.0.elm) on this library to get a feel for how
5it can be used.
6-}
8import open Basics
9import Signal (lift,foldp,Signal)
10import open List
11import Maybe (Just, Nothing)
13data Automaton input output = Pure (input -> output)
14 | Stateful state (input -> state -> (output,state))
16-- The basics
18-- AFRP name: arr
19pure: (i -> o) -> Automaton i o
20pure = Pure
22-- AFRP name: >>>
23andThen: Automaton i inter -> Automaton inter o -> Automaton i o
24andThen first second =
25 case first of
26 Pure f -> case second of -- f is the function from first
27 Pure s -> Pure (s . f) -- s is the function from second
28 Stateful b s -> Stateful b (\i -> s (f i)) -- b is the base state from second
29 Stateful fb f -> case second of -- fb is the base state from first
30 Pure s -> Stateful fb (\i st -> -- sb is the base state from second
31 let (inter, st') = f i st -- i is the input
32 in (s inter, st')) -- st is the input state
33 Stateful sb s -> Stateful (fb, sb) (\i (fst, sst) -> -- inter is the intermediate value
34 let (inter, fst') = f i fst -- st' is the new state
35 (o, sst') = s inter sst -- fst and sst are the state of first and second
36 in (o, (fst', sst'))) -- ect...
38-- AFRP name: first
39extendDown: Automaton i o -> Automaton (i,extra) (o,extra)
40extendDown auto = case auto of
41 Pure fun -> Pure (\(i,extra) -> (fun i, extra))
42 Stateful base fun -> Stateful base (\(i,extra) s -> (fun i s, extra))
44-- AFRP name: loop
45loop: s -> Automaton (i,s) (o,s) -> Automaton i o
46loop base auto = case auto of
47 Pure fun -> Stateful base (curry fun)
48 Stateful base2 fun -> -- fun: (i, s) -> s2 -> ((o, s), s2)
49 let newFun = (\i (s,s2) ->
50 let ((o, s'), s2') = fun (i, s) s2
51 in (o, (s', s2'))) -- newFun: i -> (s, s2) -> (o, (s, s2))
52 in Stateful (base, base2) newFun
54-- Run an automaton on a given signal
55run: Automaton i o -> o -> Signal i -> Signal o
56run auto baseOut input = case auto of
57 Pure fun -> lift fun input
58 Stateful base fun -> lift fst
59 (foldp (\i (o, s) -> fun i s)
60 (baseOut, base) input)
63-- Other frequently used functions/operators
65-- Create an automaton with state. Requires an initial state and a step
66-- function to step the state forward. For example, an automaton that counted
67-- how many steps it has taken would look like this:
68--
69-- count = Automaton a Int
70-- count = state 0 (\\_ c -> c+1)
71--
72-- It is a stateful automaton. The initial state is zero, and the step function
73-- increments the state on every step.
74state : s -> (i -> s -> s) -> Automaton i s
75state base fun = loop base (pure (\(i,s) ->
76 let s' = fun i s
77 in (s',s')))
79-- Create an automaton with hidden state. Requires an initial state and a
80-- step function to step the state forward and produce an output.
81hiddenState : s -> (i -> s -> (s,o)) -> Automaton i o
82hiddenState base fun = loop base (pure (\(i,s) ->
83 let (o,s') = fun i s
84 in (s',o)))
86-- AFRP name: second
87extendUp: Automaton i o -> Automaton (extra,i) (extra,o)
88extendUp auto =
89 let swap (a, b) = (b, a)
90 in pure swap `andThen` extendDown auto `andThen` pure swap
92-- (parallel composition)
93pair: Automaton i1 o1 -> Automaton i2 o2 -> Automaton (i1,i2) (o1,o2)
94pair f g = extendDown f `andThen` extendUp g
96branch : Automaton i o1 -> Automaton i o2 -> Automaton i (o1,o2)
97branch f g =
98 let double = pure (\i -> (i,i))
99 in double `andThen` pair f g
101combi: Automaton i o -> Automaton i [o] -> Automaton i [o]
102combi a1 a2 = (a1 `branch` a2) `andThen` pure (uncurry (::))
104-- Combine a list of automatons into a single automaton that produces a list.
105combine : [Automaton i o] -> Automaton i [o]
106combine autos =
107 let l = length autos
108 in if l == 0
109 then pure (\_ -> [])
110 else foldr combi (last autos `andThen` pure (\a -> [a])) (take (l-1) autos)
113-- Examples of automata
115-- Count the number of steps taken.
116count : Automaton a Int
117count = state 0 (\_ c -> c + 1)
119type Queue t = ([t],[t])
120empty = ([],[])
121enqueue x (en,de) = (x::en, de)
122dequeue q = case q of
123 ([],[]) -> Nothing
124 (en,[]) -> dequeue ([], reverse en)
125 (en,hd::tl) -> Just (hd, (en,tl))
127-- Computes the running average of the last `n` inputs.
128average : Int -> Automaton Float Float
129average k =
130 let step n (ns,len,sum) =
131 if len == k then stepFull n (ns,len,sum)
132 else ((enqueue n ns, len+1, sum+n), (sum+n) / (toFloat len+1))
133 stepFull n (ns,len,sum) =
134 case dequeue ns of
135 Nothing -> ((ns,len,sum), 0)
136 Just (m,ns') -> let sum' = sum + n - m
137 in ((enqueue n ns', len, sum'), sum' / toFloat len)
138 in hiddenState (empty,0,0) step
141{-- TODO(evancz): See the following papers for ideas on how to make this
142library faster and better:
144- Functional Reactive Programming, Continued -- took some inspirations from this paper (Apanatshka)
145- Causal commutative arrows and their optimization
147Speeding things up is a really low priority. Language features and
148libraries with nice APIs and are way more important!
149--}