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 {a} {s} {t} {e} {m :: * -> *}.
(HasTime a s, RealFloat t, Monoid e) =>
t -> Wire s e m t t
loop a
x)
where
loop :: t -> Wire s e m t t
loop t
x' =
(s -> t -> (Either e t, Wire s e m t t)) -> Wire s e m t t
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 -> t -> (Either e t, Wire s e m t t)) -> Wire s e m t t)
-> (s -> t -> (Either e t, Wire s e m t t)) -> Wire s e m t t
forall a b. (a -> b) -> a -> b
$ \s
ds t
x ->
let dt :: t
dt = a -> t
forall a b. (Real a, Fractional b) => a -> b
realToFrac (s -> a
forall t s. HasTime t s => s -> t
dtime s
ds)
dx :: t
dx = (t
x t -> t -> t
forall a. Num a => a -> a -> a
- t
x') t -> t -> t
forall a. Fractional a => a -> a -> a
/ t
dt
mdx :: Either e t
mdx | t -> Bool
forall a. RealFloat a => a -> Bool
isNaN t
dx = t -> Either e t
forall a b. b -> Either a b
Right t
0
| t -> Bool
forall a. RealFloat a => a -> Bool
isInfinite t
dx = e -> Either e t
forall a b. a -> Either a b
Left e
forall a. Monoid a => a
mempty
| Bool
otherwise = t -> Either e t
forall a b. b -> Either a b
Right t
dx
in Either e t
mdx Either e t
-> (Either e t, Wire s e m t t) -> (Either e t, Wire s e m t t)
forall a b. a -> b -> b
`seq` (Either e t
mdx, t -> Wire s e m t t
loop t
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)
forall a b. a -> b -> b
`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 {a} {s} {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)
forall a b. a -> b -> b
`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)