{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
module Numeric.Backprop.Explicit (
BVar, W, Backprop(..), ABP(..), NumBP(..)
, ZeroFunc(..), zfNum, zfNums, zeroFunc, zeroFuncs, zfFunctor
, AddFunc(..), afNum, afNums, addFunc, addFuncs
, OneFunc(..), ofNum, ofNums, oneFunc, oneFuncs, ofFunctor
, backprop, evalBP, gradBP, backpropWith
, evalBP0
, backprop2, evalBP2, gradBP2, backpropWith2
, backpropN, evalBPN, gradBPN, backpropWithN, RPureConstrained
, constVar, auto, coerceVar
, viewVar, setVar, overVar
, sequenceVar, collectVar
, previewVar, toListOfVar
, isoVar, isoVar2, isoVar3, isoVarN
, liftOp
, liftOp1, liftOp2, liftOp3
, splitBV
, joinBV
, BVGroup
, Op(..)
, op0, opConst, idOp
, bpOp
, op1, op2, op3
, opCoerce, opTup, opIso, opIsoN, opLens
, noGrad1, noGrad
, Reifies
) where
import Data.Bifunctor
import Data.Functor.Identity
import Data.Reflection
import Data.Type.Util
import Data.Vinyl.Core
import Data.Vinyl.TypeLevel
import GHC.Generics as G
import Lens.Micro
import Numeric.Backprop.Class
import Numeric.Backprop.Internal
import Numeric.Backprop.Op
import Unsafe.Coerce
zfNums :: RPureConstrained Num as => Rec ZeroFunc as
zfNums :: forall (as :: [*]). RPureConstrained Num as => Rec ZeroFunc as
zfNums = 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 a. Num a => ZeroFunc a
zfNum
zfFunctor :: (Backprop a, Functor f) => ZeroFunc (f a)
zfFunctor :: forall a (f :: * -> *). (Backprop a, Functor f) => ZeroFunc (f a)
zfFunctor = forall a. (a -> a) -> ZeroFunc a
ZF forall (f :: * -> *) a. (Functor f, Backprop a) => f a -> f a
zeroFunctor
{-# INLINE zfFunctor #-}
afNums :: RPureConstrained Num as => Rec AddFunc as
afNums :: forall (as :: [*]). RPureConstrained Num as => Rec AddFunc as
afNums = 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 a. Num a => AddFunc a
afNum
ofNums :: RPureConstrained Num as => Rec OneFunc as
ofNums :: forall (as :: [*]). RPureConstrained Num as => Rec OneFunc as
ofNums = 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 a. Num a => OneFunc a
ofNum
ofFunctor :: (Backprop a, Functor f) => OneFunc (f a)
ofFunctor :: forall a (f :: * -> *). (Backprop a, Functor f) => OneFunc (f a)
ofFunctor = forall a. (a -> a) -> OneFunc a
OF forall (f :: * -> *) a. (Functor f, Backprop a) => f a -> f a
oneFunctor
{-# INLINE ofFunctor #-}
zeroFuncs :: RPureConstrained Backprop as => Rec ZeroFunc as
zeroFuncs :: forall (as :: [*]). RPureConstrained Backprop as => Rec ZeroFunc as
zeroFuncs = forall {k} (c :: k -> Constraint) (ts :: [k]) (f :: k -> *).
RPureConstrained c ts =>
(forall (a :: k). c a => f a) -> Rec f ts
rpureConstrained @Backprop forall a. Backprop a => ZeroFunc a
zeroFunc
addFuncs :: RPureConstrained Backprop as => Rec AddFunc as
addFuncs :: forall (as :: [*]). RPureConstrained Backprop as => Rec AddFunc as
addFuncs = forall {k} (c :: k -> Constraint) (ts :: [k]) (f :: k -> *).
RPureConstrained c ts =>
(forall (a :: k). c a => f a) -> Rec f ts
rpureConstrained @Backprop forall a. Backprop a => AddFunc a
addFunc
oneFuncs :: RPureConstrained Backprop as => Rec OneFunc as
oneFuncs :: forall (as :: [*]). RPureConstrained Backprop as => Rec OneFunc as
oneFuncs = forall {k} (c :: k -> Constraint) (ts :: [k]) (f :: k -> *).
RPureConstrained c ts =>
(forall (a :: k). c a => f a) -> Rec f ts
rpureConstrained @Backprop forall a. Backprop a => OneFunc a
oneFunc
auto :: a -> BVar s a
auto :: forall a s. a -> BVar s a
auto = forall a s. a -> BVar s a
constVar
{-# INLINE auto #-}
backpropN
:: forall as b. ()
=> Rec ZeroFunc as
-> OneFunc b
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, Rec Identity as)
backpropN :: forall (as :: [*]) b.
Rec ZeroFunc as
-> OneFunc b
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, Rec Identity as)
backpropN Rec ZeroFunc as
zfs OneFunc b
ob forall s. Reifies s W => Rec (BVar s) as -> BVar s b
f Rec Identity as
xs = case forall (as :: [*]) b.
Rec ZeroFunc as
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, b -> Rec Identity as)
backpropWithN Rec ZeroFunc as
zfs forall s. Reifies s W => Rec (BVar s) as -> BVar s b
f Rec Identity as
xs of
(b
y, b -> Rec Identity as
g) -> (b
y, b -> Rec Identity as
g (forall a. OneFunc a -> a -> a
runOF OneFunc b
ob b
y))
{-# INLINE backpropN #-}
backprop
:: ZeroFunc a
-> OneFunc b
-> (forall s. Reifies s W => BVar s a -> BVar s b)
-> a
-> (b, a)
backprop :: forall a b.
ZeroFunc a
-> OneFunc b
-> (forall s. Reifies s W => BVar s a -> BVar s b)
-> a
-> (b, a)
backprop ZeroFunc a
zfa OneFunc b
ofb forall s. Reifies s W => BVar s a -> BVar s b
f = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\case Identity a
x :& Rec Identity rs
RNil -> a
x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (as :: [*]) b.
Rec ZeroFunc as
-> OneFunc b
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, Rec Identity as)
backpropN (ZeroFunc a
zfa forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) OneFunc b
ofb (forall s. Reifies s W => BVar s a -> BVar s b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\case BVar s r
x :& Rec (BVar s) rs
RNil -> BVar s r
x))
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)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity
{-# INLINE backprop #-}
backpropWith
:: ZeroFunc a
-> (forall s. Reifies s W => BVar s a -> BVar s b)
-> a
-> (b, b -> a)
backpropWith :: forall a b.
ZeroFunc a
-> (forall s. Reifies s W => BVar s a -> BVar s b)
-> a
-> (b, b -> a)
backpropWith ZeroFunc a
zfa forall s. Reifies s W => BVar s a -> BVar s b
f = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((\case Identity a
x :& Rec Identity rs
RNil -> a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (as :: [*]) b.
Rec ZeroFunc as
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, b -> Rec Identity as)
backpropWithN (ZeroFunc a
zfa 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 s. Reifies s W => BVar s a -> BVar s b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\case BVar s r
x :& Rec (BVar s) rs
RNil -> BVar s r
x))
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)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity
{-# INLINE backpropWith #-}
evalBP0 :: (forall s. Reifies s W => BVar s a) -> a
evalBP0 :: forall a. (forall s. Reifies s W => BVar s a) -> a
evalBP0 forall s. Reifies s W => BVar s a
x = forall (as :: [*]) b.
(forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as -> b
evalBPN (forall a b. a -> b -> a
const forall s. Reifies s W => BVar s a
x) forall {u} (a :: u -> *). Rec a '[]
RNil
{-# INLINE evalBP0 #-}
evalBP :: (forall s. Reifies s W => BVar s a -> BVar s b) -> a -> b
evalBP :: forall a b.
(forall s. Reifies s W => BVar s a -> BVar s b) -> a -> b
evalBP forall s. Reifies s W => BVar s a -> BVar s b
f = forall (as :: [*]) b.
(forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as -> b
evalBPN (forall s. Reifies s W => BVar s a -> BVar s b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\case BVar s r
x :& Rec (BVar s) rs
RNil -> BVar s r
x)) 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity
{-# INLINE evalBP #-}
gradBP
:: ZeroFunc a
-> OneFunc b
-> (forall s. Reifies s W => BVar s a -> BVar s b)
-> a
-> a
gradBP :: forall a b.
ZeroFunc a
-> OneFunc b
-> (forall s. Reifies s W => BVar s a -> BVar s b)
-> a
-> a
gradBP ZeroFunc a
zfa OneFunc b
ofb forall s. Reifies s W => BVar s a -> BVar s b
f = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
ZeroFunc a
-> OneFunc b
-> (forall s. Reifies s W => BVar s a -> BVar s b)
-> a
-> (b, a)
backprop ZeroFunc a
zfa OneFunc b
ofb forall s. Reifies s W => BVar s a -> BVar s b
f
{-# INLINE gradBP #-}
gradBPN
:: Rec ZeroFunc as
-> OneFunc b
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> Rec Identity as
gradBPN :: forall (as :: [*]) b.
Rec ZeroFunc as
-> OneFunc b
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> Rec Identity as
gradBPN Rec ZeroFunc as
zfas OneFunc b
ofb forall s. Reifies s W => Rec (BVar s) as -> BVar s b
f = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (as :: [*]) b.
Rec ZeroFunc as
-> OneFunc b
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, Rec Identity as)
backpropN Rec ZeroFunc as
zfas OneFunc b
ofb forall s. Reifies s W => Rec (BVar s) as -> BVar s b
f
{-# INLINE gradBPN #-}
backprop2
:: ZeroFunc a
-> ZeroFunc b
-> OneFunc c
-> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a
-> b
-> (c, (a, b))
backprop2 :: forall a b c.
ZeroFunc a
-> ZeroFunc b
-> OneFunc c
-> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a
-> b
-> (c, (a, b))
backprop2 ZeroFunc a
zfa ZeroFunc b
zfb OneFunc c
ofc forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c
f a
x b
y = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\(Identity a
dx :& Identity b
dy :& Rec Identity rs
RNil) -> (a
dx, b
dy)) forall a b. (a -> b) -> a -> b
$
forall (as :: [*]) b.
Rec ZeroFunc as
-> OneFunc b
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, Rec Identity as)
backpropN (ZeroFunc a
zfa forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& ZeroFunc b
zfb forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil) OneFunc c
ofc
(\(BVar s r
x' :& BVar s r
y' :& Rec (BVar s) rs
RNil) -> forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c
f BVar s r
x' BVar s r
y')
(forall a. a -> Identity a
Identity a
x forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall a. a -> Identity a
Identity b
y forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil)
{-# INLINE backprop2 #-}
backpropWith2
:: ZeroFunc a
-> ZeroFunc b
-> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a
-> b
-> (c, c -> (a, b))
backpropWith2 :: forall a b c.
ZeroFunc a
-> ZeroFunc b
-> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a
-> b
-> (c, c -> (a, b))
backpropWith2 ZeroFunc a
zfa ZeroFunc b
zfb forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c
f a
x b
y = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((\(Identity a
dx :& Identity b
dy :& Rec Identity rs
RNil) -> (a
dx, b
dy)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall a b. (a -> b) -> a -> b
$
forall (as :: [*]) b.
Rec ZeroFunc as
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, b -> Rec Identity as)
backpropWithN (ZeroFunc a
zfa forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& ZeroFunc b
zfb forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil)
(\(BVar s r
x' :& BVar s r
y' :& Rec (BVar s) rs
RNil) -> forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c
f BVar s r
x' BVar s r
y')
(forall a. a -> Identity a
Identity a
x forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall a. a -> Identity a
Identity b
y forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil)
{-# INLINE backpropWith2 #-}
evalBP2
:: (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a
-> b
-> c
evalBP2 :: forall a b c.
(forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a -> b -> c
evalBP2 forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c
f a
x b
y = forall (as :: [*]) b.
(forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as -> b
evalBPN (\(BVar s r
x' :& BVar s r
y' :& Rec (BVar s) rs
RNil) -> forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c
f BVar s r
x' BVar s r
y') forall a b. (a -> b) -> a -> b
$ forall a. a -> Identity a
Identity a
x
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall a. a -> Identity a
Identity b
y
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil
{-# INLINE evalBP2 #-}
gradBP2
:: ZeroFunc a
-> ZeroFunc b
-> OneFunc c
-> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a
-> b
-> (a, b)
gradBP2 :: forall a b c.
ZeroFunc a
-> ZeroFunc b
-> OneFunc c
-> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a
-> b
-> (a, b)
gradBP2 ZeroFunc a
zfa ZeroFunc b
zfb OneFunc c
ofc forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c
f a
x = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c.
ZeroFunc a
-> ZeroFunc b
-> OneFunc c
-> (forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c)
-> a
-> b
-> (c, (a, b))
backprop2 ZeroFunc a
zfa ZeroFunc b
zfb OneFunc c
ofc forall s. Reifies s W => BVar s a -> BVar s b -> BVar s c
f a
x
{-# INLINE gradBP2 #-}
bpOp
:: Rec ZeroFunc as
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Op as b
bpOp :: forall (as :: [*]) b.
Rec ZeroFunc as
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Op as b
bpOp Rec ZeroFunc as
zfs forall s. Reifies s W => Rec (BVar s) as -> BVar s b
f = forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op (forall (as :: [*]) b.
Rec ZeroFunc as
-> (forall s. Reifies s W => Rec (BVar s) as -> BVar s b)
-> Rec Identity as
-> (b, b -> Rec Identity as)
backpropWithN Rec ZeroFunc as
zfs forall s. Reifies s W => Rec (BVar s) as -> BVar s b
f)
{-# INLINE bpOp #-}
overVar
:: Reifies s W
=> AddFunc a
-> AddFunc b
-> ZeroFunc a
-> ZeroFunc b
-> Lens' b a
-> (BVar s a -> BVar s a)
-> BVar s b
-> BVar s b
overVar :: forall s a b.
Reifies s W =>
AddFunc a
-> AddFunc b
-> ZeroFunc a
-> ZeroFunc b
-> Lens' b a
-> (BVar s a -> BVar s a)
-> BVar s b
-> BVar s b
overVar AddFunc a
afa AddFunc b
afb ZeroFunc a
zfa ZeroFunc b
zfb Lens' b a
l BVar s a -> BVar s a
f BVar s b
x = forall a b s.
Reifies s W =>
AddFunc a
-> AddFunc b
-> ZeroFunc a
-> Lens' b a
-> BVar s a
-> BVar s b
-> BVar s b
setVar AddFunc a
afa AddFunc b
afb ZeroFunc a
zfa Lens' b a
l (BVar s a -> BVar s a
f (forall a b s.
Reifies s W =>
AddFunc a -> ZeroFunc b -> Lens' b a -> BVar s b -> BVar s a
viewVar AddFunc a
afa ZeroFunc b
zfb Lens' b a
l BVar s b
x)) BVar s b
x
{-# INLINE overVar #-}
isoVar
:: Reifies s W
=> AddFunc a
-> (a -> b)
-> (b -> a)
-> BVar s a
-> BVar s b
isoVar :: forall s a b.
Reifies s W =>
AddFunc a -> (a -> b) -> (b -> a) -> BVar s a -> BVar s b
isoVar AddFunc a
af a -> b
f b -> a
g = forall a b s.
Reifies s W =>
AddFunc a -> Op '[a] b -> BVar s a -> BVar s b
liftOp1 AddFunc a
af (forall a b. (a -> b) -> (b -> a) -> Op '[a] b
opIso a -> b
f b -> a
g)
{-# INLINE isoVar #-}
isoVar2
:: Reifies s W
=> AddFunc a
-> AddFunc b
-> (a -> b -> c)
-> (c -> (a, b))
-> BVar s a
-> BVar s b
-> BVar s c
isoVar2 :: forall s a b c.
Reifies s W =>
AddFunc a
-> AddFunc b
-> (a -> b -> c)
-> (c -> (a, b))
-> BVar s a
-> BVar s b
-> BVar s c
isoVar2 AddFunc a
afa AddFunc b
afb a -> b -> c
f c -> (a, b)
g = forall a b c s.
Reifies s W =>
AddFunc a
-> AddFunc b -> Op '[a, b] c -> BVar s a -> BVar s b -> BVar s c
liftOp2 AddFunc a
afa AddFunc b
afb (forall a b c. (a -> b -> c) -> (c -> (a, b)) -> Op '[a, b] c
opIso2 a -> b -> c
f c -> (a, b)
g)
{-# INLINE isoVar2 #-}
isoVar3
:: Reifies s W
=> AddFunc a
-> AddFunc b
-> AddFunc c
-> (a -> b -> c -> d)
-> (d -> (a, b, c))
-> BVar s a
-> BVar s b
-> BVar s c
-> BVar s d
isoVar3 :: forall s a b c d.
Reifies s W =>
AddFunc a
-> AddFunc b
-> AddFunc c
-> (a -> b -> c -> d)
-> (d -> (a, b, c))
-> BVar s a
-> BVar s b
-> BVar s c
-> BVar s d
isoVar3 AddFunc a
afa AddFunc b
afb AddFunc c
afc a -> b -> c -> d
f d -> (a, b, c)
g = forall a b c d s.
Reifies s W =>
AddFunc a
-> AddFunc b
-> AddFunc c
-> Op '[a, b, c] d
-> BVar s a
-> BVar s b
-> BVar s c
-> BVar s d
liftOp3 AddFunc a
afa AddFunc b
afb AddFunc c
afc (forall a b c d.
(a -> b -> c -> d) -> (d -> (a, b, c)) -> Op '[a, b, c] d
opIso3 a -> b -> c -> d
f d -> (a, b, c)
g)
{-# INLINE isoVar3 #-}
isoVarN
:: Reifies s W
=> Rec AddFunc as
-> (Rec Identity as -> b)
-> (b -> Rec Identity as)
-> Rec (BVar s) as
-> BVar s b
isoVarN :: forall s (as :: [*]) b.
Reifies s W =>
Rec AddFunc as
-> (Rec Identity as -> b)
-> (b -> Rec Identity as)
-> Rec (BVar s) as
-> BVar s b
isoVarN Rec AddFunc as
afs Rec Identity as -> b
f b -> Rec Identity as
g = forall (as :: [*]) b s.
Reifies s W =>
Rec AddFunc as -> Op as b -> Rec (BVar s) as -> BVar s b
liftOp Rec AddFunc as
afs (forall (as :: [*]) b.
(Rec Identity as -> b) -> (b -> Rec Identity as) -> Op as b
opIsoN Rec Identity as -> b
f b -> Rec Identity as
g)
{-# INLINE isoVarN #-}
class BVGroup s as i o | o -> i, i -> as where
gsplitBV :: Rec AddFunc as -> Rec ZeroFunc as -> BVar s (i ()) -> o ()
gjoinBV :: Rec AddFunc as -> Rec ZeroFunc as -> o () -> BVar s (i ())
instance BVGroup s '[] (K1 i a) (K1 i (BVar s a)) where
gsplitBV :: Rec AddFunc '[]
-> Rec ZeroFunc '[] -> BVar s (K1 i a ()) -> K1 i (BVar s a) ()
gsplitBV Rec AddFunc '[]
_ Rec ZeroFunc '[]
_ = forall k i c (p :: k). c -> K1 i c p
K1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b s. Coercible a b => BVar s a -> BVar s b
coerceVar
{-# INLINE gsplitBV #-}
gjoinBV :: Rec AddFunc '[]
-> Rec ZeroFunc '[] -> K1 i (BVar s a) () -> BVar s (K1 i a ())
gjoinBV Rec AddFunc '[]
_ Rec ZeroFunc '[]
_ = forall a b s. Coercible a b => BVar s a -> BVar s b
coerceVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1
{-# INLINE gjoinBV #-}
instance BVGroup s as i o
=> BVGroup s as (M1 p c i) (M1 p c o) where
gsplitBV :: Rec AddFunc as
-> Rec ZeroFunc as -> BVar s (M1 p c i ()) -> M1 p c o ()
gsplitBV Rec AddFunc as
afs Rec ZeroFunc as
zfs = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> BVar s (i ()) -> o ()
gsplitBV Rec AddFunc as
afs Rec ZeroFunc as
zfs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b s. Coercible a b => BVar s a -> BVar s b
coerceVar @_ @(i ())
{-# INLINE gsplitBV #-}
gjoinBV :: Rec AddFunc as
-> Rec ZeroFunc as -> M1 p c o () -> BVar s (M1 p c i ())
gjoinBV Rec AddFunc as
afs Rec ZeroFunc as
zfs = forall a b s. Coercible a b => BVar s a -> BVar s b
coerceVar @(i ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> o () -> BVar s (i ())
gjoinBV Rec AddFunc as
afs Rec ZeroFunc as
zfs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
{-# INLINE gjoinBV #-}
instance BVGroup s '[] V1 V1 where
gsplitBV :: Rec AddFunc '[] -> Rec ZeroFunc '[] -> BVar s (V1 ()) -> V1 ()
gsplitBV Rec AddFunc '[]
_ Rec ZeroFunc '[]
_ = forall a b. a -> b
unsafeCoerce
{-# INLINE gsplitBV #-}
gjoinBV :: Rec AddFunc '[] -> Rec ZeroFunc '[] -> V1 () -> BVar s (V1 ())
gjoinBV Rec AddFunc '[]
_ Rec ZeroFunc '[]
_ = V1 () -> BVar s (V1 ())
\case
{-# INLINE gjoinBV #-}
instance BVGroup s '[] U1 U1 where
gsplitBV :: Rec AddFunc '[] -> Rec ZeroFunc '[] -> BVar s (U1 ()) -> U1 ()
gsplitBV Rec AddFunc '[]
_ Rec ZeroFunc '[]
_ BVar s (U1 ())
_ = forall k (p :: k). U1 p
U1
{-# INLINE gsplitBV #-}
gjoinBV :: Rec AddFunc '[] -> Rec ZeroFunc '[] -> U1 () -> BVar s (U1 ())
gjoinBV Rec AddFunc '[]
_ Rec ZeroFunc '[]
_ U1 ()
_ = forall a s. a -> BVar s a
constVar forall k (p :: k). U1 p
U1
{-# INLINE gjoinBV #-}
instance ( Reifies s W
, BVGroup s as i1 o1
, BVGroup s bs i2 o2
, cs ~ (as ++ bs)
, RecApplicative as
) => BVGroup s (i1 () ': i2 () ': cs) (i1 :*: i2) (o1 :*: o2) where
gsplitBV :: Rec AddFunc (i1 () : i2 () : cs)
-> Rec ZeroFunc (i1 () : i2 () : cs)
-> BVar s ((:*:) i1 i2 ())
-> (:*:) o1 o2 ()
gsplitBV (AddFunc r
afa :& AddFunc r
afb :& Rec AddFunc rs
afs) (ZeroFunc r
zfa :& ZeroFunc r
zfb :& Rec ZeroFunc rs
zfs) BVar s ((:*:) i1 i2 ())
xy = o1 ()
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: o2 ()
y
where
(Rec AddFunc as
afas, Rec AddFunc bs
afbs) = forall {u} (f :: u -> *) (as :: [u]) (bs :: [u]).
RecApplicative as =>
Rec f (as ++ bs) -> (Rec f as, Rec f bs)
splitRec Rec AddFunc rs
afs
(Rec ZeroFunc as
zfas, Rec ZeroFunc bs
zfbs) = forall {u} (f :: u -> *) (as :: [u]) (bs :: [u]).
RecApplicative as =>
Rec f (as ++ bs) -> (Rec f as, Rec f bs)
splitRec Rec ZeroFunc rs
zfs
zfab :: ZeroFunc ((:*:) i1 i2 ())
zfab = forall a. (a -> a) -> ZeroFunc a
ZF forall a b. (a -> b) -> a -> b
$ \(i1 ()
xx :*: i2 ()
yy) -> forall a. ZeroFunc a -> a -> a
runZF ZeroFunc r
zfa i1 ()
xx forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall a. ZeroFunc a -> a -> a
runZF ZeroFunc r
zfb i2 ()
yy
x :: o1 ()
x = forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> BVar s (i ()) -> o ()
gsplitBV Rec AddFunc as
afas Rec ZeroFunc as
zfas forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b s.
Reifies s W =>
AddFunc a -> ZeroFunc b -> Lens' b a -> BVar s b -> BVar s a
viewVar AddFunc r
afa ZeroFunc ((:*:) i1 i2 ())
zfab forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
Lens' ((:*:) f g a) (f a)
p1 forall a b. (a -> b) -> a -> b
$ BVar s ((:*:) i1 i2 ())
xy
y :: o2 ()
y = forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> BVar s (i ()) -> o ()
gsplitBV Rec AddFunc bs
afbs Rec ZeroFunc bs
zfbs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b s.
Reifies s W =>
AddFunc a -> ZeroFunc b -> Lens' b a -> BVar s b -> BVar s a
viewVar AddFunc r
afb ZeroFunc ((:*:) i1 i2 ())
zfab forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
Lens' ((:*:) f g a) (g a)
p2 forall a b. (a -> b) -> a -> b
$ BVar s ((:*:) i1 i2 ())
xy
{-# INLINE gsplitBV #-}
gjoinBV :: Rec AddFunc (i1 () : i2 () : cs)
-> Rec ZeroFunc (i1 () : i2 () : cs)
-> (:*:) o1 o2 ()
-> BVar s ((:*:) i1 i2 ())
gjoinBV (AddFunc r
afa :& AddFunc r
afb :& Rec AddFunc rs
afs) (ZeroFunc r
_ :& ZeroFunc r
_ :& Rec ZeroFunc rs
zfs) (o1 ()
x :*: o2 ()
y)
= forall s a b c.
Reifies s W =>
AddFunc a
-> AddFunc b
-> (a -> b -> c)
-> (c -> (a, b))
-> BVar s a
-> BVar s b
-> BVar s c
isoVar2 AddFunc r
afa AddFunc r
afb forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> (f p, g p)
unP
(forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> o () -> BVar s (i ())
gjoinBV Rec AddFunc as
afas Rec ZeroFunc as
zfas o1 ()
x)
(forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> o () -> BVar s (i ())
gjoinBV Rec AddFunc bs
afbs Rec ZeroFunc bs
zfbs o2 ()
y)
where
(Rec AddFunc as
afas, Rec AddFunc bs
afbs) = forall {u} (f :: u -> *) (as :: [u]) (bs :: [u]).
RecApplicative as =>
Rec f (as ++ bs) -> (Rec f as, Rec f bs)
splitRec Rec AddFunc rs
afs
(Rec ZeroFunc as
zfas, Rec ZeroFunc bs
zfbs) = forall {u} (f :: u -> *) (as :: [u]) (bs :: [u]).
RecApplicative as =>
Rec f (as ++ bs) -> (Rec f as, Rec f bs)
splitRec Rec ZeroFunc rs
zfs
unP :: (:*:) f g p -> (f p, g p)
unP (f p
xx :*: g p
yy) = (f p
xx, g p
yy)
{-# INLINE gjoinBV #-}
instance ( Reifies s W
, BVGroup s as i1 o1
, BVGroup s bs i2 o2
, cs ~ (as ++ bs)
, RecApplicative as
) => BVGroup s (i1 () ': i2 () ': cs) (i1 :+: i2) (o1 :+: o2) where
gsplitBV :: Rec AddFunc (i1 () : i2 () : cs)
-> Rec ZeroFunc (i1 () : i2 () : cs)
-> BVar s ((:+:) i1 i2 ())
-> (:+:) o1 o2 ()
gsplitBV (AddFunc r
afa :& AddFunc r
afb :& Rec AddFunc rs
afs) (ZeroFunc r
zfa :& ZeroFunc r
zfb :& Rec ZeroFunc rs
zfs) BVar s ((:+:) i1 i2 ())
xy =
case forall b a s.
Reifies s W =>
AddFunc a
-> ZeroFunc b -> Traversal' b a -> BVar s b -> Maybe (BVar s a)
previewVar AddFunc r
afa ZeroFunc ((:+:) i1 i2 ())
zf forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
Traversal' ((:+:) f g a) (f a)
s1 BVar s ((:+:) i1 i2 ())
xy of
Just BVar s r
x -> forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall a b. (a -> b) -> a -> b
$ forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> BVar s (i ()) -> o ()
gsplitBV Rec AddFunc as
afas Rec ZeroFunc as
zfas BVar s r
x
Maybe (BVar s r)
Nothing -> case forall b a s.
Reifies s W =>
AddFunc a
-> ZeroFunc b -> Traversal' b a -> BVar s b -> Maybe (BVar s a)
previewVar AddFunc r
afb ZeroFunc ((:+:) i1 i2 ())
zf forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
Traversal' ((:+:) f g a) (g a)
s2 BVar s ((:+:) i1 i2 ())
xy of
Just BVar s r
y -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall a b. (a -> b) -> a -> b
$ forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> BVar s (i ()) -> o ()
gsplitBV Rec AddFunc bs
afbs Rec ZeroFunc bs
zfbs BVar s r
y
Maybe (BVar s r)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"Numeric.Backprop.gsplitBV: Internal error occurred"
where
zf :: ZeroFunc ((:+:) i1 i2 ())
zf = forall a. (a -> a) -> ZeroFunc a
ZF forall a b. (a -> b) -> a -> b
$ \case
L1 i1 ()
xx -> forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall a b. (a -> b) -> a -> b
$ forall a. ZeroFunc a -> a -> a
runZF ZeroFunc r
zfa i1 ()
xx
R1 i2 ()
yy -> forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall a b. (a -> b) -> a -> b
$ forall a. ZeroFunc a -> a -> a
runZF ZeroFunc r
zfb i2 ()
yy
(Rec AddFunc as
afas, Rec AddFunc bs
afbs) = forall {u} (f :: u -> *) (as :: [u]) (bs :: [u]).
RecApplicative as =>
Rec f (as ++ bs) -> (Rec f as, Rec f bs)
splitRec Rec AddFunc rs
afs
(Rec ZeroFunc as
zfas, Rec ZeroFunc bs
zfbs) = forall {u} (f :: u -> *) (as :: [u]) (bs :: [u]).
RecApplicative as =>
Rec f (as ++ bs) -> (Rec f as, Rec f bs)
splitRec Rec ZeroFunc rs
zfs
{-# INLINE gsplitBV #-}
gjoinBV :: Rec AddFunc (i1 () : i2 () : cs)
-> Rec ZeroFunc (i1 () : i2 () : cs)
-> (:+:) o1 o2 ()
-> BVar s ((:+:) i1 i2 ())
gjoinBV (AddFunc r
afa :& AddFunc r
afb :& Rec AddFunc rs
afs) (ZeroFunc r
zfa :& ZeroFunc r
zfb :& Rec ZeroFunc rs
zfs) = \case
L1 o1 ()
x -> forall a b s.
Reifies s W =>
AddFunc a -> Op '[a] b -> BVar s a -> BVar s b
liftOp1 AddFunc r
afa (forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 (\r
xx -> (forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 r
xx, \case L1 i1 ()
d -> i1 ()
d; R1 i2 ()
_ -> forall a. ZeroFunc a -> a -> a
runZF ZeroFunc r
zfa r
xx)))
(forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> o () -> BVar s (i ())
gjoinBV Rec AddFunc as
afas Rec ZeroFunc as
zfas o1 ()
x)
R1 o2 ()
y -> forall a b s.
Reifies s W =>
AddFunc a -> Op '[a] b -> BVar s a -> BVar s b
liftOp1 AddFunc r
afb (forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 (\r
yy -> (forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 r
yy, \case L1 i1 ()
_ -> forall a. ZeroFunc a -> a -> a
runZF ZeroFunc r
zfb r
yy; R1 i2 ()
d -> i2 ()
d)))
(forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> o () -> BVar s (i ())
gjoinBV Rec AddFunc bs
afbs Rec ZeroFunc bs
zfbs o2 ()
y)
where
(Rec AddFunc as
afas, Rec AddFunc bs
afbs) = forall {u} (f :: u -> *) (as :: [u]) (bs :: [u]).
RecApplicative as =>
Rec f (as ++ bs) -> (Rec f as, Rec f bs)
splitRec Rec AddFunc rs
afs
(Rec ZeroFunc as
zfas, Rec ZeroFunc bs
zfbs) = forall {u} (f :: u -> *) (as :: [u]) (bs :: [u]).
RecApplicative as =>
Rec f (as ++ bs) -> (Rec f as, Rec f bs)
splitRec Rec ZeroFunc rs
zfs
{-# INLINE gjoinBV #-}
splitBV
:: forall z f s as.
( Generic (z f)
, Generic (z (BVar s))
, BVGroup s as (Rep (z f)) (Rep (z (BVar s)))
, Reifies s W
)
=> AddFunc (Rep (z f) ())
-> Rec AddFunc as
-> ZeroFunc (z f)
-> Rec ZeroFunc as
-> BVar s (z f)
-> z (BVar s)
splitBV :: forall (z :: (* -> *) -> *) (f :: * -> *) s (as :: [*]).
(Generic (z f), Generic (z (BVar s)),
BVGroup s as (Rep (z f)) (Rep (z (BVar s))), Reifies s W) =>
AddFunc (Rep (z f) ())
-> Rec AddFunc as
-> ZeroFunc (z f)
-> Rec ZeroFunc as
-> BVar s (z f)
-> z (BVar s)
splitBV AddFunc (Rep (z f) ())
af Rec AddFunc as
afs ZeroFunc (z f)
zf Rec ZeroFunc as
zfs =
forall a x. Generic a => Rep a x -> a
G.to
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> BVar s (i ()) -> o ()
gsplitBV Rec AddFunc as
afs Rec ZeroFunc as
zfs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b s.
Reifies s W =>
AddFunc a -> ZeroFunc b -> Lens' b a -> BVar s b -> BVar s a
viewVar AddFunc (Rep (z f) ())
af ZeroFunc (z f)
zf (forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall a x. Generic a => a -> Rep a x
from @(z f) @()) (forall a b. a -> b -> a
const forall a x. Generic a => Rep a x -> a
G.to))
{-# INLINE splitBV #-}
joinBV
:: forall z f s as.
( Generic (z f)
, Generic (z (BVar s))
, BVGroup s as (Rep (z f)) (Rep (z (BVar s)))
, Reifies s W
)
=> AddFunc (z f)
-> Rec AddFunc as
-> ZeroFunc (Rep (z f) ())
-> Rec ZeroFunc as
-> z (BVar s)
-> BVar s (z f)
joinBV :: forall (z :: (* -> *) -> *) (f :: * -> *) s (as :: [*]).
(Generic (z f), Generic (z (BVar s)),
BVGroup s as (Rep (z f)) (Rep (z (BVar s))), Reifies s W) =>
AddFunc (z f)
-> Rec AddFunc as
-> ZeroFunc (Rep (z f) ())
-> Rec ZeroFunc as
-> z (BVar s)
-> BVar s (z f)
joinBV AddFunc (z f)
af Rec AddFunc as
afs ZeroFunc (Rep (z f) ())
zf Rec ZeroFunc as
zfs =
forall a b s.
Reifies s W =>
AddFunc a -> ZeroFunc b -> Lens' b a -> BVar s b -> BVar s a
viewVar AddFunc (z f)
af ZeroFunc (Rep (z f) ())
zf (forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a x. Generic a => Rep a x -> a
G.to (forall a b. a -> b -> a
const forall a x. Generic a => a -> Rep a x
from))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (as :: [*]) (i :: * -> *) (o :: * -> *).
BVGroup s as i o =>
Rec AddFunc as -> Rec ZeroFunc as -> o () -> BVar s (i ())
gjoinBV Rec AddFunc as
afs Rec ZeroFunc as
zfs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from @(z (BVar s)) @()
{-# INLINE joinBV #-}