{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Numeric.Backprop.Op (
Op(..)
, Rec(..)
, runOp, evalOp, gradOp, gradOpWith
, op0, opConst, idOp
, opLens
, op1, op2, op3
, opCoerce, opTup, opIso, opIso2, opIso3, opIsoN
, noGrad1, noGrad
, composeOp, composeOp1, (~.)
, (+.), (-.), (*.), negateOp, absOp, signumOp
, (/.), recipOp
, expOp, logOp, sqrtOp, (**.), logBaseOp
, sinOp, cosOp, tanOp, asinOp, acosOp, atanOp
, sinhOp, coshOp, tanhOp, asinhOp, acoshOp, atanhOp
) where
import Control.Applicative
import Data.Bifunctor
import Data.Coerce
import Data.Functor.Identity
import Data.List
import Data.Type.Util
import Data.Vinyl.Core
import Lens.Micro
import Lens.Micro.Extras
import qualified Data.Vinyl.Recursive as VR
newtype Op as a =
Op {
forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith :: Rec Identity as -> (a, a -> Rec Identity as)
}
newtype OpCont as a = OC { forall (as :: [*]) a. OpCont as a -> a -> Rec Identity as
runOpCont :: a -> Rec Identity as }
composeOp
:: forall as bs c. (RPureConstrained Num as)
=> Rec (Op as) bs
-> Op bs c
-> Op as c
composeOp :: forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp Rec (Op as) bs
os Op bs c
o = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ \Rec Identity as
xs ->
let (Rec Identity bs
ys, Rec (OpCont as) bs
conts) = forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> (g x, h x))
-> forall (xs :: [k]). Rec f xs -> (Rec g xs, Rec h xs)
runzipWith (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. a -> Identity a
Identity forall (as :: [*]) a. (a -> Rec Identity as) -> OpCont as a
OC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith Rec Identity as
xs) Rec (Op as) bs
os
(c
z, c -> Rec Identity bs
gFz) = forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith Op bs c
o Rec Identity bs
ys
gFunc :: c -> Rec Identity as
gFunc c
g0 =
let g1 :: Rec Identity bs
g1 = c -> Rec Identity bs
gFz c
g0
g2s :: Rec (Const (Rec Identity as)) bs
g2s :: Rec (Const (Rec Identity as)) bs
g2s = forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> forall (xs :: [k]). Rec f xs -> Rec g xs -> Rec h xs
VR.rzipWith (\OpCont as x
oc (Identity x
g) -> forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ forall (as :: [*]) a. OpCont as a -> a -> Rec Identity as
runOpCont OpCont as x
oc x
g)
Rec (OpCont as) bs
conts Rec Identity bs
g1
in forall {u} (f :: u -> *) (g :: u -> *) (rs :: [u]).
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
VR.rmap (\(Dict x
x) -> forall a. a -> Identity a
Identity x
x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *).
(forall (x :: k). f x -> g x -> h x)
-> forall (xs :: [k]). Rec f xs -> Rec g xs -> Rec h xs
VR.rzipWith (\(Dict !x
x) (Identity x
y) ->
let q :: x
q = x
x forall a. Num a => a -> a -> a
+ x
y in x
q seq :: forall a b. a -> b -> b
`seq` forall (c :: * -> Constraint) a. c a => a -> Dict c a
Dict x
q
)
)
(forall {k} (c :: k -> Constraint) (ts :: [k]) (f :: k -> *).
RPureConstrained c ts =>
(forall (a :: k). c a => f a) -> Rec f ts
rpureConstrained @Num (forall (c :: * -> Constraint) a. c a => a -> Dict c a
Dict @Num a
0))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {u} (f :: u -> *) m (rs :: [u]).
Monoid m =>
(forall (x :: u). f x -> m) -> Rec f rs -> m
VR.rfoldMap ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst)
forall a b. (a -> b) -> a -> b
$ Rec (Const (Rec Identity as)) bs
g2s
in (c
z, c -> Rec Identity as
gFunc)
composeOp1
:: RPureConstrained Num as
=> Op as b
-> Op '[b] c
-> Op as c
composeOp1 :: forall (as :: [*]) b c.
RPureConstrained Num as =>
Op as b -> Op '[b] c -> Op as c
composeOp1 = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil)
infixr 9 ~.
(~.)
:: (RPureConstrained Num as)
=> Op '[b] c
-> Op as b
-> Op as c
~. :: forall (as :: [*]) b c.
RPureConstrained Num as =>
Op '[b] c -> Op as b -> Op as c
(~.) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (as :: [*]) b c.
RPureConstrained Num as =>
Op as b -> Op '[b] c -> Op as c
composeOp1
{-# INLINE (~.) #-}
evalOp :: Op as a -> Rec Identity as -> a
evalOp :: forall (as :: [*]) a. Op as a -> Rec Identity as -> a
evalOp Op as a
o = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith Op as a
o
{-# INLINE evalOp #-}
runOp :: Num a => Op as a -> Rec Identity as -> (a, Rec Identity as)
runOp :: forall a (as :: [*]).
Num a =>
Op as a -> Rec Identity as -> (a, Rec Identity as)
runOp Op as a
o = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. (a -> b) -> a -> b
$ a
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith Op as a
o
{-# INLINE runOp #-}
gradOpWith
:: Op as a
-> Rec Identity as
-> a
-> Rec Identity as
gradOpWith :: forall (as :: [*]) a.
Op as a -> Rec Identity as -> a -> Rec Identity as
gradOpWith Op as a
o = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith Op as a
o
{-# INLINE gradOpWith #-}
gradOp :: Num a => Op as a -> Rec Identity as -> Rec Identity as
gradOp :: forall a (as :: [*]).
Num a =>
Op as a -> Rec Identity as -> Rec Identity as
gradOp Op as a
o Rec Identity as
i = forall (as :: [*]) a.
Op as a -> Rec Identity as -> a -> Rec Identity as
gradOpWith Op as a
o Rec Identity as
i a
1
{-# INLINE gradOp #-}
opCoerce :: Coercible a b => Op '[a] b
opCoerce :: forall a b. Coercible a b => Op '[a] b
opCoerce = forall a b. (a -> b) -> (b -> a) -> Op '[a] b
opIso coerce :: forall a b. Coercible a b => a -> b
coerce coerce :: forall a b. Coercible a b => a -> b
coerce
{-# INLINE opCoerce #-}
noGrad1 :: (a -> b) -> Op '[a] b
noGrad1 :: forall a b. (a -> b) -> Op '[a] b
noGrad1 a -> b
f = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x ->
( a -> b
f a
x
, \b
_ -> forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Numeric.Backprop.Op.noGrad1: no gradient defined"
)
{-# INLINE noGrad1 #-}
noGrad :: (Rec Identity as -> b) -> Op as b
noGrad :: forall (as :: [*]) b. (Rec Identity as -> b) -> Op as b
noGrad Rec Identity as -> b
f = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ \Rec Identity as
xs ->
( Rec Identity as -> b
f Rec Identity as
xs
, \b
_ -> forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Numeric.Backprop.Op.noGrad: no gradient defined"
)
{-# INLINE noGrad #-}
idOp :: Op '[a] a
idOp :: forall a. Op '[a] a
idOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (a
x, forall a. a -> a
id)
{-# INLINE idOp #-}
opTup :: Op as (Rec Identity as)
opTup :: forall (as :: [*]). Op as (Rec Identity as)
opTup = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ \Rec Identity as
xs -> (Rec Identity as
xs, forall a. a -> a
id)
{-# INLINE opTup #-}
opIso :: (a -> b) -> (b -> a) -> Op '[ a ] b
opIso :: forall a b. (a -> b) -> (b -> a) -> Op '[a] b
opIso a -> b
to' b -> a
from' = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> b
to' a
x, b -> a
from')
{-# INLINE opIso #-}
opIso2 :: (a -> b -> c) -> (c -> (a, b)) -> Op '[a, b] c
opIso2 :: forall a b c. (a -> b -> c) -> (c -> (a, b)) -> Op '[a, b] c
opIso2 a -> b -> c
to' c -> (a, b)
from' = forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 forall a b. (a -> b) -> a -> b
$ \a
x b
y -> (a -> b -> c
to' a
x b
y, c -> (a, b)
from')
{-# INLINE opIso2 #-}
opIso3 :: (a -> b -> c -> d) -> (d -> (a, b, c)) -> Op '[a, b, c] d
opIso3 :: forall a b c d.
(a -> b -> c -> d) -> (d -> (a, b, c)) -> Op '[a, b, c] d
opIso3 a -> b -> c -> d
to' d -> (a, b, c)
from' = forall a b c d.
(a -> b -> c -> (d, d -> (a, b, c))) -> Op '[a, b, c] d
op3 forall a b. (a -> b) -> a -> b
$ \a
x b
y c
z -> (a -> b -> c -> d
to' a
x b
y c
z, d -> (a, b, c)
from')
{-# INLINE opIso3 #-}
opIsoN :: (Rec Identity as -> b) -> (b -> Rec Identity as) -> Op as b
opIsoN :: forall (as :: [*]) b.
(Rec Identity as -> b) -> (b -> Rec Identity as) -> Op as b
opIsoN Rec Identity as -> b
to' b -> Rec Identity as
from' = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ \Rec Identity as
xs -> (Rec Identity as -> b
to' Rec Identity as
xs, b -> Rec Identity as
from')
{-# INLINE opIsoN #-}
opLens :: Num a => Lens' a b -> Op '[ a ] b
opLens :: forall a b. Num a => Lens' a b -> Op '[a] b
opLens Lens' a b
l = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a s. Getting a s a -> s -> a
view Lens' a b
l a
x, \b
d -> forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' a b
l b
d a
0)
{-# INLINE opLens #-}
opConst
:: forall as a. RPureConstrained Num as
=> a
-> Op as a
opConst :: forall (as :: [*]) a. RPureConstrained Num as => a -> Op as a
opConst a
x = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const
(a
x, forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k -> Constraint) (ts :: [k]) (f :: k -> *).
RPureConstrained c ts =>
(forall (a :: k). c a => f a) -> Rec f ts
rpureConstrained @Num Identity a
0)
{-# INLINE opConst #-}
op0 :: a -> Op '[] a
op0 :: forall a. a -> Op '[] a
op0 a
x = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ \case
Rec Identity '[]
RNil -> (a
x, forall a b. a -> b -> a
const forall {u} (a :: u -> *). Rec a '[]
RNil)
{-# INLINE op0 #-}
op1
:: (a -> (b, b -> a))
-> Op '[a] b
op1 :: forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 a -> (b, b -> a)
f = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ \case
Identity r
x :& Rec Identity rs
RNil ->
let (b
y, b -> a
dx) = a -> (b, b -> a)
f r
x
in (b
y, \(!b
d) -> (forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
dx forall a b. (a -> b) -> a -> b
$ b
d)
{-# INLINE op1 #-}
op2
:: (a -> b -> (c, c -> (a, b)))
-> Op '[a,b] c
op2 :: forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 a -> b -> (c, c -> (a, b))
f = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ \case
Identity r
x :& Identity r
y :& Rec Identity rs
RNil ->
let (c
z, c -> (a, b)
dxdy) = a -> b -> (c, c -> (a, b))
f r
x r
y
in (c
z, (\(!a
dx,!b
dy) -> forall a. a -> Identity a
Identity a
dx forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall a. a -> Identity a
Identity b
dy forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> (a, b)
dxdy)
{-# INLINE op2 #-}
op3
:: (a -> b -> c -> (d, d -> (a, b, c)))
-> Op '[a,b,c] d
op3 :: forall a b c d.
(a -> b -> c -> (d, d -> (a, b, c))) -> Op '[a, b, c] d
op3 a -> b -> c -> (d, d -> (a, b, c))
f = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op forall a b. (a -> b) -> a -> b
$ \case
Identity r
x :& Identity r
y :& Identity r
z :& Rec Identity rs
RNil ->
let (d
q, d -> (a, b, c)
dxdydz) = a -> b -> c -> (d, d -> (a, b, c))
f r
x r
y r
z
in (d
q, (\(!a
dx, !b
dy, !c
dz) -> forall a. a -> Identity a
Identity a
dx forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall a. a -> Identity a
Identity b
dy forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall a. a -> Identity a
Identity c
dz forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> (a, b, c)
dxdydz)
{-# INLINE op3 #-}
instance (RPureConstrained Num as, Num a) => Num (Op as a) where
Op as a
o1 + :: Op as a -> Op as a -> Op as a
+ Op as a
o2 = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Num a => Op '[a, a] a
(+.)
{-# INLINE (+) #-}
Op as a
o1 - :: Op as a -> Op as a -> Op as a
- Op as a
o2 = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Num a => Op '[a, a] a
(-.)
{-# INLINE (-) #-}
Op as a
o1 * :: Op as a -> Op as a -> Op as a
* Op as a
o2 = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Num a => Op '[a, a] a
(*.)
{-# INLINE (*) #-}
negate :: Op as a -> Op as a
negate Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Num a => Op '[a] a
negateOp
{-# INLINE negate #-}
signum :: Op as a -> Op as a
signum Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Num a => Op '[a] a
signumOp
{-# INLINE signum #-}
abs :: Op as a -> Op as a
abs Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Num a => Op '[a] a
absOp
{-# INLINE abs #-}
fromInteger :: Integer -> Op as a
fromInteger Integer
x = forall (as :: [*]) a. RPureConstrained Num as => a -> Op as a
opConst (forall a. Num a => Integer -> a
fromInteger Integer
x)
{-# INLINE fromInteger #-}
instance (RPureConstrained Num as, Fractional a) => Fractional (Op as a) where
Op as a
o1 / :: Op as a -> Op as a -> Op as a
/ Op as a
o2 = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Fractional a => Op '[a, a] a
(/.)
recip :: Op as a -> Op as a
recip Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Fractional a => Op '[a] a
recipOp
{-# INLINE recip #-}
fromRational :: Rational -> Op as a
fromRational Rational
x = forall (as :: [*]) a. RPureConstrained Num as => a -> Op as a
opConst (forall a. Fractional a => Rational -> a
fromRational Rational
x)
{-# INLINE fromRational #-}
instance (RPureConstrained Num as, Floating a) => Floating (Op as a) where
pi :: Op as a
pi = forall (as :: [*]) a. RPureConstrained Num as => a -> Op as a
opConst forall a. Floating a => a
pi
{-# INLINE pi #-}
exp :: Op as a -> Op as a
exp Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
expOp
{-# INLINE exp #-}
log :: Op as a -> Op as a
log Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
logOp
{-# INLINE log #-}
sqrt :: Op as a -> Op as a
sqrt Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
sqrtOp
{-# INLINE sqrt #-}
Op as a
o1 ** :: Op as a -> Op as a -> Op as a
** Op as a
o2 = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a, a] a
(**.)
{-# INLINE (**) #-}
logBase :: Op as a -> Op as a -> Op as a
logBase Op as a
o1 Op as a
o2 = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a, a] a
logBaseOp
{-# INLINE logBase #-}
sin :: Op as a -> Op as a
sin Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
sinOp
{-# INLINE sin #-}
cos :: Op as a -> Op as a
cos Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
cosOp
{-# INLINE cos #-}
tan :: Op as a -> Op as a
tan Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
tanOp
{-# INLINE tan #-}
asin :: Op as a -> Op as a
asin Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
asinOp
{-# INLINE asin #-}
acos :: Op as a -> Op as a
acos Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
acosOp
{-# INLINE acos #-}
atan :: Op as a -> Op as a
atan Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
atanOp
{-# INLINE atan #-}
sinh :: Op as a -> Op as a
sinh Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
sinhOp
{-# INLINE sinh #-}
cosh :: Op as a -> Op as a
cosh Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
coshOp
{-# INLINE cosh #-}
tanh :: Op as a -> Op as a
tanh Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
tanhOp
{-# INLINE tanh #-}
asinh :: Op as a -> Op as a
asinh Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
asinhOp
{-# INLINE asinh #-}
acosh :: Op as a -> Op as a
acosh Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
acoshOp
{-# INLINE acosh #-}
atanh :: Op as a -> Op as a
atanh Op as a
o = forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) forall a. Floating a => Op '[a] a
atanhOp
{-# INLINE atanh #-}
(+.) :: Num a => Op '[a, a] a
+. :: forall a. Num a => Op '[a, a] a
(+.) = forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 forall a b. (a -> b) -> a -> b
$ \a
x a
y -> (a
x forall a. Num a => a -> a -> a
+ a
y, \a
g -> (a
g, a
g))
{-# INLINE (+.) #-}
(-.) :: Num a => Op '[a, a] a
-. :: forall a. Num a => Op '[a, a] a
(-.) = forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 forall a b. (a -> b) -> a -> b
$ \a
x a
y -> (a
x forall a. Num a => a -> a -> a
- a
y, \a
g -> (a
g, -a
g))
{-# INLINE (-.) #-}
(*.) :: Num a => Op '[a, a] a
*. :: forall a. Num a => Op '[a, a] a
(*.) = forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 forall a b. (a -> b) -> a -> b
$ \a
x a
y -> (a
x forall a. Num a => a -> a -> a
* a
y, \a
g -> (a
yforall a. Num a => a -> a -> a
*a
g, a
xforall a. Num a => a -> a -> a
*a
g))
{-# INLINE (*.) #-}
(/.) :: Fractional a => Op '[a, a] a
/. :: forall a. Fractional a => Op '[a, a] a
(/.) = forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 forall a b. (a -> b) -> a -> b
$ \a
x a
y -> (a
x forall a. Fractional a => a -> a -> a
/ a
y, \a
g -> (a
gforall a. Fractional a => a -> a -> a
/a
y, -a
gforall a. Num a => a -> a -> a
*a
xforall a. Fractional a => a -> a -> a
/(a
yforall a. Num a => a -> a -> a
*a
y)))
{-# INLINE (/.) #-}
(**.) :: Floating a => Op '[a, a] a
**. :: forall a. Floating a => Op '[a, a] a
(**.) = forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 forall a b. (a -> b) -> a -> b
$ \a
x a
y -> ( a
x forall a. Floating a => a -> a -> a
** a
y
, let dx :: a
dx = a
yforall a. Num a => a -> a -> a
*a
xforall a. Floating a => a -> a -> a
**(a
yforall a. Num a => a -> a -> a
-a
1)
dy :: a
dy = a
xforall a. Floating a => a -> a -> a
**a
yforall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
log a
x
in \a
g -> (a
gforall a. Num a => a -> a -> a
*a
dx, a
gforall a. Num a => a -> a -> a
*a
dy)
)
{-# INLINE (**.) #-}
negateOp :: Num a => Op '[a] a
negateOp :: forall a. Num a => Op '[a] a
negateOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Num a => a -> a
negate a
x, forall a. Num a => a -> a
negate)
{-# INLINE negateOp #-}
signumOp :: Num a => Op '[a] a
signumOp :: forall a. Num a => Op '[a] a
signumOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Num a => a -> a
signum a
x, forall a b. a -> b -> a
const a
0)
{-# INLINE signumOp #-}
absOp :: Num a => Op '[a] a
absOp :: forall a. Num a => Op '[a] a
absOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Num a => a -> a
abs a
x, (forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
signum a
x))
{-# INLINE absOp #-}
recipOp :: Fractional a => Op '[a] a
recipOp :: forall a. Fractional a => Op '[a] a
recipOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Fractional a => a -> a
recip a
x, (forall a. Fractional a => a -> a -> a
/(a
xforall a. Num a => a -> a -> a
*a
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate)
{-# INLINE recipOp #-}
expOp :: Floating a => Op '[a] a
expOp :: forall a. Floating a => Op '[a] a
expOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
exp a
x, (forall a. Floating a => a -> a
exp a
x forall a. Num a => a -> a -> a
*))
{-# INLINE expOp #-}
logOp :: Floating a => Op '[a] a
logOp :: forall a. Floating a => Op '[a] a
logOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
log a
x, (forall a. Fractional a => a -> a -> a
/a
x))
{-# INLINE logOp #-}
sqrtOp :: Floating a => Op '[a] a
sqrtOp :: forall a. Floating a => Op '[a] a
sqrtOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
sqrt a
x, (forall a. Fractional a => a -> a -> a
/ (a
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt a
x)))
{-# INLINE sqrtOp #-}
logBaseOp :: Floating a => Op '[a, a] a
logBaseOp :: forall a. Floating a => Op '[a, a] a
logBaseOp = forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 forall a b. (a -> b) -> a -> b
$ \a
x a
y -> ( forall a. Floating a => a -> a -> a
logBase a
x a
y
, let dx :: a
dx = - forall a. Floating a => a -> a -> a
logBase a
x a
y forall a. Fractional a => a -> a -> a
/ (forall a. Floating a => a -> a
log a
x forall a. Num a => a -> a -> a
* a
x)
in \a
g -> (a
gforall a. Num a => a -> a -> a
*a
dx, a
gforall a. Fractional a => a -> a -> a
/(a
y forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
log a
x))
)
{-# INLINE logBaseOp #-}
sinOp :: Floating a => Op '[a] a
sinOp :: forall a. Floating a => Op '[a] a
sinOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
sin a
x, (forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos a
x))
{-# INLINE sinOp #-}
cosOp :: Floating a => Op '[a] a
cosOp :: forall a. Floating a => Op '[a] a
cosOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
cos a
x, (forall a. Num a => a -> a -> a
* (-forall a. Floating a => a -> a
sin a
x)))
{-# INLINE cosOp #-}
tanOp :: Floating a => Op '[a] a
tanOp :: forall a. Floating a => Op '[a] a
tanOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
tan a
x, (forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
cos a
xforall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)))
{-# INLINE tanOp #-}
asinOp :: Floating a => Op '[a] a
asinOp :: forall a. Floating a => Op '[a] a
asinOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
asin a
x, (forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
sqrt(a
1 forall a. Num a => a -> a -> a
- a
xforall a. Num a => a -> a -> a
*a
x)))
{-# INLINE asinOp #-}
acosOp :: Floating a => Op '[a] a
acosOp :: forall a. Floating a => Op '[a] a
acosOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
acos a
x, (forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
sqrt (a
1 forall a. Num a => a -> a -> a
- a
xforall a. Num a => a -> a -> a
*a
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a
negate)
{-# INLINE acosOp #-}
atanOp :: Floating a => Op '[a] a
atanOp :: forall a. Floating a => Op '[a] a
atanOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
atan a
x, (forall a. Fractional a => a -> a -> a
/ (a
xforall a. Num a => a -> a -> a
*a
x forall a. Num a => a -> a -> a
+ a
1)))
{-# INLINE atanOp #-}
sinhOp :: Floating a => Op '[a] a
sinhOp :: forall a. Floating a => Op '[a] a
sinhOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
sinh a
x, (forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cosh a
x))
{-# INLINE sinhOp #-}
coshOp :: Floating a => Op '[a] a
coshOp :: forall a. Floating a => Op '[a] a
coshOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
cosh a
x, (forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sinh a
x))
{-# INLINE coshOp #-}
tanhOp :: Floating a => Op '[a] a
tanhOp :: forall a. Floating a => Op '[a] a
tanhOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
tanh a
x, (forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
cosh a
xforall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)))
{-# INLINE tanhOp #-}
asinhOp :: Floating a => Op '[a] a
asinhOp :: forall a. Floating a => Op '[a] a
asinhOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
asinh a
x, (forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
sqrt (a
xforall a. Num a => a -> a -> a
*a
x forall a. Num a => a -> a -> a
+ a
1)))
{-# INLINE asinhOp #-}
acoshOp :: Floating a => Op '[a] a
acoshOp :: forall a. Floating a => Op '[a] a
acoshOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
acosh a
x, (forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
sqrt (a
xforall a. Num a => a -> a -> a
*a
x forall a. Num a => a -> a -> a
- a
1)))
{-# INLINE acoshOp #-}
atanhOp :: Floating a => Op '[a] a
atanhOp :: forall a. Floating a => Op '[a] a
atanhOp = forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 forall a b. (a -> b) -> a -> b
$ \a
x -> (forall a. Floating a => a -> a
atanh a
x, (forall a. Fractional a => a -> a -> a
/ (a
1 forall a. Num a => a -> a -> a
- a
xforall a. Num a => a -> a -> a
*a
x)))
{-# INLINE atanhOp #-}