module FRP.Netwire.Move
(
derivative,
integral,
integralWith
)
where
import Control.Wire
derivative ::
(RealFloat a, HasTime t s, Monoid e)
=> Wire s e m a a
derivative :: forall a t s e (m :: * -> *).
(RealFloat a, HasTime t s, Monoid e) =>
Wire s e m a a
derivative = (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a)
-> (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \s
_ a
x -> (e -> Either e a
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty, a -> Wire s e m a a
forall {s} {a} {b} {e} {m :: * -> *}.
(HasTime a s, RealFloat b, Monoid e) =>
b -> Wire s e m b b
loop a
x)
where
loop :: b -> Wire s e m b b
loop b
x' =
(s -> b -> (Either e b, Wire s e m b b)) -> Wire s e m b b
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> b -> (Either e b, Wire s e m b b)) -> Wire s e m b b)
-> (s -> b -> (Either e b, Wire s e m b b)) -> Wire s e m b b
forall a b. (a -> b) -> a -> b
$ \s
ds b
x ->
let dt :: b
dt = a -> b
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> a
forall t s. HasTime t s => s -> t
dtime s
ds)
dx :: b
dx = (b
x b -> b -> b
forall a. Num a => a -> a -> a
- b
x') b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
dt
mdx :: Either e b
mdx | b -> Bool
forall a. RealFloat a => a -> Bool
isNaN b
dx = b -> Either e b
forall a b. b -> Either a b
Right b
0
| b -> Bool
forall a. RealFloat a => a -> Bool
isInfinite b
dx = e -> Either e b
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
| Bool
otherwise = b -> Either e b
forall a b. b -> Either a b
Right b
dx
in Either e b
mdx Either e b
-> (Either e b, Wire s e m b b) -> (Either e b, Wire s e m b b)
`seq` (Either e b
mdx, b -> Wire s e m b b
loop b
x)
integral ::
(Fractional a, HasTime t s)
=> a
-> Wire s e m a a
integral :: forall a t s e (m :: * -> *).
(Fractional a, HasTime t s) =>
a -> Wire s e m a a
integral a
x' =
(s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a)
-> (s -> a -> (Either e a, Wire s e m a a)) -> Wire s e m a a
forall a b. (a -> b) -> a -> b
$ \s
ds a
dx ->
let dt :: a
dt = t -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> t
forall t s. HasTime t s => s -> t
dtime s
ds)
in a
x' a -> (Either e a, Wire s e m a a) -> (Either e a, Wire s e m a a)
`seq` (a -> Either e a
forall a b. b -> Either a b
Right a
x', a -> Wire s e m a a
forall a t s e (m :: * -> *).
(Fractional a, HasTime t s) =>
a -> Wire s e m a a
integral (a
x' a -> a -> a
forall a. Num a => a -> a -> a
+ a
dta -> a -> a
forall a. Num a => a -> a -> a
*a
dx))
integralWith ::
(Fractional a, HasTime t s)
=> (w -> a -> a)
-> a
-> Wire s e m (a, w) a
integralWith :: forall a t s w e (m :: * -> *).
(Fractional a, HasTime t s) =>
(w -> a -> a) -> a -> Wire s e m (a, w) a
integralWith w -> a -> a
correct = a -> Wire s e m (a, w) a
forall {s} {a} {e} {m :: * -> *}.
HasTime a s =>
a -> Wire s e m (a, w) a
loop
where
loop :: a -> Wire s e m (a, w) a
loop a
x' =
(s -> (a, w) -> (Either e a, Wire s e m (a, w) a))
-> Wire s e m (a, w) a
forall s a e b (m :: * -> *).
Monoid s =>
(s -> a -> (Either e b, Wire s e m a b)) -> Wire s e m a b
mkPure ((s -> (a, w) -> (Either e a, Wire s e m (a, w) a))
-> Wire s e m (a, w) a)
-> (s -> (a, w) -> (Either e a, Wire s e m (a, w) a))
-> Wire s e m (a, w) a
forall a b. (a -> b) -> a -> b
$ \s
ds (a
dx, w
w) ->
let dt :: a
dt = a -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> a
forall t s. HasTime t s => s -> t
dtime s
ds)
x :: a
x = w -> a -> a
correct w
w (a
x' a -> a -> a
forall a. Num a => a -> a -> a
+ a
dta -> a -> a
forall a. Num a => a -> a -> a
*a
dx)
in a
x' a
-> (Either e a, Wire s e m (a, w) a)
-> (Either e a, Wire s e m (a, w) a)
`seq` (a -> Either e a
forall a b. b -> Either a b
Right a
x', a -> Wire s e m (a, w) a
loop a
x)