{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Numeric.Backprop.Op
-- Copyright   : (c) Justin Le 2023
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Provides the 'Op' type and combinators, which represent differentiable
-- functions/operations on values, and are used internally by the library
-- to perform back-propagation.
--
-- Users of the library can ignore this module for the most part. Library
-- authors defining backpropagatable primitives for their functions are
-- recommend to simply use 'op0', 'op1', 'op2', 'op3', which are
-- re-exported in "Numeric.Backprop".  However, authors who want more
-- options in defining their primtive functions might find some of these
-- functions useful.
--
-- Note that if your entire function is a single non-branching composition
-- of functions, 'Op' and its utility functions alone are sufficient to
-- differentiate/backprop.  However, this happens rarely in practice.
--
-- To use these 'Op's with the backprop library, they can be made to work
-- with 'BVar's using 'liftOp', 'liftOp1', 'liftOp2', and 'liftOp3'.
--
-- If you are writing a library, see
-- <https://backprop.jle.im/06-equipping-your-library.html> for a guide for
-- equipping your library with backpropatable operations using 'Op's.
--
-- See also <https://backprop.jle.im/06-manual-gradients.html this guide>
-- for writing Ops manually on your own numerical functions.
module Numeric.Backprop.Op (
  -- * Implementation
  -- $opdoc
  Op (..),

  -- ** Tuple Types#prod#
  -- $prod
  Rec (..),

  -- * Running

  -- ** Pure
  runOp,
  evalOp,
  gradOp,
  gradOpWith,

  -- * Creation
  op0,
  opConst,
  idOp,
  opLens,

  -- ** Giving gradients directly
  op1,
  op2,
  op3,

  -- ** From Isomorphisms
  opCoerce,
  opTup,
  opIso,
  opIso2,
  opIso3,
  opIsoN,

  -- ** No gradient
  noGrad1,
  noGrad,

  -- * Manipulation
  composeOp,
  composeOp1,
  (~.),

  -- * Utility

  -- ** Numeric Ops#numops#
  -- $numops
  (+.),
  (-.),
  (*.),
  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 (foldl')
import Data.Type.Util
import Data.Vinyl.Core
import qualified Data.Vinyl.Recursive as VR
import Lens.Micro
import Lens.Micro.Extras

-- $opdoc
-- 'Op's contain information on a function as well as its gradient, but
-- provides that information in a way that allows them to be "chained".
--
-- For example, for a function
--
-- \[
-- f : \mathbb{R}^n \rightarrow \mathbb{R}
-- \]
--
-- We might want to apply a function \(g\) to the result we get, to get
-- our "final" result:
--
-- \[
-- \eqalign{
-- y &= f(\mathbf{x})\cr
-- z &= g(y)
-- }
-- \]
--
-- Now, we might want the gradient \(\nabla z\) with respect to
-- \(\mathbf{x}\), or \(\nabla_\mathbf{x} z\).  Explicitly, this is:
--
-- \[
-- \nabla_\mathbf{x} z = \left< \frac{\partial z}{\partial x_1}, \frac{\partial z}{\partial x_2}, \ldots \right>
-- \]
--
-- We can compute that by multiplying the total derivative of \(z\) with
-- respect to \(y\) (that is, \(\frac{dz}{dy}\)) with the gradient of
-- \(f\)) itself:
--
-- \[
-- \eqalign{
-- \nabla_\mathbf{x} z &= \frac{dz}{dy} \left< \frac{\partial y}{\partial x_1}, \frac{\partial y}{\partial x_2}, \ldots \right>\cr
-- \nabla_\mathbf{x} z &= \frac{dz}{dy} \nabla_\mathbf{x} y
-- }
-- \]
--
-- So, to create an @'Op' as a@ with the 'Op' constructor, you give
-- a function that returns a tuple, containing:
--
--     1. An @a@: The result of the function
--     2. An @a -> Rec Identity as@:  A function that, when given
--     \(\frac{dz}{dy}\), returns the total gradient
--     \(\nabla_z \mathbf{x}\).
--
-- This is done so that 'Op's can easily be "chained" together, one after
-- the other.  If you have an 'Op' for \(f\) and an 'Op' for \(g\), you can
-- compute the gradient of \(f\) knowing that the result target is
-- \(g \circ f\).
--
-- See <https://backprop.jle.im/06-manual-gradients.html this guide> for
-- a detailed look on writing ops manually on your own numerical functions.
--
-- Note that end users should probably never be required to construct an
-- 'Op' explicitly this way.  Instead, libraries should provide
-- carefuly pre-constructed ones, or provide ways to generate them
-- automatically (like 'op1', 'op2', and 'op3' here).
--
-- For examples of 'Op's implemented from scratch, see the implementations
-- of '+.', '-.', 'recipOp', 'sinOp', etc.
--
-- See "Numeric.Backprop.Op#prod" for a mini-tutorial on using 'Rec' and
-- 'Rec Identity'.

-- | An @'Op' as a@ describes a differentiable function from @as@ to @a@.
--
-- For example, a value of type
--
-- @
-- 'Op' '[Int, Bool] Double
-- @
--
-- is a function from an 'Int' and a 'Bool', returning a 'Double'.  It can
-- be differentiated to give a /gradient/ of an 'Int' and a 'Bool' if given
-- a total derivative for the @Double@.  If we call 'Bool' \(2\), then,
-- mathematically, it is akin to a:
--
-- \[
-- f : \mathbb{Z} \times 2 \rightarrow \mathbb{R}
-- \]
--
-- See 'runOp', 'gradOp', and 'gradOpWith' for examples on how to run it,
-- and 'Op' for instructions on creating it.
--
-- It is simpler to not use this type constructor directly, and instead use
-- the 'op2', 'op1', 'op2', and 'op3' helper smart constructors.
--
-- See "Numeric.Backprop.Op#prod" for a mini-tutorial on using 'Rec' and
-- 'Rec Identity'.
--
-- To /use/ an 'Op' with the backprop library, see 'liftOp', 'liftOp1',
-- 'liftOp2', and 'liftOp3'.
newtype Op as a
  = -- | Construct an 'Op' by giving a function creating the
    -- result, and also a continuation on how to create the gradient, given
    -- the total derivative of @a@.
    --
    -- See the module documentation for "Numeric.Backprop.Op" for more
    -- details on the function that this constructor and 'Op' expect.
    Op
    { forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith :: Rec Identity as -> (a, a -> Rec Identity as)
    -- ^ Run the function that the 'Op' encodes, returning
    -- a continuation to compute the gradient, given the total
    -- derivative of @a@.  See documentation for "Numeric.Backprop.Op"
    -- for more information.
    }

-- | Helper wrapper used for the implementation of 'composeOp'.
newtype OpCont as a = OC {forall (as :: [*]) a. OpCont as a -> a -> Rec Identity as
runOpCont :: a -> Rec Identity as}

-- | Compose 'Op's together, like 'sequence' for functions, or @liftAN@.
--
-- That is, given an @'Op' as b1@, an @'Op' as b2@, and an @'Op' as b3@, it
-- can compose them with an @'Op' '[b1,b2,b3] c@ to create an @'Op' as
-- c@.
composeOp ::
  forall as bs c.
  RPureConstrained Num as =>
  -- | 'Rec' of 'Op's taking @as@ and returning
  --     different @b@ in @bs@
  Rec (Op as) bs ->
  -- | 'OpM' taking eac of the @bs@ from the
  --     input 'Rec'.
  Op bs c ->
  -- | Composed 'Op'
  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 = (Rec Identity as -> (c, c -> Rec Identity as)) -> Op as c
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op ((Rec Identity as -> (c, c -> Rec Identity as)) -> Op as c)
-> (Rec Identity as -> (c, c -> Rec Identity as)) -> Op as c
forall a b. (a -> b) -> a -> b
$ \Rec Identity as
xs ->
  let (Rec Identity bs
ys, Rec (OpCont as) bs
conts) = (forall x. Op as x -> (Identity x, OpCont as x))
-> forall (xs :: [*]).
   Rec (Op as) xs -> (Rec Identity xs, Rec (OpCont as) xs)
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 ((x -> Identity x)
-> ((x -> Rec Identity as) -> OpCont as x)
-> (x, x -> Rec Identity as)
-> (Identity x, OpCont as x)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap x -> Identity x
forall a. a -> Identity a
Identity (x -> Rec Identity as) -> OpCont as x
forall (as :: [*]) a. (a -> Rec Identity as) -> OpCont as a
OC ((x, x -> Rec Identity as) -> (Identity x, OpCont as x))
-> (Op as x -> (x, x -> Rec Identity as))
-> Op as x
-> (Identity x, OpCont as x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Op as x -> Rec Identity as -> (x, x -> Rec Identity as))
-> Rec Identity as -> Op as x -> (x, x -> Rec Identity as)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Op as x -> Rec Identity as -> (x, x -> Rec Identity as)
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) = Op bs c -> Rec Identity bs -> (c, c -> Rec Identity bs)
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 x. OpCont as x -> Identity x -> Const (Rec Identity as) x)
-> forall (xs :: [*]).
   Rec (OpCont as) xs
   -> Rec Identity xs -> Rec (Const (Rec Identity as)) xs
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) -> Rec Identity as -> Const (Rec Identity as) x
forall {k} a (b :: k). a -> Const a b
Const (Rec Identity as -> Const (Rec Identity as) x)
-> Rec Identity as -> Const (Rec Identity as) x
forall a b. (a -> b) -> a -> b
$ OpCont as x -> x -> Rec Identity as
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 x. Dict Num x -> Identity x)
-> Rec (Dict Num) as -> Rec Identity as
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) -> x -> Identity x
forall a. a -> Identity a
Identity x
x)
              (Rec (Dict Num) as -> Rec Identity as)
-> (Rec (Const (Rec Identity as)) bs -> Rec (Dict Num) as)
-> Rec (Const (Rec Identity as)) bs
-> Rec Identity as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rec (Dict Num) as -> Rec Identity as -> Rec (Dict Num) as)
-> Rec (Dict Num) as -> [Rec Identity as] -> Rec (Dict Num) as
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                ( (forall x. Dict Num x -> Identity x -> Dict Num x)
-> forall (xs :: [*]).
   Rec (Dict Num) xs -> Rec Identity xs -> Rec (Dict Num) xs
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 x -> x -> x
forall a. Num a => a -> a -> a
+ x
y in x
q x -> Dict Num x -> Dict Num x
forall a b. a -> b -> b
`seq` x -> Dict Num x
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
forall (c :: * -> Constraint) (ts :: [*]) (f :: * -> *).
RPureConstrained c ts =>
(forall a. c a => f a) -> Rec f ts
rpureConstrained @Num (forall (c :: * -> Constraint) a. c a => a -> Dict c a
Dict @Num a
0))
              ([Rec Identity as] -> Rec (Dict Num) as)
-> (Rec (Const (Rec Identity as)) bs -> [Rec Identity as])
-> Rec (Const (Rec Identity as)) bs
-> Rec (Dict Num) as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Const (Rec Identity as) x -> [Rec Identity as])
-> Rec (Const (Rec Identity as)) bs -> [Rec Identity as]
forall {u} (f :: u -> *) m (rs :: [u]).
Monoid m =>
(forall (x :: u). f x -> m) -> Rec f rs -> m
VR.rfoldMap ((Rec Identity as -> [Rec Identity as] -> [Rec Identity as]
forall a. a -> [a] -> [a]
: []) (Rec Identity as -> [Rec Identity as])
-> (Const (Rec Identity as) x -> Rec Identity as)
-> Const (Rec Identity as) x
-> [Rec Identity as]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (Rec Identity as) x -> Rec Identity as
forall {k} a (b :: k). Const a b -> a
getConst)
              (Rec (Const (Rec Identity as)) bs -> Rec Identity as)
-> Rec (Const (Rec Identity as)) bs -> Rec Identity as
forall a b. (a -> b) -> a -> b
$ Rec (Const (Rec Identity as)) bs
g2s
   in (c
z, c -> Rec Identity as
gFunc)

-- | Convenient wrapper over 'composeOp' for the case where the second
-- function only takes one input, so the two 'Op's can be directly piped
-- together, like for '.'.
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 = Rec (Op as) '[b] -> Op '[b] c -> Op as c
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Rec (Op as) '[b] -> Op '[b] c -> Op as c)
-> (Op as b -> Rec (Op as) '[b]) -> Op as b -> Op '[b] c -> Op as c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Op as b -> Rec (Op as) '[] -> Rec (Op as) '[b]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil)

-- | Convenient infix synonym for (flipped) 'composeOp1'.  Meant to be used
-- just like '.':
--
-- @
-- f :: 'Op' '[b]   c
-- g :: 'Op' '[a,a] b
--
-- f '~.' g :: Op '[a, a] c
-- @
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
(~.) = (Op as b -> Op '[b] c -> Op as c)
-> Op '[b] c -> Op as b -> Op as c
forall a b c. (a -> b -> c) -> b -> a -> c
flip Op as b -> Op '[b] c -> Op as c
forall (as :: [*]) b c.
RPureConstrained Num as =>
Op as b -> Op '[b] c -> Op as c
composeOp1
{-# INLINE (~.) #-}

-- | Run the function that an 'Op' encodes, to get the result.
--
-- >>> runOp (op2 (*)) (3 :& 5 :& RNil)
-- 15
evalOp :: Op as a -> Rec Identity as -> a
evalOp :: forall (as :: [*]) a. Op as a -> Rec Identity as -> a
evalOp Op as a
o = (a, a -> Rec Identity as) -> a
forall a b. (a, b) -> a
fst ((a, a -> Rec Identity as) -> a)
-> (Rec Identity as -> (a, a -> Rec Identity as))
-> Rec Identity as
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith Op as a
o
{-# INLINE evalOp #-}

-- | Run the function that an 'Op' encodes, to get the resulting output and
-- also its gradient with respect to the inputs.
--
-- >>> gradOp' (op2 (*)) (3 :& 5 :& RNil)
-- (15, 5 :& 3 :& RNil)
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 = ((a -> Rec Identity as) -> Rec Identity as)
-> (a, a -> Rec Identity as) -> (a, Rec Identity as)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((a -> Rec Identity as) -> a -> Rec Identity as
forall a b. (a -> b) -> a -> b
$ a
1) ((a, a -> Rec Identity as) -> (a, Rec Identity as))
-> (Rec Identity as -> (a, a -> Rec Identity as))
-> Rec Identity as
-> (a, Rec Identity as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith Op as a
o
{-# INLINE runOp #-}

-- | Get the gradient function that an 'Op' encodes, with a third argument
-- expecting the total derivative of the result.
--
-- See the module documentaiton for "Numeric.Backprop.Op" for more
-- information.
gradOpWith ::
  -- | 'Op' to run
  Op as a ->
  -- | Inputs to run it with
  Rec Identity as ->
  -- | The total derivative of the result.
  a ->
  -- | The gradient
  Rec Identity as
gradOpWith :: forall (as :: [*]) a.
Op as a -> Rec Identity as -> a -> Rec Identity as
gradOpWith Op as a
o = (a, a -> Rec Identity as) -> a -> Rec Identity as
forall a b. (a, b) -> b
snd ((a, a -> Rec Identity as) -> a -> Rec Identity as)
-> (Rec Identity as -> (a, a -> Rec Identity as))
-> Rec Identity as
-> a
-> Rec Identity as
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
forall (as :: [*]) a.
Op as a -> Rec Identity as -> (a, a -> Rec Identity as)
runOpWith Op as a
o
{-# INLINE gradOpWith #-}

-- | Run the function that an 'Op' encodes, and get the gradient of the
-- output with respect to the inputs.
--
-- >>> gradOp (op2 (*)) (3 :& 5 :& RNil)
-- 5 :& 3 :& RNil
-- -- the gradient of x*y is (y, x)
--
-- @
-- 'gradOp' o xs = 'gradOpWith' o xs 1
-- @
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 = Op as a -> Rec Identity as -> a -> Rec Identity as
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 #-}

-- | An 'Op' that coerces an item into another item whose type has the same
-- runtime representation.
--
-- >>> gradOp' opCoerce (Identity 5) :: (Int, Identity Int)
-- (5, Identity 1)
--
-- @
-- 'opCoerce' = 'opIso' 'coerced' 'coerce'
-- @
opCoerce :: Coercible a b => Op '[a] b
opCoerce :: forall a b. Coercible a b => Op '[a] b
opCoerce = (a -> b) -> (b -> a) -> Op '[a] b
forall a b. (a -> b) -> (b -> a) -> Op '[a] b
opIso a -> b
forall a b. Coercible a b => a -> b
coerce b -> a
forall a b. Coercible a b => a -> b
coerce
{-# INLINE opCoerce #-}

-- | Create an 'Op' with no gradient.  Can be evaluated with 'evalOp',  but
-- will throw a runtime exception when asked for the gradient.
--
-- Can be used with 'BVar' with 'liftOp1', and 'evalBP' will work fine.
-- 'gradBP'  and 'backprop' will also work fine if the result is never used
-- in the final answer, but will throw a runtime exception if the final
-- answer depends on the result of this operation.
--
-- Useful if your only API is exposed through /backprop/.  Just be sure to
-- tell your users that this will explode when finding the gradient if the
-- result is used in the final result.
--
-- @since 0.1.3.0
noGrad1 :: (a -> b) -> Op '[a] b
noGrad1 :: forall a b. (a -> b) -> Op '[a] b
noGrad1 a -> b
f = (a -> (b, b -> a)) -> Op '[a] b
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (b, b -> a)) -> Op '[a] b)
-> (a -> (b, b -> a)) -> Op '[a] b
forall a b. (a -> b) -> a -> b
$ \a
x ->
  ( a -> b
f a
x
  , \b
_ -> [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Numeric.Backprop.Op.noGrad1: no gradient defined"
  )
{-# INLINE noGrad1 #-}

-- | Create an 'Op' with no gradient.  Can be evaluated with 'evalOp',  but
-- will throw a runtime exception when asked for the gradient.
--
-- Can be used with 'BVar' with 'liftOp', and 'evalBP' will work fine.
-- 'gradBP'  and 'backprop' will also work fine if the result is never used
-- in the final answer, but will throw a runtime exception if the final
-- answer depends on the result of this operation.
--
-- Useful if your only API is exposed through /backprop/.  Just be sure to
-- tell your users that this will explode when finding the gradient if the
-- result is used in the final result.
--
-- @since 0.1.3.0
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 = (Rec Identity as -> (b, b -> Rec Identity as)) -> Op as b
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op ((Rec Identity as -> (b, b -> Rec Identity as)) -> Op as b)
-> (Rec Identity as -> (b, b -> Rec Identity as)) -> Op as b
forall a b. (a -> b) -> a -> b
$ \Rec Identity as
xs ->
  ( Rec Identity as -> b
f Rec Identity as
xs
  , \b
_ -> [Char] -> Rec Identity as
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Numeric.Backprop.Op.noGrad: no gradient defined"
  )
{-# INLINE noGrad #-}

-- | An 'Op' that just returns whatever it receives.  The identity
-- function.
--
-- @
-- 'idOp' = 'opIso' 'id' 'id'
-- @
idOp :: Op '[a] a
idOp :: forall a. Op '[a] a
idOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 (,a -> a
forall a. a -> a
id)
{-# INLINE idOp #-}

-- | An 'Op' that takes @as@ and returns exactly the input tuple.
--
-- >>> gradOp' opTup (1 :& 2 :& 3 :& RNil)
-- (1 :& 2 :& 3 :& RNil, 1 :& 1 :& 1 :& RNil)
opTup :: Op as (Rec Identity as)
opTup :: forall (as :: [*]). Op as (Rec Identity as)
opTup = (Rec Identity as
 -> (Rec Identity as, Rec Identity as -> Rec Identity as))
-> Op as (Rec Identity as)
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op (,Rec Identity as -> Rec Identity as
forall a. a -> a
id)
{-# INLINE opTup #-}

-- | An 'Op' that runs the input value through an isomorphism.
--
-- Warning: This is unsafe!  It assumes that the isomorphisms themselves
-- have derivative 1, so will break for things like 'exp' & 'log'.
-- Basically, don't use this for any "numeric" isomorphisms.
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' = (a -> (b, b -> a)) -> Op '[a] b
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (b, b -> a)) -> Op '[a] b)
-> (a -> (b, b -> a)) -> Op '[a] b
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> b
to' a
x, b -> a
from')
{-# INLINE opIso #-}

-- | An 'Op' that runs the two input values through an isomorphism.  Useful
-- for things like constructors.  See 'opIso' for caveats.
--
-- @since 0.1.4.0
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' = (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 ((a -> b -> (c, c -> (a, b))) -> Op '[a, b] c)
-> (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
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 #-}

-- | An 'Op' that runs the three input values through an isomorphism.
-- Useful for things like constructors.  See 'opIso' for caveats.
--
-- @since 0.1.4.0
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' = (a -> b -> c -> (d, d -> (a, b, c))) -> Op '[a, b, c] d
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))) -> Op '[a, b, c] d)
-> (a -> b -> c -> (d, d -> (a, b, c))) -> Op '[a, b, c] d
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 #-}

-- | An 'Op' that runs the input value through an isomorphism between
-- a tuple of values and a value.  See 'opIso' for caveats.
--
-- In "Numeric.Backprop.Op" since version 0.1.2.0, but only exported from
-- "Numeric.Backprop" since version 0.1.3.0.
--
-- @since 0.1.2.0
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' = (Rec Identity as -> (b, b -> Rec Identity as)) -> Op as b
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op ((Rec Identity as -> (b, b -> Rec Identity as)) -> Op as b)
-> (Rec Identity as -> (b, b -> Rec Identity as)) -> Op as b
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 #-}

-- | An 'Op' that extracts a value from an input value using a 'Lens''.
--
-- Warning: This is unsafe!  It assumes that it extracts a specific value
-- unchanged, with derivative 1, so will break for things that numerically
-- manipulate things before returning them.
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 = (a -> (b, b -> a)) -> Op '[a] b
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (b, b -> a)) -> Op '[a] b)
-> (a -> (b, b -> a)) -> Op '[a] b
forall a b. (a -> b) -> a -> b
$ \a
x -> (Getting b a b -> a -> b
forall a s. Getting a s a -> s -> a
view Getting b a b
Lens' a b
l a
x, \b
d -> ASetter a a b b -> b -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter a a b b
Lens' a b
l b
d a
0)
{-# INLINE opLens #-}

-- | An 'Op' that ignores all of its inputs and returns a given constant
-- value.
--
-- >>> gradOp' (opConst 10) (1 :& 2 :& 3 :& RNil)
-- (10, 0 :& 0 :& 0 :& RNil)
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 =
  (Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op ((Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a)
-> (Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
forall a b. (a -> b) -> a -> b
$
    (a, a -> Rec Identity as)
-> Rec Identity as -> (a, a -> Rec Identity as)
forall a b. a -> b -> a
const
      (a
x, Rec Identity as -> a -> Rec Identity as
forall a b. a -> b -> a
const (Rec Identity as -> a -> Rec Identity as)
-> Rec Identity as -> a -> Rec Identity as
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
forall (c :: * -> Constraint) (ts :: [*]) (f :: * -> *).
RPureConstrained c ts =>
(forall a. c a => f a) -> Rec f ts
rpureConstrained @Num Identity a
forall a. Num a => Identity a
0)
{-# INLINE opConst #-}

-- | Create an 'Op' that takes no inputs and always returns the given
-- value.
--
-- There is no gradient, of course (using 'gradOp' will give you an empty
-- tuple), because there is no input to have a gradient of.
--
-- >>> runOp (op0 10) RNil
-- (10, RNil)
--
-- For a constant 'Op' that takes input and ignores it, see 'opConst' and
-- 'opConst''.
op0 :: a -> Op '[] a
op0 :: forall a. a -> Op '[] a
op0 a
x = (Rec Identity '[] -> (a, a -> Rec Identity '[])) -> Op '[] a
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op ((Rec Identity '[] -> (a, a -> Rec Identity '[])) -> Op '[] a)
-> (Rec Identity '[] -> (a, a -> Rec Identity '[])) -> Op '[] a
forall a b. (a -> b) -> a -> b
$ \case
  Rec Identity '[]
RNil -> (a
x, Rec Identity '[] -> a -> Rec Identity '[]
forall a b. a -> b -> a
const Rec Identity '[]
forall {u} (a :: u -> *). Rec a '[]
RNil)
{-# INLINE op0 #-}

-- | Create an 'Op' of a function taking one input, by giving its explicit
-- derivative.  The function should return a tuple containing the result of
-- the function, and also a function taking the derivative of the result
-- and return the derivative of the input.
--
-- If we have
--
-- \[
-- \eqalign{
-- f &: \mathbb{R} \rightarrow \mathbb{R}\cr
-- y &= f(x)\cr
-- z &= g(y)
-- }
-- \]
--
-- Then the derivative \( \frac{dz}{dx} \), it would be:
--
-- \[
-- \frac{dz}{dx} = \frac{dz}{dy} \frac{dy}{dx}
-- \]
--
-- If our 'Op' represents \(f\), then the second item in the resulting
-- tuple should be a function that takes \(\frac{dz}{dy}\) and returns
-- \(\frac{dz}{dx}\).
--
-- As an example, here is an 'Op' that squares its input:
--
-- @
-- square :: Num a => 'Op' '[a] a
-- square = 'op1' $ \\x -> (x*x, \\d -> 2 * d * x
--                      )
-- @
--
-- Remember that, generally, end users shouldn't directly construct 'Op's;
-- they should be provided by libraries or generated automatically.
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 = (Rec Identity '[a] -> (b, b -> Rec Identity '[a])) -> Op '[a] b
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op ((Rec Identity '[a] -> (b, b -> Rec Identity '[a])) -> Op '[a] b)
-> (Rec Identity '[a] -> (b, b -> Rec Identity '[a])) -> Op '[a] b
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 a
r
x
     in (b
y, \(!b
d) -> (Identity a -> Rec Identity '[] -> Rec Identity '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec Identity '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) (Identity a -> Rec Identity '[a])
-> (b -> Identity a) -> b -> Rec Identity '[a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (b -> a) -> b -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
dx (b -> Rec Identity '[a]) -> b -> Rec Identity '[a]
forall a b. (a -> b) -> a -> b
$ b
d)
{-# INLINE op1 #-}

-- | Create an 'Op' of a function taking two inputs, by giving its explicit
-- gradient.  The function should return a tuple containing the result of
-- the function, and also a function taking the derivative of the result
-- and return the derivative of the input.
--
-- If we have
--
-- \[
-- \eqalign{
-- f &: \mathbb{R}^2 \rightarrow \mathbb{R}\cr
-- z &= f(x, y)\cr
-- k &= g(z)
-- }
-- \]
--
-- Then the gradient \( \left< \frac{\partial k}{\partial x}, \frac{\partial k}{\partial y} \right> \)
-- would be:
--
-- \[
-- \left< \frac{\partial k}{\partial x}, \frac{\partial k}{\partial y} \right> =
--  \left< \frac{dk}{dz} \frac{\partial z}{dx}, \frac{dk}{dz} \frac{\partial z}{dy} \right>
-- \]
--
-- If our 'Op' represents \(f\), then the second item in the resulting
-- tuple should be a function that takes \(\frac{dk}{dz}\) and returns
-- \( \left< \frac{\partial k}{dx}, \frac{\partial k}{dx} \right> \).
--
-- As an example, here is an 'Op' that multiplies its inputs:
--
-- @
-- mul :: Num a => 'Op' '[a, a] a
-- mul = 'op2'' $ \\x y -> (x*y, \\d -> (d*y, x*d)
--                      )
-- @
--
-- Remember that, generally, end users shouldn't directly construct 'Op's;
-- they should be provided by libraries or generated automatically.
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 = (Rec Identity '[a, b] -> (c, c -> Rec Identity '[a, b]))
-> Op '[a, b] c
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op ((Rec Identity '[a, b] -> (c, c -> Rec Identity '[a, b]))
 -> Op '[a, b] c)
-> (Rec Identity '[a, b] -> (c, c -> Rec Identity '[a, b]))
-> Op '[a, b] c
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 a
r
x b
r
y
     in (c
z, (\(!a
dx, !b
dy) -> a -> Identity a
forall a. a -> Identity a
Identity a
dx Identity a -> Rec Identity '[b] -> Rec Identity '[a, b]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& b -> Identity b
forall a. a -> Identity a
Identity b
dy Identity b -> Rec Identity '[] -> Rec Identity '[b]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec Identity '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) ((a, b) -> Rec Identity '[a, b])
-> (c -> (a, b)) -> c -> Rec Identity '[a, b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> (a, b)
dxdy)
{-# INLINE op2 #-}

-- | Create an 'Op' of a function taking three inputs, by giving its explicit
-- gradient.  See documentation for 'op2' for more details.
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 = (Rec Identity '[a, b, c] -> (d, d -> Rec Identity '[a, b, c]))
-> Op '[a, b, c] d
forall (as :: [*]) a.
(Rec Identity as -> (a, a -> Rec Identity as)) -> Op as a
Op ((Rec Identity '[a, b, c] -> (d, d -> Rec Identity '[a, b, c]))
 -> Op '[a, b, c] d)
-> (Rec Identity '[a, b, c] -> (d, d -> Rec Identity '[a, b, c]))
-> Op '[a, b, c] d
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 a
r
x b
r
y c
r
z
     in (d
q, (\(!a
dx, !b
dy, !c
dz) -> a -> Identity a
forall a. a -> Identity a
Identity a
dx Identity a -> Rec Identity '[b, c] -> Rec Identity '[a, b, c]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& b -> Identity b
forall a. a -> Identity a
Identity b
dy Identity b -> Rec Identity '[c] -> Rec Identity '[b, c]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& c -> Identity c
forall a. a -> Identity a
Identity c
dz Identity c -> Rec Identity '[] -> Rec Identity '[c]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec Identity '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) ((a, b, c) -> Rec Identity '[a, b, c])
-> (d -> (a, b, c)) -> d -> Rec Identity '[a, b, c]
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 = Rec (Op as) '[a, a] -> Op '[a, a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 Op as a -> Rec (Op as) '[a] -> Rec (Op as) '[a, a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a, a] a
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 = Rec (Op as) '[a, a] -> Op '[a, a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 Op as a -> Rec (Op as) '[a] -> Rec (Op as) '[a, a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a, a] a
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 = Rec (Op as) '[a, a] -> Op '[a, a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 Op as a -> Rec (Op as) '[a] -> Rec (Op as) '[a, a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a, a] a
forall a. Num a => Op '[a, a] a
(*.)
  {-# INLINE (*) #-}
  negate :: Op as a -> Op as a
negate Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Num a => Op '[a] a
negateOp
  {-# INLINE negate #-}
  signum :: Op as a -> Op as a
signum Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Num a => Op '[a] a
signumOp
  {-# INLINE signum #-}
  abs :: Op as a -> Op as a
abs Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Num a => Op '[a] a
absOp
  {-# INLINE abs #-}
  fromInteger :: Integer -> Op as a
fromInteger Integer
x = a -> Op as a
forall (as :: [*]) a. RPureConstrained Num as => a -> Op as a
opConst (Integer -> a
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 = Rec (Op as) '[a, a] -> Op '[a, a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 Op as a -> Rec (Op as) '[a] -> Rec (Op as) '[a, a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a, a] a
forall a. Fractional a => Op '[a, a] a
(/.)
  recip :: Op as a -> Op as a
recip Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Fractional a => Op '[a] a
recipOp
  {-# INLINE recip #-}
  fromRational :: Rational -> Op as a
fromRational Rational
x = a -> Op as a
forall (as :: [*]) a. RPureConstrained Num as => a -> Op as a
opConst (Rational -> a
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 = a -> Op as a
forall (as :: [*]) a. RPureConstrained Num as => a -> Op as a
opConst a
forall a. Floating a => a
pi
  {-# INLINE pi #-}
  exp :: Op as a -> Op as a
exp Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
expOp
  {-# INLINE exp #-}
  log :: Op as a -> Op as a
log Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
logOp
  {-# INLINE log #-}
  sqrt :: Op as a -> Op as a
sqrt Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
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 = Rec (Op as) '[a, a] -> Op '[a, a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 Op as a -> Rec (Op as) '[a] -> Rec (Op as) '[a, a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a, a] a
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 = Rec (Op as) '[a, a] -> Op '[a, a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o1 Op as a -> Rec (Op as) '[a] -> Rec (Op as) '[a, a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Op as a
o2 Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a, a] a
forall a. Floating a => Op '[a, a] a
logBaseOp
  {-# INLINE logBase #-}
  sin :: Op as a -> Op as a
sin Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
sinOp
  {-# INLINE sin #-}
  cos :: Op as a -> Op as a
cos Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
cosOp
  {-# INLINE cos #-}
  tan :: Op as a -> Op as a
tan Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
tanOp
  {-# INLINE tan #-}
  asin :: Op as a -> Op as a
asin Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
asinOp
  {-# INLINE asin #-}
  acos :: Op as a -> Op as a
acos Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
acosOp
  {-# INLINE acos #-}
  atan :: Op as a -> Op as a
atan Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
atanOp
  {-# INLINE atan #-}
  sinh :: Op as a -> Op as a
sinh Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
sinhOp
  {-# INLINE sinh #-}
  cosh :: Op as a -> Op as a
cosh Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
coshOp
  {-# INLINE cosh #-}
  tanh :: Op as a -> Op as a
tanh Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
tanhOp
  {-# INLINE tanh #-}
  asinh :: Op as a -> Op as a
asinh Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
asinhOp
  {-# INLINE asinh #-}
  acosh :: Op as a -> Op as a
acosh Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
acoshOp
  {-# INLINE acosh #-}
  atanh :: Op as a -> Op as a
atanh Op as a
o = Rec (Op as) '[a] -> Op '[a] a -> Op as a
forall (as :: [*]) (bs :: [*]) c.
RPureConstrained Num as =>
Rec (Op as) bs -> Op bs c -> Op as c
composeOp (Op as a
o Op as a -> Rec (Op as) '[] -> Rec (Op as) '[a]
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Op as) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil) Op '[a] a
forall a. Floating a => Op '[a] a
atanhOp
  {-# INLINE atanh #-}

-- $numops
--
-- Built-in ops for common numeric operations.
--
-- Note that the operators (like '+.') are meant to be used in prefix
-- form, like:
--
-- @
-- 'Numeric.Backprop.liftOp2' ('.+') v1 v2
-- @

-- | 'Op' for addition
(+.) :: Num a => Op '[a, a] a
+. :: forall a. Num a => Op '[a, a] a
(+.) = (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 ((a -> a -> (a, a -> (a, a))) -> Op '[a, a] a)
-> (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b. (a -> b) -> a -> b
$ \a
x a
y -> (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y, \a
g -> (a
g, a
g))
{-# INLINE (+.) #-}

-- | 'Op' for subtraction
(-.) :: Num a => Op '[a, a] a
-. :: forall a. Num a => Op '[a, a] a
(-.) = (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 ((a -> a -> (a, a -> (a, a))) -> Op '[a, a] a)
-> (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b. (a -> b) -> a -> b
$ \a
x a
y -> (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y, \a
g -> (a
g, -a
g))
{-# INLINE (-.) #-}

-- | 'Op' for multiplication
(*.) :: Num a => Op '[a, a] a
*. :: forall a. Num a => Op '[a, a] a
(*.) = (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 ((a -> a -> (a, a -> (a, a))) -> Op '[a, a] a)
-> (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b. (a -> b) -> a -> b
$ \a
x a
y -> (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y, \a
g -> (a
y a -> a -> a
forall a. Num a => a -> a -> a
* a
g, a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
g))
{-# INLINE (*.) #-}

-- | 'Op' for division
(/.) :: Fractional a => Op '[a, a] a
/. :: forall a. Fractional a => Op '[a, a] a
(/.) = (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 ((a -> a -> (a, a -> (a, a))) -> Op '[a, a] a)
-> (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b. (a -> b) -> a -> b
$ \a
x a
y -> (a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
y, \a
g -> (a
g a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
y, -(a
g a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
y a -> a -> a
forall a. Num a => a -> a -> a
* a
y))))
{-# INLINE (/.) #-}

-- | 'Op' for exponentiation
(**.) :: Floating a => Op '[a, a] a
**. :: forall a. Floating a => Op '[a, a] a
(**.) = (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 ((a -> a -> (a, a -> (a, a))) -> Op '[a, a] a)
-> (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b. (a -> b) -> a -> b
$ \a
x a
y ->
  ( a
x a -> a -> a
forall a. Floating a => a -> a -> a
** a
y
  , let dx :: a
dx = a
y a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Floating a => a -> a -> a
** (a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
        dy :: a
dy = a
x a -> a -> a
forall a. Floating a => a -> a -> a
** a
y a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
log a
x
     in \a
g -> (a
g a -> a -> a
forall a. Num a => a -> a -> a
* a
dx, a
g a -> a -> a
forall a. Num a => a -> a -> a
* a
dy)
  )
{-# INLINE (**.) #-}

-- | 'Op' for negation
negateOp :: Num a => Op '[a] a
negateOp :: forall a. Num a => Op '[a] a
negateOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Num a => a -> a
negate a
x, a -> a
forall a. Num a => a -> a
negate)
{-# INLINE negateOp #-}

-- | 'Op' for 'signum'
signumOp :: Num a => Op '[a] a
signumOp :: forall a. Num a => Op '[a] a
signumOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Num a => a -> a
signum a
x, a -> a -> a
forall a b. a -> b -> a
const a
0)
{-# INLINE signumOp #-}

-- | 'Op' for absolute value
absOp :: Num a => Op '[a] a
absOp :: forall a. Num a => Op '[a] a
absOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Num a => a -> a
abs a
x, (a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
signum a
x))
{-# INLINE absOp #-}

-- | 'Op' for multiplicative inverse
recipOp :: Fractional a => Op '[a] a
recipOp :: forall a. Fractional a => Op '[a] a
recipOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Fractional a => a -> a
recip a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x)) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
negate)
{-# INLINE recipOp #-}

-- | 'Op' for 'exp'
expOp :: Floating a => Op '[a] a
expOp :: forall a. Floating a => Op '[a] a
expOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
exp a
x, (a -> a
forall a. Floating a => a -> a
exp a
x a -> a -> a
forall a. Num a => a -> a -> a
*))
{-# INLINE expOp #-}

-- | 'Op' for the natural logarithm
logOp :: Floating a => Op '[a] a
logOp :: forall a. Floating a => Op '[a] a
logOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
log a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
x))
{-# INLINE logOp #-}

-- | 'Op' for square root
sqrtOp :: Floating a => Op '[a] a
sqrtOp :: forall a. Floating a => Op '[a] a
sqrtOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
sqrt a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
sqrt a
x)))
{-# INLINE sqrtOp #-}

-- | 'Op' for 'logBase'
logBaseOp :: Floating a => Op '[a, a] a
logBaseOp :: forall a. Floating a => Op '[a, a] a
logBaseOp = (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b c. (a -> b -> (c, c -> (a, b))) -> Op '[a, b] c
op2 ((a -> a -> (a, a -> (a, a))) -> Op '[a, a] a)
-> (a -> a -> (a, a -> (a, a))) -> Op '[a, a] a
forall a b. (a -> b) -> a -> b
$ \a
x a
y ->
  ( a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
x a
y
  , let dx :: a
dx = -(a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
x a
y a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a -> a
forall a. Floating a => a -> a
log a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x))
     in \a
g -> (a
g a -> a -> a
forall a. Num a => a -> a -> a
* a
dx, a
g a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
y a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
log a
x))
  )
{-# INLINE logBaseOp #-}

-- | 'Op' for sine
sinOp :: Floating a => Op '[a] a
sinOp :: forall a. Floating a => Op '[a] a
sinOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
sin a
x, (a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
cos a
x))
{-# INLINE sinOp #-}

-- | 'Op' for cosine
cosOp :: Floating a => Op '[a] a
cosOp :: forall a. Floating a => Op '[a] a
cosOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
cos a
x, (a -> a -> a
forall a. Num a => a -> a -> a
* (-a -> a
forall a. Floating a => a -> a
sin a
x)))
{-# INLINE cosOp #-}

-- | 'Op' for tangent
tanOp :: Floating a => Op '[a] a
tanOp :: forall a. Floating a => Op '[a] a
tanOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
tan a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
cos a
x a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)))
{-# INLINE tanOp #-}

-- | 'Op' for arcsine
asinOp :: Floating a => Op '[a] a
asinOp :: forall a. Floating a => Op '[a] a
asinOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
asin a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
sqrt (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x)))
{-# INLINE asinOp #-}

-- | 'Op' for arccosine
acosOp :: Floating a => Op '[a] a
acosOp :: forall a. Floating a => Op '[a] a
acosOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
acos a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
sqrt (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x)) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. Num a => a -> a
negate)
{-# INLINE acosOp #-}

-- | 'Op' for arctangent
atanOp :: Floating a => Op '[a] a
atanOp :: forall a. Floating a => Op '[a] a
atanOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
atan a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)))
{-# INLINE atanOp #-}

-- | 'Op' for hyperbolic sine
sinhOp :: Floating a => Op '[a] a
sinhOp :: forall a. Floating a => Op '[a] a
sinhOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
sinh a
x, (a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
cosh a
x))
{-# INLINE sinhOp #-}

-- | 'Op' for hyperbolic cosine
coshOp :: Floating a => Op '[a] a
coshOp :: forall a. Floating a => Op '[a] a
coshOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
cosh a
x, (a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
sinh a
x))
{-# INLINE coshOp #-}

-- | 'Op' for hyperbolic tangent
tanhOp :: Floating a => Op '[a] a
tanhOp :: forall a. Floating a => Op '[a] a
tanhOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
tanh a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
cosh a
x a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)))
{-# INLINE tanhOp #-}

-- | 'Op' for hyperbolic arcsine
asinhOp :: Floating a => Op '[a] a
asinhOp :: forall a. Floating a => Op '[a] a
asinhOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
asinh a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
sqrt (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)))
{-# INLINE asinhOp #-}

-- | 'Op' for hyperbolic arccosine
acoshOp :: Floating a => Op '[a] a
acoshOp :: forall a. Floating a => Op '[a] a
acoshOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
acosh a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
sqrt (a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
1)))
{-# INLINE acoshOp #-}

-- | 'Op' for hyperbolic arctangent
atanhOp :: Floating a => Op '[a] a
atanhOp :: forall a. Floating a => Op '[a] a
atanhOp = (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> (b, b -> a)) -> Op '[a] b
op1 ((a -> (a, a -> a)) -> Op '[a] a)
-> (a -> (a, a -> a)) -> Op '[a] a
forall a b. (a -> b) -> a -> b
$ \a
x -> (a -> a
forall a. Floating a => a -> a
atanh a
x, (a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x)))
{-# INLINE atanhOp #-}

-- $prod
--
-- 'Rec', from the <http://hackage.haskell.org/package/vinyl vinyl> library
-- (in "Data.Vinyl.Core") is a heterogeneous list/tuple type, which allows
-- you to tuple together multiple values of different types and operate on
-- them generically.
--
-- A @'Rec' f '[a, b, c]@ contains an @f a@, an @f b@, and an @f c@, and
-- is constructed by consing them together with ':&' (using 'RNil' as nil):
--
-- @
-- 'Identity' "hello" ':&' Identity True :& Identity 7.8 :& RNil    :: 'Rec' 'I' '[String, Bool, Double]
-- 'Const' "hello" :& Const "world" :& Const "ok" :& RNil  :: 'Rec' ('C' String) '[a, b, c]
-- 'Proxy' :& Proxy :& Proxy :& RNil           :: 'Rec' 'Proxy' '[a, b, c]
-- @
--
-- So, in general:
--
-- @
-- x :: f a
-- y :: f b
-- z :: f c
-- x :& y :& z :& RNil :: Rec f '[a, b, c]
-- @