{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MonadComprehensions #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MonoLocalBinds #-} -- see below

{-# OPTIONS_GHC -Wall #-}
-- {-# OPTIONS_GHC -Wno-unused-imports #-} -- TEMP

-- {-# OPTIONS_GHC -fno-specialise #-}

#include "ConCat/Ops.inc"

-- | Simple feed-forward deep learning

module ConCat.Deep where

import Prelude hiding (zipWith)

import GHC.TypeLits ()
import GHC.Generics (Par1(..),(:*:)(..),(:.:)(..))

-- import Data.Foldable
import Data.Key
import Data.NumInstances.Function ()

import ConCat.Misc
import ConCat.Additive
import ConCat.AltCat  (Additive1(..),(<+))
-- import ConCat.Orphans (fstF, sndF)
import ConCat.RAD     (gradR)

{--------------------------------------------------------------------
    Simple linear algebra
--------------------------------------------------------------------}

-- | Generalized matrix
infixr 1 --*
type p --* q = q :.: p

infixl 7 *^, <.>, >.<

-- | Scale a vector
scaleV, (*^) :: (Functor a, Num s) => s -> Unop (a s)
-- s *^ v = scale s <$> v
s
s *^ :: forall (a :: * -> *) s. (Functor a, Num s) => s -> Unop (a s)
*^ a s
v = (s
s s -> s -> s
forall a. Num a => a -> a -> a
*) (s -> s) -> a s -> a s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a s
v
scaleV :: forall (a :: * -> *) s. (Functor a, Num s) => s -> Unop (a s)
scaleV = s -> Unop (a s)
forall (a :: * -> *) s. (Functor a, Num s) => s -> Unop (a s)
(*^)
{-# INLINE (*^) #-}

negateV :: (Functor a, Num s) => Unop (a s)
negateV :: forall (a :: * -> *) s. (Functor a, Num s) => Unop (a s)
negateV = ((-s
1) s -> Unop (a s)
forall (a :: * -> *) s. (Functor a, Num s) => s -> Unop (a s)
*^)
{-# INLINE negateV #-}

infixl 6 ^-^
(^-^) :: (Zip a, Num s) => Binop (a s)
^-^ :: forall (a :: * -> *) s. (Zip a, Num s) => Binop (a s)
(^-^) = (s -> s -> s) -> a s -> a s -> a s
forall a b c. (a -> b -> c) -> a a -> a b -> a c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (-)
{-# INLINE (^-^) #-}

-- (^-^) :: (Functor a, Num s, Additive1 (a s)) => Binop (a s)
-- u ^-^ v = u ^+^ negateV v

infixl 7 ^/
(^/) :: (Functor a, Fractional s) => a s -> s -> a s
a s
v ^/ :: forall (a :: * -> *) s.
(Functor a, Fractional s) =>
a s -> s -> a s
^/ s
s = s -> s
forall a. Fractional a => a -> a
recip s
s s -> Unop (a s)
forall (a :: * -> *) s. (Functor a, Num s) => s -> Unop (a s)
*^ a s
v
{-# INLINE (^/) #-}

normalize :: (Foldable a, Functor a, Fractional s, Additive s)
          => Unop (a s)
normalize :: forall (a :: * -> *) s.
(Foldable a, Functor a, Fractional s, Additive s) =>
Unop (a s)
normalize a s
v = a s
v a s -> s -> a s
forall (a :: * -> *) s.
(Functor a, Fractional s) =>
a s -> s -> a s
^/ a s -> s
forall (h :: * -> *) a. (Foldable h, Additive a) => h a -> a
sumA a s
v
{-# INLINE normalize #-}

-- | Inner product
dotV,(<.>) :: (Foldable a, Zip a, Additive s, Num s) => a s -> a s -> s
a s
xs <.> :: forall (a :: * -> *) s.
(Foldable a, Zip a, Additive s, Num s) =>
a s -> a s -> s
<.> a s
ys = a s -> s
forall (h :: * -> *) a. (Foldable h, Additive a) => h a -> a
sumA ((s -> s -> s) -> a s -> a s -> a s
forall a b c. (a -> b -> c) -> a a -> a b -> a c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith s -> s -> s
forall a. Num a => a -> a -> a
(*) a s
xs a s
ys)
-- (<.>)  = joinPF . fmap scale
dotV :: forall (a :: * -> *) s.
(Foldable a, Zip a, Additive s, Num s) =>
a s -> a s -> s
dotV      = a s -> a s -> s
forall (a :: * -> *) s.
(Foldable a, Zip a, Additive s, Num s) =>
a s -> a s -> s
(<.>)
{-# INLINE (<.>) #-}
{-# INLINE dotV #-}

-- | Outer product. (Do we want this order of functor composition?)
outerV, (>.<) :: (Functor a, Functor b, Num s) => a s -> b s -> a (b s)
a s
a >.< :: forall (a :: * -> *) (b :: * -> *) s.
(Functor a, Functor b, Num s) =>
a s -> b s -> a (b s)
>.< b s
b = (s -> Unop (b s)
forall (a :: * -> *) s. (Functor a, Num s) => s -> Unop (a s)
*^ b s
b) (s -> b s) -> a s -> a (b s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a s
a
outerV :: forall (a :: * -> *) (b :: * -> *) s.
(Functor a, Functor b, Num s) =>
a s -> b s -> a (b s)
outerV  = a s -> b s -> a (b s)
forall (a :: * -> *) (b :: * -> *) s.
(Functor a, Functor b, Num s) =>
a s -> b s -> a (b s)
(>.<)
{-# INLINE (>.<) #-}
{-# INLINE outerV #-}

-- (*^ b)       :: s   -> b s
-- (*^ b) <$> a :: a s -> a (b s)

-- | Apply a linear map
linear :: (Foldable a, Zip a, Functor b, Additive s, Num s)
       => (a --* b) s -> (a s -> b s)
linear :: forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Additive s, Num s) =>
(--*) a b s -> a s -> b s
linear (Comp1 b (a s)
ba) a s
a = (a s -> a s -> s
forall (a :: * -> *) s.
(Foldable a, Zip a, Additive s, Num s) =>
a s -> a s -> s
<.> a s
a) (a s -> s) -> b (a s) -> b s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b (a s)
ba
{-# INLINE linear #-}

-- linear = linearApp
-- linear = forkF . fmap joinPF . (fmap.fmap) scale
-- linear = linear' . (fmap.fmap) scale

type Bump h = h :*: Par1

bump :: Num s => a s -> Bump a s
bump :: forall s (a :: * -> *). Num s => a s -> Bump a s
bump a s
a = a s
a a s -> Par1 s -> (:*:) a Par1 s
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: s -> Par1 s
forall p. p -> Par1 p
Par1 s
1

-- Use existing `fstF`, from ConCat.Orphans, instead.
-- unBump :: Num s => Bump a s -> a s
-- unBump (a :*: Par1 _) = a

-- | Affine map representation
infixr 1 --+
type a --+ b = Bump a --* b

-- | Affine application
affine :: (Foldable a, Zip a, Functor b, Additive s, Num s)
       => (a --+ b) s -> (a s -> b s)
affine :: forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affine (--+) a b s
m = (--+) a b s -> Bump a s -> b s
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Additive s, Num s) =>
(--*) a b s -> a s -> b s
linear (--+) a b s
m (Bump a s -> b s) -> (a s -> Bump a s) -> a s -> b s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a s -> Bump a s
forall s (a :: * -> *). Num s => a s -> Bump a s
bump
{-# INLINE affine #-}

--        m        :: b (Bump a s)
-- linear m        :: Bump a s -> b s
-- linear m . bump :: a s -> b s

-- TODO: Is there an affine counterpart to linear'?

normSqr :: (Foldable n, Zip n, Additive s, Num s) => n s -> s
normSqr :: forall (n :: * -> *) s.
(Foldable n, Zip n, Additive s, Num s) =>
n s -> s
normSqr n s
u  = n s
u n s -> n s -> s
forall (a :: * -> *) s.
(Foldable a, Zip a, Additive s, Num s) =>
a s -> a s -> s
<.> n s
u
{-# INLINE normSqr #-}

-- | Distance squared
distSqr :: (Foldable n, Zip n, Additive s, Num s) => n s -> n s -> s
distSqr :: forall (a :: * -> *) s.
(Foldable a, Zip a, Additive s, Num s) =>
a s -> a s -> s
distSqr n s
u n s
v = n s -> s
forall (n :: * -> *) s.
(Foldable n, Zip n, Additive s, Num s) =>
n s -> s
normSqr (n s
u Binop (n s)
forall (a :: * -> *) s. (Zip a, Num s) => Binop (a s)
^-^ n s
v)
{-# INLINE distSqr #-}

-- The normSqr and distSqr definitions rely on Num instances on functions.

{--------------------------------------------------------------------
    Learning
--------------------------------------------------------------------}

relus :: (Functor f, Ord a, Num a) => Unop (f a)
relus :: forall (f :: * -> *) a. (Functor f, Ord a, Num a) => Unop (f a)
relus = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Ord a => a -> a -> a
max a
0)
{-# INLINE relus #-}

-- | Affine followed by RELUs.
affRelu :: (Foldable a, Zip a, Functor b, Ord s, Additive s, Num s)
        => (a --+ b) s -> (a s -> b s)
affRelu :: forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Ord s, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affRelu (--+) a b s
l = Unop (b s)
forall (f :: * -> *) a. (Functor f, Ord a, Num a) => Unop (f a)
relus Unop (b s) -> (a s -> b s) -> a s -> b s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (--+) a b s -> a s -> b s
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affine (--+) a b s
l
{-# INLINE affRelu #-}

-- affRelu = (result.result) relus affine

logistics :: (Functor f, Floating a) => Unop (f a)
logistics :: forall (f :: * -> *) a. (Functor f, Floating a) => Unop (f a)
logistics = (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a. Floating a => a -> a
exp (-a
x)))
{-# INLINE logistics #-}

-- | Affine followed by logistics.
affLog :: (Foldable a, Zip a, Functor b, Floating s, Additive s)
       => (a --+ b) s -> (a s -> b s)
affLog :: forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Floating s, Additive s) =>
(--+) a b s -> a s -> b s
affLog (--+) a b s
l = Unop (b s)
forall (f :: * -> *) a. (Functor f, Floating a) => Unop (f a)
logistics Unop (b s) -> (a s -> b s) -> a s -> b s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (--+) a b s -> a s -> b s
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affine (--+) a b s
l
{-# INLINE affLog #-}

errSqr :: (Foldable b, Zip b, Additive s, Num s)
       => a s :* b s -> (a s -> b s) -> s
errSqr :: forall (b :: * -> *) s (a :: * -> *).
(Foldable b, Zip b, Additive s, Num s) =>
(a s :* b s) -> (a s -> b s) -> s
errSqr (a s
a,b s
b) a s -> b s
h = b s -> b s -> s
forall (a :: * -> *) s.
(Foldable a, Zip a, Additive s, Num s) =>
a s -> a s -> s
distSqr b s
b (a s -> b s
h a s
a)
{-# INLINE errSqr #-}

errSqrSampled :: (Foldable b, Zip b, Additive s, Num s)
              => (p s -> a s -> b s) -> a s :* b s -> p s -> s
errSqrSampled :: forall (b :: * -> *) s (p :: * -> *) (a :: * -> *).
(Foldable b, Zip b, Additive s, Num s) =>
(p s -> a s -> b s) -> (a s :* b s) -> p s -> s
errSqrSampled p s -> a s -> b s
h a s :* b s
sample = (a s :* b s) -> (a s -> b s) -> s
forall (b :: * -> *) s (a :: * -> *).
(Foldable b, Zip b, Additive s, Num s) =>
(a s :* b s) -> (a s -> b s) -> s
errSqr a s :* b s
sample ((a s -> b s) -> s) -> (p s -> a s -> b s) -> p s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p s -> a s -> b s
h
{-# INLINE errSqrSampled #-}

errGrad :: (Foldable b, Zip b, Additive s, Num s)
        => (p s -> a s -> b s) -> a s :* b s -> Unop (p s)
errGrad :: forall (b :: * -> *) s (p :: * -> *) (a :: * -> *).
(Foldable b, Zip b, Additive s, Num s) =>
(p s -> a s -> b s) -> (a s :* b s) -> Unop (p s)
errGrad = ((((a s :* b s) -> p s -> s) -> (a s :* b s) -> Unop (p s))
-> ((p s -> a s -> b s) -> (a s :* b s) -> p s -> s)
-> (p s -> a s -> b s)
-> (a s :* b s)
-> Unop (p s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
result((((a s :* b s) -> p s -> s) -> (a s :* b s) -> Unop (p s))
 -> ((p s -> a s -> b s) -> (a s :* b s) -> p s -> s)
 -> (p s -> a s -> b s)
 -> (a s :* b s)
 -> Unop (p s))
-> (((p s -> s) -> Unop (p s))
    -> ((a s :* b s) -> p s -> s) -> (a s :* b s) -> Unop (p s))
-> ((p s -> s) -> Unop (p s))
-> ((p s -> a s -> b s) -> (a s :* b s) -> p s -> s)
-> (p s -> a s -> b s)
-> (a s :* b s)
-> Unop (p s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((p s -> s) -> Unop (p s))
-> ((a s :* b s) -> p s -> s) -> (a s :* b s) -> Unop (p s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
result) (p s -> s) -> Unop (p s)
forall s a. Num s => (a -> s) -> a -> a
gradR (p s -> a s -> b s) -> (a s :* b s) -> p s -> s
forall (b :: * -> *) s (p :: * -> *) (a :: * -> *).
(Foldable b, Zip b, Additive s, Num s) =>
(p s -> a s -> b s) -> (a s :* b s) -> p s -> s
errSqrSampled
{-# INLINE errGrad #-}

infixr 9 @.
(@.) :: (q s -> b -> c) -> (p s -> a -> b) -> ((q :*: p) s -> a -> c)
(q s -> b -> c
g @. :: forall (q :: * -> *) s b c (p :: * -> *) a.
(q s -> b -> c) -> (p s -> a -> b) -> (:*:) q p s -> a -> c
@. p s -> a -> b
f) (q s
q :*: p s
p) = q s -> b -> c
g q s
q (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p s -> a -> b
f p s
p
{-# INLINE (@.) #-}

-- Using q :*: p instead of p :*: q avoids the need for parens when combining
-- several, while giving (@.) the same fixity as (.).

{--------------------------------------------------------------------
    SGD interface
--------------------------------------------------------------------}

-- Single SGD step, from one parameter estimation to the next
step :: forall s p a b.
     (Foldable b, Zip b, Functor p, Zip p, Additive1 p, Additive s, Num s)
  => (p s -> a s -> b s) -> s -> a s :* b s -> Unop (p s)
-- step m gamma sample p = p ^+^ gamma *^ errGrad m sample p <+ additive1 @p @s
step :: forall s (p :: * -> *) (a :: * -> *) (b :: * -> *).
(Foldable b, Zip b, Functor p, Zip p, Additive1 p, Additive s,
 Num s) =>
(p s -> a s -> b s) -> s -> (a s :* b s) -> Unop (p s)
step = \ p s -> a s -> b s
m s
gamma a s :* b s
sample p s
p -> p s
p Binop (p s)
forall (a :: * -> *) s. (Zip a, Num s) => Binop (a s)
^-^ s
gamma s -> p s -> p s
forall (a :: * -> *) s. (Functor a, Num s) => s -> Unop (a s)
*^ (p s -> a s -> b s) -> (a s :* b s) -> p s -> p s
forall (b :: * -> *) s (p :: * -> *) (a :: * -> *).
(Foldable b, Zip b, Additive s, Num s) =>
(p s -> a s -> b s) -> (a s :* b s) -> Unop (p s)
errGrad p s -> a s -> b s
m a s :* b s
sample p s
p (Con (Sat Additive (p s)) => p s)
-> (Sat Additive s |- Sat Additive (p s)) -> p s
forall a b r. Con a => (Con b => r) -> (a |- b) -> r
<+ forall (h :: * -> *) a.
Additive1 h =>
Sat Additive a |- Sat Additive (h a)
additive1 @p @s
{-# INLINE step #-}

-- Multiple SGD steps, from one parameter estimation to another
steps :: ( Foldable b, Zip b, Zip p
         , Additive1 p, Functor f, Foldable f, Additive s, Num s)
      => (p s -> a s -> b s) -> s -> f (a s :* b s) -> Unop (p s)
-- steps m gamma samples = compose (step m gamma <$> samples)
steps :: forall (b :: * -> *) (p :: * -> *) (f :: * -> *) s (a :: * -> *).
(Foldable b, Zip b, Zip p, Additive1 p, Functor f, Foldable f,
 Additive s, Num s) =>
(p s -> a s -> b s) -> s -> f (a s :* b s) -> Unop (p s)
steps = \ p s -> a s -> b s
m s
gamma f (a s :* b s)
samples -> f (Unop (p s)) -> Unop (p s)
forall (f :: * -> *) a. Foldable f => f (Unop a) -> Unop a
compose ((p s -> a s -> b s) -> s -> (a s :* b s) -> Unop (p s)
forall s (p :: * -> *) (a :: * -> *) (b :: * -> *).
(Foldable b, Zip b, Functor p, Zip p, Additive1 p, Additive s,
 Num s) =>
(p s -> a s -> b s) -> s -> (a s :* b s) -> Unop (p s)
step p s -> a s -> b s
m s
gamma ((a s :* b s) -> Unop (p s)) -> f (a s :* b s) -> f (Unop (p s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a s :* b s)
samples)
{-# INLINE steps #-}

-- Moving parameters to RHS lambdas allows even unsaturated applications of step
-- and steps to inline. See 2018-02-28 journal notes. An alternative solution
-- that seems to work is to leave the `step` and `steps` definitions as before
-- but replace the call to `step` in `steps` by `inline step`, where `inline`
-- comes from `GHC.Exts`.

--          step m gamma              :: a s :* b s -> Unop (p s)
--          step m gamma <$> samples  :: f (Unop (p s))
-- compose (step m gamma <$> samples) :: Unop (p s)

-- | Train a network on several epochs of the training data, keeping
-- track of its parameters after each.
trainNTimes :: ( Foldable b, Zip b, Zip p
               , Additive1 p, Functor f, Foldable f, Additive s, Num s)
            => Int                  -- ^ number of epochs
            -> s                    -- ^ learning rate
            -> (p s -> a s -> b s)  -- ^ The "network" just converts a set of parameters
                                    -- into a function from input to output functors.
            -> p s                  -- ^ initial guess for learnable parameters
            -> f (a s :* b s)       -- ^ the training pairs
            -> [p s]                -- ^ initial parameters + those after each training epoch
-- trainNTimes n rate net ps prs = take (n+1) $ iterate (steps net rate prs) ps
trainNTimes :: forall (b :: * -> *) (p :: * -> *) (f :: * -> *) s (a :: * -> *).
(Foldable b, Zip b, Zip p, Additive1 p, Functor f, Foldable f,
 Additive s, Num s) =>
Int -> s -> (p s -> a s -> b s) -> p s -> f (a s :* b s) -> [p s]
trainNTimes = \ Int
n s
rate p s -> a s -> b s
net p s
ps f (a s :* b s)
prs -> Int -> [p s] -> [p s]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([p s] -> [p s]) -> [p s] -> [p s]
forall a b. (a -> b) -> a -> b
$ (p s -> p s) -> p s -> [p s]
forall a. (a -> a) -> a -> [a]
iterate ((p s -> a s -> b s) -> s -> f (a s :* b s) -> p s -> p s
forall (b :: * -> *) (p :: * -> *) (f :: * -> *) s (a :: * -> *).
(Foldable b, Zip b, Zip p, Additive1 p, Functor f, Foldable f,
 Additive s, Num s) =>
(p s -> a s -> b s) -> s -> f (a s :* b s) -> Unop (p s)
steps p s -> a s -> b s
net s
rate f (a s :* b s)
prs) p s
ps
{-# INLINE trainNTimes #-}

{--------------------------------------------------------------------
    Temp
--------------------------------------------------------------------}

err1 :: (R -> R) -> R :* R -> R
err1 :: (R -> R) -> (R :* R) -> R
err1 R -> R
h (R
a,R
b) = R -> R
forall a. Num a => a -> a
sqr (R
b R -> R -> R
forall a. Num a => a -> a -> a
- R -> R
h R
a)
{-# INLINE err1 #-}

err1Grad :: (p -> R -> R) -> R :* R -> Unop p
err1Grad :: forall p. (p -> R -> R) -> (R :* R) -> Unop p
err1Grad p -> R -> R
h R :* R
sample = (p -> R) -> p -> p
forall s a. Num s => (a -> s) -> a -> a
gradR (\ p
a -> (R -> R) -> (R :* R) -> R
err1 (p -> R -> R
h p
a) R :* R
sample)
{-# INLINE err1Grad #-}

{--------------------------------------------------------------------
    Examples
--------------------------------------------------------------------}

infixr 1 -->
type (a --> b) s = a s -> b s

lr1 :: (C2 Foldable a b, Zip a, Functor b)
    => (a --+ b) R  ->  (a --> b) R
lr1 :: forall (a :: * -> *) (b :: * -> *).
(C2 Foldable a b, Zip a, Functor b) =>
(--+) a b R -> (-->) a b R
lr1 = (--+) a b R -> a R -> b R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Ord s, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affRelu
{-# INLINE lr1 #-}

lr2 :: (C2 Foldable a b, C2 Zip a b, C2 Functor b c)
    => ((b --+ c) :*: (a --+ b)) R  ->  (a --> c) R
lr2 :: forall (a :: * -> *) (b :: * -> *) (c :: * -> *).
(C2 Foldable a b, C2 Zip a b, C2 Functor b c) =>
(:*:) (b --+ c) (a --+ b) R -> (-->) a c R
lr2 = (--+) b c R -> b R -> c R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Ord s, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affRelu ((--+) b c R -> b R -> c R)
-> ((--+) a b R -> a R -> b R)
-> (:*:) (b --+ c) (a --+ b) R
-> a R
-> c R
forall (q :: * -> *) s b c (p :: * -> *) a.
(q s -> b -> c) -> (p s -> a -> b) -> (:*:) q p s -> a -> c
@. (--+) a b R -> a R -> b R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Ord s, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affRelu
{-# INLINE lr2 #-}

lr3 :: (C3 Foldable a b c, C3 Zip a b c, C3 Functor b c d)
    => ((c --+ d) :*: (b --+ c) :*: (a --+ b)) R  ->  (a --> d) R
lr3 :: forall (a :: * -> *) (b :: * -> *) (c :: * -> *) (d :: * -> *).
(C3 Foldable a b c, C3 Zip a b c, C3 Functor b c d) =>
(:*:) (c --+ d) ((b --+ c) :*: (a --+ b)) R -> (-->) a d R
lr3 = (--+) c d R -> c R -> d R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Ord s, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affRelu ((--+) c d R -> c R -> d R)
-> ((:*:) (b --+ c) (a --+ b) R -> a R -> c R)
-> (:*:) (c --+ d) ((b --+ c) :*: (a --+ b)) R
-> a R
-> d R
forall (q :: * -> *) s b c (p :: * -> *) a.
(q s -> b -> c) -> (p s -> a -> b) -> (:*:) q p s -> a -> c
@. (--+) b c R -> b R -> c R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Ord s, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affRelu ((--+) b c R -> b R -> c R)
-> ((--+) a b R -> a R -> b R)
-> (:*:) (b --+ c) (a --+ b) R
-> a R
-> c R
forall (q :: * -> *) s b c (p :: * -> *) a.
(q s -> b -> c) -> (p s -> a -> b) -> (:*:) q p s -> a -> c
@. (--+) a b R -> a R -> b R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Ord s, Additive s, Num s) =>
(--+) a b s -> a s -> b s
affRelu
{-# INLINE lr3 #-}

lr3' :: (C3 Foldable a b c, C3 Zip a b c, C3 Functor b c d)
     => ((c --+ d) :*: (b --+ c) :*: (a --+ b)) R  ->  (a --> d) R
lr3' :: forall (a :: * -> *) (b :: * -> *) (c :: * -> *) (d :: * -> *).
(C3 Foldable a b c, C3 Zip a b c, C3 Functor b c d) =>
(:*:) (c --+ d) ((b --+ c) :*: (a --+ b)) R -> (-->) a d R
lr3' = (--+) c d R -> c R -> d R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Floating s, Additive s) =>
(--+) a b s -> a s -> b s
affLog ((--+) c d R -> c R -> d R)
-> ((:*:) (b --+ c) (a --+ b) R -> a R -> c R)
-> (:*:) (c --+ d) ((b --+ c) :*: (a --+ b)) R
-> a R
-> d R
forall (q :: * -> *) s b c (p :: * -> *) a.
(q s -> b -> c) -> (p s -> a -> b) -> (:*:) q p s -> a -> c
@. (--+) b c R -> b R -> c R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Floating s, Additive s) =>
(--+) a b s -> a s -> b s
affLog ((--+) b c R -> b R -> c R)
-> ((--+) a b R -> a R -> b R)
-> (:*:) (b --+ c) (a --+ b) R
-> a R
-> c R
forall (q :: * -> *) s b c (p :: * -> *) a.
(q s -> b -> c) -> (p s -> a -> b) -> (:*:) q p s -> a -> c
@. (--+) a b R -> a R -> b R
forall (a :: * -> *) (b :: * -> *) s.
(Foldable a, Zip a, Functor b, Floating s, Additive s) =>
(--+) a b s -> a s -> b s
affLog
{-# INLINE lr3' #-}