1 {-# OPTIONS -H12m -package lang #-}
4 import TypesettingTricks
5 import Int( Num(fromInt) )
10 mapSignal:: (Physical a, Physical b) => (s a b) -> a -> b
11 mapSigList:: (Physical a, Physical b) => (s a b) -> [a] -> [b]
12 toSig:: (Physical a, Physical b) => (s a b) -> SignalRep a b
13 mapSignal = mapSignal . toSig
14 mapSigList = map . mapSignal
15 toSig = FunctionRep . mapSignal
16 instance Signal (->) where
19 data {- (Physical a, Physical b) => -} SignalRep a b =
20 FunctionRep (a -> b) |
21 PieceContRep (PieceCont a b)
23 instance Eq (SignalRep a b) where
24 (==) a b = error "No equality for SignalRep"
26 instance Show (SignalRep a b) where
27 show sr = error "No show for SignalRep"
29 instance Signal SignalRep where
30 mapSignal (FunctionRep f) = mapSignal f
31 mapSignal (PieceContRep f) = mapSignal f
32 mapSigList (FunctionRep f) = mapSigList f
33 mapSigList (PieceContRep f) = mapSigList f
35 instance (Physical a, Physical b) => Eq (a -> b) where
36 a == b = error "Attempt to apply equality to functions"
37 binop:: (Physical a, Physical b) => (Float -> Float -> Float) ->
38 (a -> b) -> (a -> b) -> a -> b
39 binop op f g t = toPhysical ((fromPhysical (f t)) `op` (fromPhysical (g t)))
40 unop:: (Physical a, Physical b ) => (Float -> Float) ->
42 unop op f t = toPhysical (op (fromPhysical (f t)))
43 instance (Physical a, Physical b) => Num (SignalRep a b) where
44 f + g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
45 f * g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
46 negate f = FunctionRep (unop negate (mapSignal f))
47 abs f = FunctionRep (unop abs (mapSignal f))
48 signum f = FunctionRep (unop abs (mapSignal f))
49 fromInteger i = FunctionRep (\t -> toPhysical (fromInteger i))
50 fromInt i = FunctionRep (\t -> toPhysical (fromInt i))
51 instance (Physical a, Physical b) =>
52 Fractional (SignalRep a b) where
53 f / g = FunctionRep (binop (/) (mapSignal f) (mapSignal g))
54 fromRational r = FunctionRep (\t -> (toPhysical (fromRational r)))
55 instance (Physical a, Physical b) =>
56 Floating (SignalRep a b) where
57 pi = FunctionRep (\t -> (toPhysical pi))
58 exp f = FunctionRep (unop exp (mapSignal f))
59 log f = FunctionRep (unop log (mapSignal f))
60 sin f = FunctionRep (unop sin (mapSignal f))
61 cos f = FunctionRep (unop cos (mapSignal f))
62 asin f = FunctionRep (unop asin (mapSignal f))
63 acos f = FunctionRep (unop acos (mapSignal f))
64 atan f = FunctionRep (unop atan (mapSignal f))
65 sinh f = FunctionRep (unop sinh (mapSignal f))
66 cosh f = FunctionRep (unop cosh (mapSignal f))
67 asinh f = FunctionRep (unop asinh (mapSignal f))
68 acosh f = FunctionRep (unop acosh (mapSignal f))
69 atanh f = FunctionRep (unop atanh (mapSignal f))
72 FunctionEvent (Float -> Bool) |
75 instance Show Event where
76 show (TimeEvent f) = "TimeEvent " ++ show f
77 show (FunctionEvent _) = "FunctionEvent"
78 show (BurstEvent i e) = "BurstEvent " ++ show i ++ " " ++ show e
80 instance Eq Event where
81 (TimeEvent x) == (TimeEvent y) = x == y
82 (BurstEvent i e) == (BurstEvent i' e') = (i' == i) && (e' == e)
83 eventOccurs:: Event -> Float -> Float
84 eventOccurs (TimeEvent t) x = if x < t then x else t
85 eventOccurs (FunctionEvent f) x = stepEval f x
86 eventOccurs (BurstEvent i e) x =
90 eventOccurs (BurstEvent (i-1) e) ((eventOccurs e x) + eventEps x)
91 stepEval:: (Float -> Bool) -> Float -> Float
92 stepEval f x = if f x then x else stepEval f (x + eventEps x)
93 data ZeroIndicator = LocalZero | GlobalZero deriving (Eq, Show)
94 data {- (Physical a, Physical b) => -} FunctionWindow a b =
95 Window ZeroIndicator Event (SignalRep a b)
97 data PieceCont a b = Windows [FunctionWindow a b]
99 instance Signal PieceCont where
100 mapSignal (Windows []) t = toPhysical 0.0
101 mapSignal (Windows wl) t = (mapSignal s) (toPhysical t')
102 where (t', (Window z e s), wl') = getWindow 0.0 (fromPhysical t) wl
104 getWindow:: (Physical a, Physical b) =>
105 Float -> Float -> [ FunctionWindow a b ] ->
106 (Float, FunctionWindow a b, [ FunctionWindow a b ])
107 getWindow st t [] = (t, Window LocalZero e f, [])
108 where e = TimeEvent (realmul 2 t)
109 f = FunctionRep (\t -> toPhysical 0.0)
110 getWindow st t (w:wl) = if t' <= wt then (t',w,w:wl)
111 else getWindow (st+wt) t wl
112 where wt = eventOccurs e t'
114 t' = if z == LocalZero then t-st else t
115 (|>) :: (Physical a, Physical b) => FunctionWindow a b ->
116 PieceCont a b -> PieceCont a b
117 w |> (Windows wl) = Windows (w:wl)
118 nullWindow = Windows []
119 cycleWindows:: (Physical a, Physical b) =>
120 PieceCont a b -> PieceCont a b
121 cycleWindows (Windows wl) = Windows (cycle wl)
122 constant:: (Physical a, Physical b) => b -> SignalRep a b
123 constant x = FunctionRep (\t -> x)
124 linear:: (Physical a, Physical b) => Float -> b -> SignalRep a b
125 linear m b = FunctionRep (\x -> toPhysical (realmul m (fromPhysical x) + (fromPhysical b)))
126 sine:: (Physical a, Physical b) =>
127 b -> Frequency -> Float -> SignalRep a b
128 sine mag omeg phase = FunctionRep (\x -> toPhysical (realmul (fromPhysical mag) (sin (realmul (realmul (realmul 2 pi) (fromPhysical omeg)) (fromPhysical x) + phase))))
129 waveform:: (Physical a, Physical b) => a -> [b] -> SignalRep a b
130 waveform samp ampls =
131 let stepSlope y y' = realdiv ((fromPhysical y') - (fromPhysical y)) (fromPhysical samp)
132 makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp))
133 (linear (stepSlope v v') v)
135 in PieceContRep (Windows (map makeWin (zip points (tail points))))
136 random:: (Physical a, Physical b) =>
137 Integer -> a -> SignalRep a b
138 random i s = waveform s (map toPhysical (rand i))
139 ramp:: (Physical a, Physical b) => a -> b -> SignalRep a b
141 let sig = linear (realdiv (fromPhysical v) (fromPhysical per)) (toPhysical 0.0)
142 in PieceContRep (Windows (cycle ([Window LocalZero (TimeEvent (fromPhysical per)) sig ])))
143 triangle:: (Physical a, Physical b) => a -> b -> SignalRep a b
145 let sl = realmul 2.0 (realdiv (fromPhysical v) (fromPhysical per))
146 qper = realdiv (fromPhysical v) 4.0
147 wins = (Window LocalZero (TimeEvent qper) (linear sl (toPhysical 0.0))) |>
148 (Window LocalZero (TimeEvent (realmul 2.0 qper)) (linear (- sl) v)) |>
149 (Window LocalZero (TimeEvent qper) (linear sl (toPhysical (- (fromPhysical v))))) |>
151 in PieceContRep (cycleWindows wins)
152 step:: (Physical a, Physical b) => a -> b -> SignalRep a b
153 step tr lvl = FunctionRep (\t -> if (fromPhysical t) < (fromPhysical tr) then (toPhysical 0.0) else lvl)
154 square:: (Physical a, Physical b) => a -> b -> SignalRep a b
156 let trans = realdiv (fromPhysical per) 2.0
157 nlvl = asTypeOf (toPhysical (- (fromPhysical lvl))) lvl
158 f t = if (fromPhysical t) < trans then lvl else nlvl
159 wins = Windows [Window LocalZero (TimeEvent (fromPhysical per)) (FunctionRep f)]
160 in PieceContRep (cycleWindows wins)
161 pulse:: (Physical a, Physical b) => a -> a -> b -> SignalRep a b
163 let tr = (fromPhysical st) + (fromPhysical wid)
164 f t = if (fromPhysical t) < (fromPhysical st) then (toPhysical 0.0)
165 else if (fromPhysical t) < tr then lvl else (toPhysical 0.0)
167 trap:: (Physical a, Physical b) => a -> a -> a -> a -> b ->
169 trap st r wid f lvl =
170 let stepSlope y y' t = realdiv (y' - y) (fromPhysical t)
171 bigwin = realmul 10000000 ((fromPhysical st) + (fromPhysical wid))
172 wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
173 Window LocalZero (TimeEvent (fromPhysical r)) (linear (stepSlope 0.0 (fromPhysical lvl) r) (toPhysical 0.0)) |>
174 Window LocalZero (TimeEvent (fromPhysical wid)) (constant lvl) |>
175 Window LocalZero (TimeEvent (fromPhysical f)) (linear (stepSlope (fromPhysical lvl) 0.0 f) lvl) |>
176 Window LocalZero (TimeEvent bigwin) (constant (toPhysical 0.0)) |>
179 expc:: (Physical a, Physical b) => Float -> SignalRep a b
180 expc damp = FunctionRep (\t -> toPhysical (exp (- (realmul (fromPhysical t) damp))))
181 data {- (Physical indep, Physical dep) => -} BasicSignal indep dep =
182 Overshoot {start_delay::indep,
185 oscillation::Frequency,
187 | Pulse_dc {start_delay::indep,
194 over::BasicSignal indep dep,
195 under::BasicSignal indep dep}
196 | Pulse_ac {start_delay::indep,
201 frequency::Frequency,
205 data {- (Eq a, Eq b) => -} Foo a b = Foo { x :: a, y :: b}
207 foo :: (Eq a, Eq b) => Foo a b
211 overshoot:: (Physical a, Physical b) => BasicSignal a b
212 overshoot = Overshoot{}
213 pulse_dc:: (Physical a, Physical b) => BasicSignal a b
214 pulse_dc = Pulse_dc {over = Overshoot{start_delay=toPhysical 0.0,
215 ringing=(toPhysical 0.0),
216 oscillation=toPhysical 1.0,
218 under = Overshoot{start_delay=toPhysical 0.0,
219 ringing=(toPhysical 0.0),
220 oscillation=toPhysical 1.0,
222 start_delay = toPhysical 0.0,
223 dc_offset = toPhysical 0.0}
225 pulse_ac:: (Physical a, Physical b) => BasicSignal a b
226 pulse_ac = Pulse_ac {dc_offset = toPhysical 0.0,
227 amplitude = toPhysical 0.0}
230 makeWin:: (Physical a, Physical b) => a -> a ->
231 SignalRep a b -> SignalRep a b
233 let wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
234 Window LocalZero (TimeEvent (fromPhysical wid)) sig |>
237 instance Signal BasicSignal where
238 toSig (Overshoot start_delay pulse_width ringing oscillation damp_fac) =
239 let ring = sine ringing oscillation 0.0
240 cond = asTypeOf (expc damp_fac) ring
242 temp:: (Physical a, Physical b) => SignalRep a b ->
243 SignalRep a b -> SignalRep a b
244 temp f g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
246 -- temp f g = asTypeOf (f * g) ring
247 wins = Window LocalZero (TimeEvent (fromPhysical start_delay)) (constant (toPhysical 0.0)) |>
248 Window LocalZero (TimeEvent (fromPhysical pulse_width)) sig |>
251 toSig Pulse_dc{ start_delay = start_delay
252 , rise_time = rise_time
253 , pulse_width = pulse_width
254 , fall_time = fall_time
255 , dc_offset = dc_offset
257 , amplitude = amplitude
261 let pul = trap start_delay rise_time pulse_width fall_time amplitude
262 so = toPhysical ((fromPhysical start_delay) + (fromPhysical rise_time))
263 su = toPhysical ((fromPhysical so) + (fromPhysical pulse_width) + (fromPhysical fall_time))
264 oversh = toSig over{start_delay=so}
265 undersh = toSig under{start_delay=su}
266 off = constant dc_offset
267 temp:: (Physical a, Physical b) => SignalRep a b ->
268 SignalRep a b -> SignalRep a b
269 temp f g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
270 sig = temp (temp (temp pul oversh) undersh) off
271 wins = (Window LocalZero (TimeEvent (fromPhysical period)) sig) |>
273 in PieceContRep (cycleWindows wins)
274 sumSig:: (Physical a, Physical b, Signal s, Signal s') =>
275 (s a b) -> (s' a b) -> SignalRep a b
277 let s1 t = fromPhysical (mapSignal f t)
278 s2 t = fromPhysical (mapSignal f' t)
279 in FunctionRep (\t -> toPhysical ((s1 t) + (s2 t)))
280 mulSig:: (Physical a, Physical b, Signal s, Signal s') =>
281 (s a b) -> (s' a b) -> SignalRep a b
283 let f1 t = fromPhysical (mapSignal f t)
284 f2 t = fromPhysical (mapSignal f' t)
285 in FunctionRep (\t -> toPhysical ((f1 t) * (f2 t)))
287 eventEps:: Float -> Float
288 eventEps x = let eps = realdiv x 1000 in if 0.01 < eps then 0.01 else eps