--- /dev/null
+{-# OPTIONS -H12m #-}
+
+module Basic where
+import TypesettingTricks
+import Physical
+--import GHC( (->) )
+infixr 7 |>
+class Signal s where
+ mapSignal:: (Physical a, Physical b) => (s a b) -> a -> b
+ mapSigList:: (Physical a, Physical b) => (s a b) -> [a] -> [b]
+ toSig:: (Physical a, Physical b) => (s a b) -> SignalRep a b
+ mapSignal = mapSignal . toSig
+ mapSigList = map . mapSignal
+ toSig = FunctionRep . mapSignal
+instance Signal (->) where
+ mapSignal f = f
+ toSig = FunctionRep
+data {- (Physical a, Physical b) => -} SignalRep a b =
+ FunctionRep (a -> b) |
+ PieceContRep (PieceCont a b)
+ deriving (Eq, Show)
+instance Signal SignalRep where
+ mapSignal (FunctionRep f) = mapSignal f
+ mapSignal (PieceContRep f) = mapSignal f
+ mapSigList (FunctionRep f) = mapSigList f
+ mapSigList (PieceContRep f) = mapSigList f
+ toSig = id
+instance (Physical a, Physical b) => Eq (a -> b) where
+ a == b = error "Attempt to apply equality to functions"
+binop:: (Physical a, Physical b) => (Float -> Float -> Float) ->
+ (a -> b) -> (a -> b) -> a -> b
+binop op f g t = toPhysical ((fromPhysical (f t)) `op` (fromPhysical (g t)))
+unop:: (Physical a, Physical b ) => (Float -> Float) ->
+ (a -> b) -> a -> b
+unop op f t = toPhysical (op (fromPhysical (f t)))
+instance (Physical a, Physical b) => Num (SignalRep a b) where
+ f + g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
+ f * g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
+ negate f = FunctionRep (unop negate (mapSignal f))
+ abs f = FunctionRep (unop abs (mapSignal f))
+ signum f = FunctionRep (unop abs (mapSignal f))
+ fromInteger i = FunctionRep (\t -> toPhysical (fromInteger i))
+ fromInt i = FunctionRep (\t -> toPhysical (fromInt i))
+instance (Physical a, Physical b) =>
+ Fractional (SignalRep a b) where
+ f / g = FunctionRep (binop (/) (mapSignal f) (mapSignal g))
+ fromRational r = FunctionRep (\t -> (toPhysical (fromRational r)))
+instance (Physical a, Physical b) =>
+ Floating (SignalRep a b) where
+ pi = FunctionRep (\t -> (toPhysical pi))
+ exp f = FunctionRep (unop exp (mapSignal f))
+ log f = FunctionRep (unop log (mapSignal f))
+ sin f = FunctionRep (unop sin (mapSignal f))
+ cos f = FunctionRep (unop cos (mapSignal f))
+ asin f = FunctionRep (unop asin (mapSignal f))
+ acos f = FunctionRep (unop acos (mapSignal f))
+ atan f = FunctionRep (unop atan (mapSignal f))
+ sinh f = FunctionRep (unop sinh (mapSignal f))
+ cosh f = FunctionRep (unop cosh (mapSignal f))
+ asinh f = FunctionRep (unop asinh (mapSignal f))
+ acosh f = FunctionRep (unop acosh (mapSignal f))
+ atanh f = FunctionRep (unop atanh (mapSignal f))
+data Event =
+ TimeEvent Float |
+ FunctionEvent (Float -> Bool) |
+ BurstEvent Int Event
+ deriving (Show)
+instance Eq Event where
+ (TimeEvent x) == (TimeEvent y) = x == y
+ (BurstEvent i e) == (BurstEvent i' e') = (i' == i) && (e' == e)
+eventOccurs:: Event -> Float -> Float
+eventOccurs (TimeEvent t) x = if x < t then x else t
+eventOccurs (FunctionEvent f) x = stepEval f x
+eventOccurs (BurstEvent i e) x =
+ if i == 1 then
+ eventOccurs e x
+ else
+ eventOccurs (BurstEvent (i-1) e) ((eventOccurs e x) + eventEps x)
+stepEval:: (Float -> Bool) -> Float -> Float
+stepEval f x = if f x then x else stepEval f (x + eventEps x)
+data ZeroIndicator = LocalZero | GlobalZero deriving (Eq, Show)
+data {- (Physical a, Physical b) => -} FunctionWindow a b =
+ Window ZeroIndicator Event (SignalRep a b)
+ deriving (Eq, Show)
+data PieceCont a b = Windows [FunctionWindow a b]
+ deriving (Eq, Show)
+instance Signal PieceCont where
+ mapSignal (Windows []) t = toPhysical 0.0
+ mapSignal (Windows wl) t = (mapSignal s) (toPhysical t')
+ where (t', (Window z e s), wl') = getWindow 0.0 (fromPhysical t) wl
+ toSig = PieceContRep
+getWindow:: (Physical a, Physical b) =>
+ Float -> Float -> [ FunctionWindow a b ] ->
+ (Float, FunctionWindow a b, [ FunctionWindow a b ])
+getWindow st t [] = (t, Window LocalZero e f, [])
+ where e = TimeEvent (realmul 2 t)
+ f = FunctionRep (\t -> toPhysical 0.0)
+getWindow st t (w:wl) = if t' <= wt then (t',w,w:wl)
+ else getWindow (st+wt) t wl
+ where wt = eventOccurs e t'
+ (Window z e s) = w
+ t' = if z == LocalZero then t-st else t
+(|>) :: (Physical a, Physical b) => FunctionWindow a b ->
+ PieceCont a b -> PieceCont a b
+w |> (Windows wl) = Windows (w:wl)
+nullWindow = Windows []
+cycleWindows:: (Physical a, Physical b) =>
+ PieceCont a b -> PieceCont a b
+cycleWindows (Windows wl) = Windows (cycle wl)
+constant:: (Physical a, Physical b) => b -> SignalRep a b
+constant x = FunctionRep (\t -> x)
+linear:: (Physical a, Physical b) => Float -> b -> SignalRep a b
+linear m b = FunctionRep (\x -> toPhysical (realmul m (fromPhysical x) + (fromPhysical b)))
+sine:: (Physical a, Physical b) =>
+ b -> Frequency -> Float -> SignalRep a b
+sine mag omeg phase = FunctionRep (\x -> toPhysical (realmul (fromPhysical mag) (sin (realmul (realmul (realmul 2 pi) (fromPhysical omeg)) (fromPhysical x) + phase))))
+waveform:: (Physical a, Physical b) => a -> [b] -> SignalRep a b
+waveform samp ampls =
+ let stepSlope y y' = realdiv ((fromPhysical y') - (fromPhysical y)) (fromPhysical samp)
+ makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp))
+ (linear (stepSlope v v') v)
+ points = cycle ampls
+ in PieceContRep (Windows (map makeWin (zip points (tail points))))
+random:: (Physical a, Physical b) =>
+ Integer -> a -> SignalRep a b
+random i s = waveform s (map toPhysical (rand i))
+ramp:: (Physical a, Physical b) => a -> b -> SignalRep a b
+ramp per v =
+ let sig = linear (realdiv (fromPhysical v) (fromPhysical per)) (toPhysical 0.0)
+ in PieceContRep (Windows (cycle ([Window LocalZero (TimeEvent (fromPhysical per)) sig ])))
+triangle:: (Physical a, Physical b) => a -> b -> SignalRep a b
+triangle per v =
+ let sl = realmul 2.0 (realdiv (fromPhysical v) (fromPhysical per))
+ qper = realdiv (fromPhysical v) 4.0
+ wins = (Window LocalZero (TimeEvent qper) (linear sl (toPhysical 0.0))) |>
+ (Window LocalZero (TimeEvent (realmul 2.0 qper)) (linear (- sl) v)) |>
+ (Window LocalZero (TimeEvent qper) (linear sl (toPhysical (- (fromPhysical v))))) |>
+ nullWindow
+ in PieceContRep (cycleWindows wins)
+step:: (Physical a, Physical b) => a -> b -> SignalRep a b
+step tr lvl = FunctionRep (\t -> if (fromPhysical t) < (fromPhysical tr) then (toPhysical 0.0) else lvl)
+square:: (Physical a, Physical b) => a -> b -> SignalRep a b
+square per lvl =
+ let trans = realdiv (fromPhysical per) 2.0
+ nlvl = asTypeOf (toPhysical (- (fromPhysical lvl))) lvl
+ f t = if (fromPhysical t) < trans then lvl else nlvl
+ wins = Windows [Window LocalZero (TimeEvent (fromPhysical per)) (FunctionRep f)]
+ in PieceContRep (cycleWindows wins)
+pulse:: (Physical a, Physical b) => a -> a -> b -> SignalRep a b
+pulse st wid lvl =
+ let tr = (fromPhysical st) + (fromPhysical wid)
+ f t = if (fromPhysical t) < (fromPhysical st) then (toPhysical 0.0)
+ else if (fromPhysical t) < tr then lvl else (toPhysical 0.0)
+ in FunctionRep f
+trap:: (Physical a, Physical b) => a -> a -> a -> a -> b ->
+ SignalRep a b
+trap st r wid f lvl =
+ let stepSlope y y' t = realdiv (y' - y) (fromPhysical t)
+ bigwin = realmul 10000000 ((fromPhysical st) + (fromPhysical wid))
+ wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
+ Window LocalZero (TimeEvent (fromPhysical r)) (linear (stepSlope 0.0 (fromPhysical lvl) r) (toPhysical 0.0)) |>
+ Window LocalZero (TimeEvent (fromPhysical wid)) (constant lvl) |>
+ Window LocalZero (TimeEvent (fromPhysical f)) (linear (stepSlope (fromPhysical lvl) 0.0 f) lvl) |>
+ Window LocalZero (TimeEvent bigwin) (constant (toPhysical 0.0)) |>
+ nullWindow
+ in PieceContRep wins
+expc:: (Physical a, Physical b) => Float -> SignalRep a b
+expc damp = FunctionRep (\t -> toPhysical (exp (- (realmul (fromPhysical t) damp))))
+data {- (Physical indep, Physical dep) => -} BasicSignal indep dep =
+ Overshoot {start_delay::indep,
+ pulse_width::indep,
+ ringing::dep,
+ oscillation::Frequency,
+ damp_fac::Float}
+ | Pulse_dc {start_delay::indep,
+ pulse_width::indep,
+ rise_time::indep,
+ fall_time::indep,
+ period::indep,
+ dc_offset::dep,
+ amplitude::dep,
+ over::BasicSignal indep dep,
+ under::BasicSignal indep dep}
+ | Pulse_ac {start_delay::indep,
+ pulse_width::indep,
+ period::indep,
+ dc_offset::dep,
+ amplitude::dep,
+ frequency::Frequency,
+ phase::Float}
+ deriving (Eq, Show)
+
+data {- (Eq a, Eq b) => -} Foo a b = Foo { x :: a, y :: b}
+
+foo :: (Eq a, Eq b) => Foo a b
+foo = Foo{}
+
+{-
+overshoot:: (Physical a, Physical b) => BasicSignal a b
+overshoot = Overshoot{}
+pulse_dc:: (Physical a, Physical b) => BasicSignal a b
+pulse_dc = Pulse_dc {over = Overshoot{start_delay=toPhysical 0.0,
+ ringing=(toPhysical 0.0),
+ oscillation=toPhysical 1.0,
+ damp_fac=1.0},
+ under = Overshoot{start_delay=toPhysical 0.0,
+ ringing=(toPhysical 0.0),
+ oscillation=toPhysical 1.0,
+ damp_fac=1.0},
+ start_delay = toPhysical 0.0,
+ dc_offset = toPhysical 0.0}
+
+pulse_ac:: (Physical a, Physical b) => BasicSignal a b
+pulse_ac = Pulse_ac {dc_offset = toPhysical 0.0,
+ amplitude = toPhysical 0.0}
+-}
+
+makeWin:: (Physical a, Physical b) => a -> a ->
+ SignalRep a b -> SignalRep a b
+makeWin st wid sig =
+ let wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
+ Window LocalZero (TimeEvent (fromPhysical wid)) sig |>
+ nullWindow
+ in PieceContRep wins
+instance Signal BasicSignal where
+ toSig Overshoot{start_delay,pulse_width,
+ ringing,oscillation,damp_fac} =
+ let ring = sine ringing oscillation 0.0
+ cond = asTypeOf (expc damp_fac) ring
+ sig = temp ring cond
+ temp:: (Physical a, Physical b) => SignalRep a b ->
+ SignalRep a b -> SignalRep a b
+ temp f g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
+-- temp f g = f * g
+-- temp f g = asTypeOf (f * g) ring
+ wins = Window LocalZero (TimeEvent (fromPhysical start_delay)) (constant (toPhysical 0.0)) |>
+ Window LocalZero (TimeEvent (fromPhysical pulse_width)) sig |>
+ nullWindow
+ in PieceContRep wins
+ toSig Pulse_dc{start_delay,rise_time,pulse_width,fall_time,
+ dc_offset,period,amplitude,over,under} =
+ let pul = trap start_delay rise_time pulse_width fall_time amplitude
+ so = toPhysical ((fromPhysical start_delay) + (fromPhysical rise_time))
+ su = toPhysical ((fromPhysical so) + (fromPhysical pulse_width) + (fromPhysical fall_time))
+ oversh = toSig over{start_delay=so}
+ undersh = toSig under{start_delay=su}
+ off = constant dc_offset
+ temp:: (Physical a, Physical b) => SignalRep a b ->
+ SignalRep a b -> SignalRep a b
+ temp f g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
+ sig = temp (temp (temp pul oversh) undersh) off
+ wins = (Window LocalZero (TimeEvent (fromPhysical period)) sig) |>
+ nullWindow
+ in PieceContRep (cycleWindows wins)
+sumSig:: (Physical a, Physical b, Signal s, Signal s') =>
+ (s a b) -> (s' a b) -> SignalRep a b
+sumSig f f' =
+ let s1 t = fromPhysical (mapSignal f t)
+ s2 t = fromPhysical (mapSignal f' t)
+ in FunctionRep (\t -> toPhysical ((s1 t) + (s2 t)))
+mulSig:: (Physical a, Physical b, Signal s, Signal s') =>
+ (s a b) -> (s' a b) -> SignalRep a b
+mulSig f f' =
+ let f1 t = fromPhysical (mapSignal f t)
+ f2 t = fromPhysical (mapSignal f' t)
+ in FunctionRep (\t -> toPhysical ((f1 t) * (f2 t)))
+
+eventEps:: Float -> Float
+eventEps x = let eps = realdiv x 1000 in if 0.01 < eps then 0.01 else eps
--- /dev/null
+module Physical where
+import TypesettingTricks
+class (Eq a, Show a) => Physical a where
+ fromPhysical:: a -> Float
+ toPhysical:: Float -> a
+instance Physical Float where
+ fromPhysical x = x
+ toPhysical x = x
+data PlaneAngle =
+ Rad Float |
+ Mrad Float |
+ Urad Float |
+ Deg Float |
+ Rev Float
+ deriving (Eq, Show)
+instance Physical PlaneAngle where
+ fromPhysical (Rad x) = x
+ fromPhysical (Mrad x) = realdiv x 1000
+ fromPhysical (Urad x) = realdiv x 1000000
+ fromPhysical (Deg x) = realdiv (realmul x pi) 180
+ fromPhysical (Rev x) = realdiv x (realmul 2.0 pi)
+ toPhysical x = Rad x
+data SolidAngle =
+ Sr Float |
+ Msr Float
+ deriving (Eq, Show)
+instance Physical SolidAngle where
+ fromPhysical (Sr x) = x
+ fromPhysical (Msr x) = realdiv x 1000
+ toPhysical x = Sr x
+data BurstLength =
+ Cycle Float |
+ Pulse Float
+ deriving (Eq, Show)
+instance Physical BurstLength where
+ fromPhysical (Cycle x) = x
+ fromPhysical (Pulse x) = x
+ toPhysical x = Cycle x
+data Capacitance =
+ Fd Float |
+ Ufd Float |
+ Nfd Float |
+ Pfd Float
+ deriving (Eq, Show)
+instance Physical Capacitance where
+ fromPhysical (Fd x) = x
+ fromPhysical (Ufd x) = realdiv x 1000000
+ fromPhysical (Nfd x) = realdiv x 1000000000
+ fromPhysical (Pfd x) = realdiv x 1000000000000
+ toPhysical x = Fd x
+data Charge =
+ C Float |
+ Kc Float |
+ Uc Float |
+ Nc Float
+ deriving (Eq, Show)
+instance Physical Charge where
+ fromPhysical (C x) = x
+ fromPhysical (Kc x) = realmul 1000 x
+ fromPhysical (Uc x) = realdiv x 1000000
+ fromPhysical (Nc x) = realdiv x 1000000000
+ toPhysical x = C x
+data Current =
+ A Float |
+ Ka Float |
+ Ma Float |
+ Ua Float |
+ Na Float
+ deriving (Eq, Show)
+instance Physical Current where
+ fromPhysical (A x) = x
+ fromPhysical (Ka x) = realmul 1000 x
+ fromPhysical (Ma x) = realdiv x 1000
+ fromPhysical (Ua x) = realdiv x 1000000
+ fromPhysical (Na x) = realdiv x 1000000000
+ toPhysical x = A x
+data Distance =
+ M Float |
+ Km Float |
+ Mm Float |
+ Um Float |
+ Nm Float |
+ In Float |
+ Ft Float |
+ SMi Float |
+ NMi Float
+ deriving (Eq, Show)
+instance Physical Distance where
+ fromPhysical (M x) = x
+ fromPhysical (Km x) = realmul 1000 x
+ fromPhysical (Mm x) = realdiv x 1000
+ fromPhysical (Um x) = realdiv x 1000000
+ fromPhysical (Nm x) = realdiv x 1000000000
+ fromPhysical (In x) = realmul 25.4 x
+ fromPhysical (Ft x) = realmul 2.12 x
+ fromPhysical (SMi x) = realdiv x 2490.57
+ fromPhysical (NMi x) = realdiv x 1825
+ toPhysical x = M x
+data Energy =
+ J Float |
+ Kj Float |
+ Mj Float |
+ Ev Float |
+ Kev Float |
+ Mev Float
+ deriving (Eq, Show)
+instance Physical Energy where
+ fromPhysical (J x) = x
+ fromPhysical (Kj x) = realmul 1000 x
+ fromPhysical (Mj x) = realdiv x 1000
+ fromPhysical (Ev x) = realmul 1.6E-19 x
+ fromPhysical (Kev x) = realmul 1.6E-16 x
+ fromPhysical (Mev x) = realmul 1.6E-13 x
+ toPhysical x = J x
+data MagFlux =
+ Wb Float |
+ Mwb Float
+ deriving (Eq, Show)
+instance Physical MagFlux where
+ fromPhysical (Wb x) = x
+ fromPhysical (Mwb x) = realdiv x 1000
+ toPhysical x = Wb x
+data FluxDensity =
+ T Float |
+ Mt Float |
+ Ut Float |
+ Gam Float
+ deriving (Eq, Show)
+instance Physical FluxDensity where
+ fromPhysical (T x) = x
+ fromPhysical (Mt x) = realdiv x 1000
+ fromPhysical (Ut x) = realdiv x 1000000
+ fromPhysical (Gam x) = realdiv x 1000000000
+ toPhysical x = T x
+data Force =
+ N Float |
+ Kn Float |
+ Mn Float |
+ Un Float
+ deriving (Eq, Show)
+instance Physical Force where
+ fromPhysical (N x) = x
+ fromPhysical (Kn x) = realmul 1000 x
+ fromPhysical (Mn x) = realdiv x 1000
+ fromPhysical (Un x) = realdiv x 1000000
+ toPhysical x = N x
+data Frequency =
+ Hz Float |
+ Khz Float |
+ Mhz Float |
+ Ghz Float
+ deriving (Eq, Show)
+instance Physical Frequency where
+ fromPhysical (Hz x) = x
+ fromPhysical (Khz x) = realmul 1000 x
+ fromPhysical (Mhz x) = realmul 1000000 x
+ fromPhysical (Ghz x) = realmul 1000000000 x
+ toPhysical x = Hz x
+data Illuminance =
+ Lx Float
+ deriving (Eq, Show)
+instance Physical Illuminance where
+ fromPhysical (Lx x) = x
+ toPhysical x = Lx x
+data Inductance =
+ H Float |
+ Mh Float |
+ Uh Float |
+ Nh Float |
+ Ph Float
+ deriving (Eq, Show)
+instance Physical Inductance where
+ fromPhysical (H x) = x
+ fromPhysical (Mh x) = realdiv x 1000
+ fromPhysical (Uh x) = realdiv x 1000000
+ fromPhysical (Nh x) = realdiv x 1000000000
+ fromPhysical (Ph x) = realdiv x 1000000000000
+ toPhysical x = H x
+data Luminance =
+ Nt Float
+ deriving (Eq, Show)
+instance Physical Luminance where
+ fromPhysical (Nt x) = x
+ toPhysical x = Nt x
+data LuminFlux =
+ Lm Float
+ deriving (Eq, Read, Show)
+instance Physical LuminFlux where
+ fromPhysical (Lm x) = x
+ toPhysical x = Lm x
+data LuminInten =
+ Cd Float
+ deriving (Eq, Read, Show)
+instance Physical LuminInten where
+ fromPhysical (Cd x) = x
+ toPhysical x = Cd x
+data Mass =
+ Kg Float |
+ G Float |
+ Mg Float |
+ Ug Float
+ deriving (Eq, Show)
+instance Physical Mass where
+ fromPhysical (Kg x) = x
+ fromPhysical (G x) = realdiv x 1000
+ fromPhysical (Mg x) = realdiv x 1000000
+ fromPhysical (Ug x) = realdiv x 1000000000
+ toPhysical x = Kg x
+data Power =
+ W Float |
+ Kw Float |
+ Mw Float |
+ Uw Float
+ deriving (Eq, Show)
+instance Physical Power where
+ fromPhysical (W x) = x
+ fromPhysical (Kw x) = realmul 1000 x
+ fromPhysical (Mw x) = realdiv x 1000
+ fromPhysical (Uw x) = realdiv x 1000000
+ toPhysical x = W x
+data Pressure =
+ Pa Float |
+ Kpa Float |
+ Mpa Float |
+ Upa Float |
+ Mb Float
+ deriving (Eq, Show)
+instance Physical Pressure where
+ fromPhysical (Pa x) = x
+ fromPhysical (Kpa x) = realmul 1000 x
+ fromPhysical (Mpa x) = realdiv x 1000
+ fromPhysical (Upa x) = realdiv x 1000000
+ fromPhysical (Mb x) = realmul 100 x
+ toPhysical x = Pa x
+data Pulse =
+ Pulses Float
+ deriving (Eq, Show)
+instance Physical Pulse where
+ fromPhysical (Pulses x) = x
+ toPhysical x = Pulses x
+data RatioInOut =
+ Db Float
+ deriving (Eq, Show)
+instance Physical RatioInOut where
+ fromPhysical (Db x) = x
+ toPhysical x = Db x
+data Resistance =
+ Ohm Float |
+ Kohm Float |
+ Mohm Float
+ deriving (Eq, Show)
+instance Physical Resistance where
+ fromPhysical (Ohm x) = x
+ fromPhysical (Kohm x) = realmul 1000 x
+ fromPhysical (Mohm x) = realmul 1000000 x
+ toPhysical x = Ohm x
+data Temperature =
+ Degk Float |
+ Degc Float |
+ Degf Float
+ deriving (Eq, Show)
+instance Physical Temperature where
+ fromPhysical (Degk x) = x
+ fromPhysical (Degc x) = x + 273
+ fromPhysical (Degf x) = (realdiv (realmul 5 (x-32)) 9) + 273
+ toPhysical x = Degk x
+data Time =
+ Sec Float |
+ Msec Float |
+ Usec Float |
+ Nsec Float |
+ Min Float |
+ Hr Float
+ deriving (Eq, Show)
+instance Physical Time where
+ fromPhysical (Sec x) = x
+ fromPhysical (Msec x) = realdiv x 1000
+ fromPhysical (Usec x) = realdiv x 1000000
+ fromPhysical (Nsec x) = realdiv x 1000000000
+ fromPhysical (Min x) = realmul 60 x
+ fromPhysical (Hr x) = realmul 3600 x
+ toPhysical x = Sec x
+data Voltage =
+ V Float |
+ Kv Float |
+ Mv Float |
+ Uv Float
+ deriving (Eq, Show)
+instance Physical Voltage where
+ fromPhysical (V x) = x
+ fromPhysical (Kv x) = realmul 1000 x
+ fromPhysical (Mv x) = realdiv x 1000
+ fromPhysical (Uv x) = realdiv x 1000000
+ toPhysical x = V x
+data Volume =
+ L Float |
+ Ml Float
+ deriving (Eq, Show)
+instance Physical Volume where
+ fromPhysical (L x) = x
+ fromPhysical (Ml x) = realdiv x 1000
+ toPhysical x = L x
--- /dev/null
+The functions in this file (well, the single function) will allow the
+user to plot different functions using the Gnuplot program. In fact,
+all it really does is output a number of points on the list and allow
+the user to activate Gnuplot and use the plotting program to get the
+appropriate output.
+
+The first line just gives the module name. For the moment, I don't
+anticipate using any modules (although this may change).
+
+> module Plot where
+> import IO
+
+Now we give the type of the function. This consists of a file name, a
+list of values, and a function that goes from the appropriate types.
+
+> plot2d:: (Show a, Show b) => String -> [a] -> (a -> b) -> IO()
+> plot2d fl inp f = openFile fl WriteMode >>= \flh ->
+> plot2d' flh inp f >>
+> hClose flh
+
+> plot2d':: (Show a, Show b) => Handle -> [a] -> (a -> b) -> IO()
+> plot2d' fl [] f = return ()
+> plot2d' fl (x:xs) f = hPutStr fl (show x) >>
+> hPutStr fl " " >>
+> hPutStr fl (show (f x)) >>
+> hPutStr fl "\n" >>
+> plot2d' fl xs f
+
+> plot3d:: (Show a, Show b, Show c) => String -> [a] -> [b] ->
+> (a -> b -> c) -> IO()
+> plot3d fl inp1 inp2 f = openFile fl WriteMode >>= \flh ->
+> plot3d' flh inp1 inp2 f >>
+> hClose flh
+
+> plot3d':: (Show a, Show b, Show c) => Handle -> [a] -> [b] ->
+> (a -> b -> c) -> IO()
+> plot3d' fl [] inp f = return ()
+> plot3d' fl (x:xs) inp f = plot3d'' fl x inp f >>
+> hPutStr fl "\n" >>
+> plot3d' fl xs inp f
+
+> plot3d'':: (Show a, Show b, Show c) => Handle -> a -> [b] ->
+> (a -> b -> c) -> IO()
+> plot3d'' fl inp [] f = return ()
+> plot3d'' fl x (y:ys) f = hPutStr fl (show x) >>
+> hPutStr fl " " >>
+> hPutStr fl (show y) >>
+> hPutStr fl " " >>
+> hPutStr fl (show (f x y)) >>
+> hPutStr fl "\n" >>
+> plot3d'' fl x ys f
+
+
+And now, let's create a function to make a range out of a triple of a
+start point, an end point, and an increment.
+
+> createRange:: (Num a, Ord a) => a -> a -> a -> [a]
+> createRange s e i = if s > e then []
+> else s : createRange (s+i) e i
+
+We now settle down to a couple of more specific functions that do
+things that are more unique to gnuplot. First, we have something that
+creates the appropriate gnuplot command file.
+
+> createGnuPlot:: Show a => String -> a -> a -> IO()
+> createGnuPlot fl s e = openFile (fl ++ ".gnp") WriteMode >>= \flh ->
+> hPutStr flh "set terminal latex\n" >>
+> hPutStr flh "set output \"" >>
+> hPutStr flh (fl ++ ".tex\"\n") >>
+> hPutStr flh "set nokey\n" >>
+> hPutStr flh "plot [" >>
+> hPutStr flh (show s) >>
+> hPutStr flh ":" >>
+> hPutStr flh (show e) >>
+> hPutStr flh "] \"" >>
+> hPutStr flh (fl ++ ".plt\"") >>
+> hPutStr flh " with lines\n" >>
+> hClose flh
+
+And now we create a fairly specific plotExam function that takes a
+string, a function, and two floats and produces the correct files
+
+> plotExam:: String -> Float -> Float -> (Float -> Float) -> IO()
+> plotExam fl s e f = plot2d (fl++".plt") r f >>
+> createGnuPlot fl s e
+> where r = createRange s e ((e - s) / 2500)
projects / ghc-hetmet.git / commitdiff