packages feed

inf-backprop (empty) → 0.1.0.0

raw patch · 13 files changed

+2489/−0 lines, 13 filesdep +basedep +comonaddep +doctest

Dependencies added: base, comonad, doctest, isomorphism-class, monad-logger, numhask, simple-expr, text, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,9 @@+# Revision history for simple-expr++## 0.1.0.0 -- 2023-05-12++* Basic types `Backprop`, `StartBackprop` etc.+* Basic function backprrop derivative implementations.+* `Isomorphism` tyepclass and extra instances for `IsomorphicTo` typeclass from `isomorphism-class` package.+* Extra instancies for `Additive` typeclass from `numhask` package. +* Tutorial
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2023, Alexey Tochin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alexey Tochin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ doctests/Main.hs view
@@ -0,0 +1,22 @@+import Test.DocTest (doctest)+import Prelude (IO)++-- This test suite exists only to add dependencies+main :: IO ()+main =+  doctest+    [ "-XHaskell2010",+      "-XNoImplicitPrelude",+      "-XGADTs",+      "-XTypeFamilies",+      "-XMultiParamTypeClasses",+      "-XFlexibleInstances",+      "-XScopedTypeVariables",+      "-XConstraintKinds",+      "-XRankNTypes",+      "-XInstanceSigs",+      "-XTupleSections",+      "-XFlexibleContexts",+      "-XDeriveFunctor",+      "src"+    ]
+ inf-backprop.cabal view
@@ -0,0 +1,88 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.1.+--+-- see: https://github.com/sol/hpack++name:           inf-backprop+version:        0.1.0.0+synopsis:       Automatic differentiation and backpropagation.+description:    ![Second order derivative of a composition](doc/images/composition_second_derivative.png)+                .+                Automatic differentiation and backpropagation.+                We do not attract gradient tape.+                Instead, the differentiation operator is defined directly as a map between differentiable function objects.+                Such functions are to be combined in arrow style using '(>>>)', '(***)', 'first', etc.+                .+                The original purpose of the package is an automatic backpropagation differentiation component+                for a functional type-dependent library for deep machine learning.+                See [tutorial](InfBackprop-Tutorial.html) details.+category:       Math+author:         Alexey Tochin+maintainer:     Alexey.Tochin@gmail.com+copyright:      2023 Alexey Tochin+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    CHANGELOG.md++library+  exposed-modules:+      Control.CatBifunctor+      Debug.LoggingBackprop+      InfBackprop+      InfBackprop.Common+      InfBackprop.Tutorial+      IsomorphismClass.Extra+      IsomorphismClass.Isomorphism+      NumHask.Extra+      Prelude.InfBackprop+  other-modules:+      Paths_inf_backprop+  hs-source-dirs:+      src+  default-extensions:+      NoImplicitPrelude+      GADTs+      TypeFamilies+      MultiParamTypeClasses+      FlexibleInstances+      ScopedTypeVariables+      ConstraintKinds+      RankNTypes+      InstanceSigs+      TupleSections+      FlexibleContexts+      DeriveFunctor+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , comonad+    , isomorphism-class+    , monad-logger+    , numhask+    , simple-expr+    , text+    , transformers+  default-language: Haskell2010++test-suite doctests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_inf_backprop+  hs-source-dirs:+      doctests+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , comonad+    , doctest+    , isomorphism-class+    , monad-logger+    , numhask+    , simple-expr+    , text+    , transformers+  default-language: Haskell2010
+ src/Control/CatBifunctor.hs view
@@ -0,0 +1,179 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  Control.CatBifunctor+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Categorical Bifunctor typeclass and its trivial instances.+module Control.CatBifunctor+  ( CatBiFunctor,+    first,+    second,+    (***),+  )+where++import Control.Applicative (liftA2)+import Control.Arrow (Kleisli (Kleisli), (>>>))+import Control.Category (Category, id)+import Control.Comonad (Cokleisli (Cokleisli), Comonad, liftW)+import Data.Bifunctor (bimap)+import GHC.Base (Type)+import Prelude (Either (Left, Right), Monad, fmap, fst, snd, ($))++-- | Categorical generalization for bifunctor with arrow notations.+-- Notice that we do NOT require the categorical morphism '(>>>)'+-- and morphism tensor product '(***)' are interchangeable. Namely,+--+-- @ (f >>> g) *** (h >>> l) != (f *** h) >>> (g *** l) @+--+-- in general.+--+-- ==== __Monad and type product instance examples of usage __+--+-- >>> import Prelude (Int, pure, Maybe(Just, Nothing), const, replicate, String)+-- >>> import Control.Arrow (Kleisli(Kleisli), runKleisli)+--+-- >>> runKleisli (Kleisli pure *** Kleisli pure) (1,2) :: [(Int, Int)]+-- [(1,2)]+--+-- >>> runKleisli (Kleisli pure *** Kleisli pure) (1,2) :: Maybe (Int, Int)+-- Just (1,2)+--+-- >>> runKleisli (Kleisli pure *** Kleisli (const Nothing)) (1,2) :: Maybe (Int, Int)+-- Nothing+--+-- >>> runKleisli (Kleisli (replicate 2) *** Kleisli (replicate 3)) ("a","b") :: [(String, String)]+-- [("a","b"),("a","b"),("a","b"),("a","b"),("a","b"),("a","b")]+--+-- ==== __Comonad and type product instance examples of usage__+--+-- >>> import Prelude (Int, pure, Maybe(..), const, replicate, String, (+), (++), Functor, Show, show, (==), (-))+-- >>> import Control.Comonad (Cokleisli(Cokleisli), runCokleisli, extract, duplicate, (=>=))+-- >>> import Control.Comonad.Store (store, seek, runStore, Store, StoreT)+-- >>> import Control.Category ((>>>))+--+-- >>> runCokleisli (Cokleisli extract *** Cokleisli extract) (store (\x -> (x + 1, x + 2)) 3) :: (Int, Int)+-- (4,5)+--+-- >>> :{+-- up :: Int -> Cokleisli (Store Int) Int Int+-- up n = Cokleisli $ \st -> let (ws, s) = runStore st in ws (s + n)+-- :}+--+-- >>> runCokleisli ((up 3 *** up 5) >>> (up 2 *** up 4)) (store (\x -> (x + 1, x + 2)) 0) :: (Int, Int)+-- (6,11)+--+-- >>> runCokleisli ((up 3 >>> up 2) *** (up 5 >>> up 4)) (store (\x -> (x + 1, x + 2)) 0) :: (Int, Int)+-- (6,11)+--+-- >>> :{+-- data Stream a = Cons a (Stream a)+-- tail :: Stream a -> Stream a+-- tail (Cons _ xs) = xs+-- instance Show a => Show (Stream a) where+--   show (Cons x0 (Cons x1 (Cons x2 (Cons x3 (Cons x4 _))))) = show [x0, x1, x2, x3, x4] ++ "..."+-- instance Functor Stream where+--   fmap f (Cons x xs) = Cons (f x) (fmap f xs)+-- instance Comonad Stream where+--   extract (Cons x _ ) = x+--   duplicate xs = Cons xs (duplicate (tail xs))+-- :}+--+-- >>> :{+-- dup :: a -> (a, a)+-- dup x = (x, x)+-- naturals :: Int -> Stream Int+-- naturals n = Cons n (naturals (n + 1))+-- take :: Int -> Stream a -> a+-- take n (Cons x xs) = if n == 0+--   then x+--   else take (n - 1) xs+-- :}+--+-- >>> naturals 0+-- [0,1,2,3,4]...+--+-- >>> take 5 (naturals 0)+-- 5+--+-- >>> ((take 3) =>= (take 4)) (naturals 0)+-- 7+--+-- >>> runCokleisli (Cokleisli (take 3) *** Cokleisli (take 4)) (fmap dup (naturals 0)) :: (Int, Int)+-- (3,4)+--+-- >>> streamN n = Cokleisli (take n)+--+-- >>> runCokleisli ((streamN 3 *** streamN 5) >>> (streamN 2 *** streamN 4)) (fmap dup (naturals 0)) :: (Int, Int)+-- (5,9)+--+-- >>> runCokleisli ((streamN 3 >>> streamN 2) *** (streamN 5 >>> streamN 4)) (fmap dup (naturals 0)) :: (Int, Int)+-- (5,9)+--+-- ==== __Monad and type sum examples of usage__+--+-- >>> import Prelude (Int, pure, Maybe(Just, Nothing), const, replicate, String)+-- >>> import Control.Arrow (Kleisli(Kleisli), runKleisli)+--+-- >>> runKleisli (Kleisli pure *** Kleisli pure) (Left "a") :: [Either String Int]+-- [Left "a"]+--+-- >>> runKleisli (Kleisli pure *** Kleisli pure) (Right 1) :: Maybe (Either String Int)+-- Just (Right 1)+class+  Category cat =>+  CatBiFunctor (p :: Type -> Type -> Type) (cat :: Type -> Type -> Type)+  where+  -- | Categorical generalization of+  --+  -- @bimap :: (a1 -> b1) -> (a2 -> b2) -> (p a1 a2 -> p c1 c2)@+  --+  -- borrowed from arrows.+  (***) :: cat a1 b1 -> cat a2 b2 -> cat (p a1 a2) (p b1 b2)++  -- | Categorical generalization of+  --+  -- @first :: (a -> b) -> (p a c -> p c b)@+  --+  -- borrowed from arrows.+  first :: cat a b -> cat (p a c) (p b c)+  first f = f *** id++  -- | Categorical generalization of+  --+  -- @second :: (a -> b) -> (p a c -> p c b)@+  --+  -- borrowed from arrows.+  second :: cat a b -> cat (p c a) (p c b)+  second f = id *** f++instance CatBiFunctor (,) (->) where+  first f = bimap f id+  second = bimap id+  (***) = bimap++instance forall m. Monad m => CatBiFunctor (,) (Kleisli m) where+  (***) :: Kleisli m a1 b1 -> Kleisli m a2 b2 -> Kleisli m (a1, a2) (b1, b2)+  (Kleisli (mf1 :: a1 -> m b1)) *** (Kleisli (mf2 :: a2 -> m b2)) = Kleisli mf12+    where+      mf12 :: (a1, a2) -> m (b1, b2)+      mf12 (x1, x2) = liftA2 (,) (mf1 x1) (mf2 x2)++instance forall m. Comonad m => CatBiFunctor (,) (Cokleisli m) where+  (***) :: Cokleisli m a1 b1 -> Cokleisli m a2 b2 -> Cokleisli m (a1, a2) (b1, b2)+  (Cokleisli (mf1 :: m a1 -> b1)) *** (Cokleisli (mf2 :: m a2 -> b2)) = Cokleisli mf12+    where+      mf12 :: m (a1, a2) -> (b1, b2)+      mf12 x12 = (mf1 $ liftW fst x12, mf2 $ liftW snd x12)++instance forall m. Monad m => CatBiFunctor Either (Kleisli m) where+  (***) :: Kleisli m a1 b1 -> Kleisli m a2 b2 -> Kleisli m (Either a1 a2) (Either b1 b2)+  (Kleisli (mf1 :: a1 -> m b1)) *** (Kleisli (mf2 :: a2 -> m b2)) = Kleisli mf12+    where+      mf12 :: Either a1 a2 -> m (Either b1 b2)+      mf12 x12 = case x12 of+        Left x1 -> fmap Left (mf1 x1)+        Right x2 -> fmap Right (mf2 x2)
+ src/Debug/LoggingBackprop.hs view
@@ -0,0 +1,368 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  Debug.LoggingBackprop+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Basics for simple expressions equipped with Monadic behaviour.+-- In particular, basic functions with logging for debug and illustration purposes.+-- See [this tutorial section](InfBackprop.Tutorial#differentiation_monadic_types) for details.+module Debug.LoggingBackprop+  ( -- * Generic logging functions+    unitConst,+    initUnaryFunc,+    initBinaryFunc,+    pureKleisli,+    backpropExpr,+    loggingBackpropExpr,++    -- * Logging functions examples+    const,+    linear,+    negate,+    (+),+    (*),+    pow,+    exp,+    sin,+    cos,+  )+where++import Control.Arrow (Kleisli (Kleisli))+import Control.CatBifunctor (first, second, (***))+import Control.Category ((.), (>>>))+import Control.Monad.Logger (MonadLogger, logInfoN)+import Data.Text (pack)+import Debug.SimpleExpr.Expr (SimpleExpr, unaryFunc)+import InfBackprop.Common (Backprop (MkBackprop), BackpropFunc)+import IsomorphismClass.Isomorphism (iso)+import NumHask (Additive, Distributive, Divisive, ExpField, Multiplicative, Subtractive, TrigField, fromInteger, zero)+import qualified NumHask as NH+import qualified NumHask.Prelude as NHP+import qualified Prelude.InfBackprop+import Prelude (Monad, Show, String, pure, return, show, ($), (<>))+import qualified Prelude as P++-- | Logging constant function.+--+-- ==== __Examples of usage__+--+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+--+-- >>> runStdoutLoggingT $ runKleisli (unitConst 42) ()+-- [Info] Initializing 42+-- 42+unitConst :: (Show a, MonadLogger m) => a -> Kleisli m () a+unitConst a = Kleisli $ \() -> do+  logInfoN $ "Initializing " <> pack (show a)+  pure a++-- | Logging single argument function.+--+-- ==== __Examples of usage__+--+-- >>> import qualified Prelude as P+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+--+-- >>> plusTwo = initUnaryFunc "+2" (P.+2)+-- >>> runStdoutLoggingT $ runKleisli plusTwo 3+-- [Info] Calculating +2 of 3 => 5+-- 5+initUnaryFunc :: (Show a, Show b, MonadLogger m) => String -> (a -> b) -> Kleisli m a b+initUnaryFunc msg f = Kleisli $ \a -> do+  let b = f a+  logInfoN $ "Calculating " <> pack msg <> " of " <> pack (show a) <> " => " <> pack (show b)+  pure b++-- | Logging two argument (binary) function.+--+-- ==== __Examples of usage__+--+-- >>> import qualified Prelude as P+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+--+-- >>> loggingProduct = initBinaryFunc "product" (P.*)+-- >>> runStdoutLoggingT $ runKleisli loggingProduct (6, 7)+-- [Info] Calculating product of 6 and 7 => 42+-- 42+initBinaryFunc :: (Show a, Show b, Show c, MonadLogger m) => String -> (a -> b -> c) -> Kleisli m (a, b) c+initBinaryFunc msg f = Kleisli $ \(a, b) -> do+  let c = f a b+  logInfoN $+    "Calculating "+      <> pack msg+      <> " of "+      <> pack (show a)+      <> " and "+      <> pack (show b)+      <> " => "+      <> pack (show c)+  return c++-- | Returns pure Kleisli morphism given a map.+--+-- ==== __Examples of usage__+--+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+--+-- >>> loggingDup = pureKleisli (\x -> (x, x))+-- >>> runStdoutLoggingT $ runKleisli loggingDup 42+-- (42,42)+pureKleisli :: Monad m => (a -> b) -> Kleisli m a b+pureKleisli f = Kleisli $ pure . f++-- Differentiable functions.++-- | Returns symbolically differentiable Simple Expression.+--+-- ==== __Examples of usage__+--+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> import InfBackprop (call, derivative, backpropExpr)+--+-- >>> x = variable "x"+-- >>> f = backpropExpr "f"+-- >>> call f x+-- f(x)+--+-- >>> derivative f x+-- 1·f'(x)+backpropExpr :: String -> BackpropFunc SimpleExpr SimpleExpr+backpropExpr funcName = MkBackprop call_ forward_ backward_+  where+    call_ = unaryFunc funcName+    forward_ = Prelude.InfBackprop.dup >>> first (backpropExpr funcName :: BackpropFunc SimpleExpr SimpleExpr)+    backward_ = second (backpropExpr (funcName <> "'")) >>> (Prelude.InfBackprop.*)++-- | Returns symbolically differentiable logging symbolic function.+--+-- ==== __Examples of usage__+--+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> import InfBackprop (call, derivative)+--+-- >>> x = variable "x"+-- >>> f = loggingBackpropExpr "f"+-- >>> runStdoutLoggingT $ runKleisli (call f) x+-- [Info] Calculating f of x => f(x)+-- f(x)+--+-- >>> runStdoutLoggingT $ runKleisli (derivative f) x+-- [Info] Calculating f of x => f(x)+-- [Info] Calculating f' of x => f'(x)+-- [Info] Calculating multiplication of 1 and f'(x) => 1·f'(x)+-- 1·f'(x)+loggingBackpropExpr :: forall m. (MonadLogger m) => String -> Backprop (Kleisli m) SimpleExpr SimpleExpr+loggingBackpropExpr funcName = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m SimpleExpr SimpleExpr+    call' = initUnaryFunc funcName (unaryFunc funcName)++    forward' :: Backprop (Kleisli m) SimpleExpr (SimpleExpr, SimpleExpr)+    forward' = dup >>> first (loggingBackpropExpr funcName :: Backprop (Kleisli m) SimpleExpr SimpleExpr)++    backward' :: Backprop (Kleisli m) (SimpleExpr, SimpleExpr) SimpleExpr+    backward' = second (loggingBackpropExpr (funcName <> "'")) >>> (*)++-- | Differentiable logging constant function.+--+-- ==== __Examples of usage__+--+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> import InfBackprop (call, derivative)+--+-- >>> runStdoutLoggingT $ runKleisli (call (const 42)) ()+-- 42+const ::+  forall c x m.+  (Additive c, Additive x, Show c, Show x, Monad m) =>+  c ->+  Backprop (Kleisli m) x c+const c = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m x c+    call' = Kleisli $ P.const (pure c)++    forward' :: Backprop (Kleisli m) x (c, ())+    forward' = const c >>> (iso :: Backprop (Kleisli m) c (c, ()))++    backward' :: Backprop (Kleisli m) (c, ()) x+    backward' = const zero++-- | Differentiable dup logging function.+dup :: forall x m. (Show x, Additive x, MonadLogger m) => Backprop (Kleisli m) x (x, x)+dup = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m x (x, x)+    call' = pureKleisli (\x -> (x, x))++    forward' :: Backprop (Kleisli m) x ((x, x), ())+    forward' = dup >>> (iso :: Backprop (Kleisli m) y (y, ()))++    backward' :: Backprop (Kleisli m) ((x, x), ()) x+    backward' = (iso :: Backprop (Kleisli m) (y, ()) y) >>> (+)++-- | Differentiable logging sum function.+--+-- ==== __Examples of usage__+--+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+-- >>> import InfBackprop (call)+--+-- >>> runStdoutLoggingT $ runKleisli (call (+)) (2, 2)+-- [Info] Calculating sum of 2 and 2 => 4+-- 4+(+) :: forall x m. (Show x, Additive x, MonadLogger m) => Backprop (Kleisli m) (x, x) x+(+) = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m (x, x) x+    call' = initBinaryFunc "sum" (NH.+)++    forward' :: Backprop (Kleisli m) (x, x) (x, ())+    forward' = (+) >>> (iso :: Backprop (Kleisli m) y (y, ()))++    backward' :: Backprop (Kleisli m) (x, ()) (x, x)+    backward' = (iso :: Backprop (Kleisli m) (x, ()) x) >>> dup++-- | Differentiable logging multiplication function.+--+-- ==== __Examples of usage__+--+-- >>> import Control.Arrow (runKleisli)+-- >>> import Control.Monad.Logger (runStdoutLoggingT)+-- >>> import InfBackprop (call)+--+-- >>> runStdoutLoggingT $ runKleisli (call (*)) (6, 7)+-- [Info] Calculating multiplication of 6 and 7 => 42+-- 42+(*) ::+  forall x m.+  (Show x, Additive x, Multiplicative x, MonadLogger m) =>+  Backprop (Kleisli m) (x, x) x+(*) = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m (x, x) x+    call' = initBinaryFunc "multiplication" (NH.*)++    forward' :: Backprop (Kleisli m) (x, x) (x, (x, x))+    forward' = dup >>> first (*)++    backward' :: Backprop (Kleisli m) (x, (x, x)) (x, x)+    backward' =+      first dup+        >>> (iso :: Backprop (Kleisli m) ((dy, dy), (x1, x2)) ((dy, x1), (dy, x2)))+        >>> (iso :: Backprop (Kleisli m) (a, b) (b, a))+        >>> ((*) *** (*))++-- | Differentiable logging linear function.+linear ::+  forall x m.+  (Show x, NH.Distributive x, MonadLogger m) =>+  x ->+  Backprop (Kleisli m) x x+linear c = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m x x+    call' = initUnaryFunc ("linear " <> show c) (c NH.*)++    forward' :: Backprop (Kleisli m) x (x, ())+    forward' = linear c >>> (iso :: Backprop (Kleisli m) y (y, ()))++    backward' :: Backprop (Kleisli m) (x, ()) x+    backward' = (iso :: Backprop (Kleisli m) (x, ()) x) >>> linear c++-- | Differentiable logging negate function.+negate ::+  forall x m.+  (Show x, Subtractive x, MonadLogger m) =>+  Backprop (Kleisli m) x x+negate = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m x x+    call' = initUnaryFunc "negate" NH.negate++    forward' :: Backprop (Kleisli m) x (x, ())+    forward' = negate >>> (iso :: Backprop (Kleisli m) y (y, ()))++    backward' :: Backprop (Kleisli m) (x, ()) x+    backward' = (iso :: Backprop (Kleisli m) (y, ()) y) >>> negate++-- | Differentiable logging exponent function.+exp ::+  forall x m.+  (ExpField x, Show x, MonadLogger m) =>+  Backprop (Kleisli m) x x+exp = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m x x+    call' = initUnaryFunc "exp" NH.exp++    forward' :: Backprop (Kleisli m) x (x, x)+    forward' = (exp :: Backprop (Kleisli m) x x) >>> dup++    backward' :: Backprop (Kleisli m) (x, x) x+    backward' = (*)++-- | Differentiable logging power function.+pow ::+  forall x m.+  (Show x, Divisive x, Distributive x, Subtractive x, NH.FromIntegral x NHP.Integer, MonadLogger m) =>+  NHP.Integer ->+  Backprop (Kleisli m) x x+pow n = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m x x+    call' = initUnaryFunc ("pow " <> show n) (NH.^ fromInteger n)++    forward' :: Backprop (Kleisli m) x (x, x)+    forward' = dup >>> first (pow n :: Backprop (Kleisli m) x x)++    backward' :: Backprop (Kleisli m) (x, x) x+    backward' = second (pow (n P.- 1) >>> linear (NH.fromIntegral n)) >>> (*)++-- | Differentiable logging sin function.+sin ::+  forall x m.+  (Show x, TrigField x, MonadLogger m) =>+  Backprop (Kleisli m) x x+sin = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m x x+    call' = initUnaryFunc "sin" NH.sin++    forward' :: Backprop (Kleisli m) x (x, x)+    forward' = dup >>> first (sin :: Backprop (Kleisli m) x x)++    backward' :: Backprop (Kleisli m) (x, x) x+    backward' = second (cos :: Backprop (Kleisli m) x x) >>> (*)++-- | Differentiable logging cos function.+cos ::+  forall x m.+  (Show x, TrigField x, MonadLogger m) =>+  Backprop (Kleisli m) x x+cos = MkBackprop call' forward' backward'+  where+    call' :: Kleisli m x x+    call' = initUnaryFunc "cos" NH.cos++    forward' :: Backprop (Kleisli m) x (x, x)+    forward' = dup >>> first (sin :: Backprop (Kleisli m) x x)++    backward' :: Backprop (Kleisli m) (x, x) x+    backward' = second (sin >>> negate :: Backprop (Kleisli m) x x) >>> (*)
+ src/InfBackprop.hs view
@@ -0,0 +1,125 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  InfBackprop+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Automatic differentiation and backpropagation.+-- See 'InfBackprop.Tutorial' for details.+module InfBackprop+  ( -- * Base++    -- ** Types+    Backprop (MkBackprop),+    BackpropFunc,+    -- Manipulations+    call,+    forward,+    backward,+    derivative,+    derivativeN,++    -- ** Categorical Bifunctor+    (***),+    first,+    second,++    -- * Differentiable functions++    -- ** Elementary functions+    const,+    linear,+    (+),+    (-),+    negate,+    (*),+    (/),++    -- ** Tuple manipulations+    dup,+    setFirst,+    setSecond,+    forget,+    forgetFirst,+    forgetSecond,++    -- ** Exponential family functions+    log,+    logBase,+    exp,+    (**),+    pow,++    -- ** Trigonometric functions+    cos,+    sin,+    tan,+    asin,+    acos,+    atan,+    atan2,+    sinh,+    cosh,+    tanh,+    asinh,+    acosh,+    atanh,++    -- * Monadic differentiable functions+    pureBackprop,+    backpropExpr,+    loggingBackpropExpr,++    -- * Tools+    pureKleisli,+    simpleDifferentiable,+  )+where++import Control.CatBifunctor (first, second, (***))+import Debug.LoggingBackprop (backpropExpr, loggingBackpropExpr, pureKleisli)+import InfBackprop.Common+  ( Backprop (MkBackprop),+    BackpropFunc,+    backward,+    call,+    const,+    derivative,+    derivativeN,+    forward,+    pureBackprop,+  )+import Prelude.InfBackprop+  ( acos,+    acosh,+    asin,+    asinh,+    atan,+    atan2,+    atanh,+    cos,+    cosh,+    dup,+    exp,+    forget,+    forgetFirst,+    forgetSecond,+    linear,+    log,+    logBase,+    negate,+    pow,+    setFirst,+    setSecond,+    simpleDifferentiable,+    sin,+    sinh,+    tan,+    tanh,+    (*),+    (**),+    (+),+    (-),+    (/),+  )
+ src/InfBackprop/Common.hs view
@@ -0,0 +1,340 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  InfBackprop.Common+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Provides base types and methods for backpropagation category morphism.+module InfBackprop.Common+  ( -- * Basic+    Backprop (MkBackprop),+    call,+    forward,+    backward,+    StartBackprop,+    startBackprop,+    forwardBackward,+    numba,+    numbaN,+    derivative,+    derivativeN,++    -- * Differentiable functions+    BackpropFunc,+    const,++    -- * Differentiable monadic functions+    pureBackprop,+  )+where++import Control.Arrow (Kleisli (Kleisli))+import Control.CatBifunctor (CatBiFunctor, first, (***))+import Control.Category (Category, id, (.), (>>>))+import GHC.Natural (Natural)+import IsomorphismClass (IsomorphicTo)+import IsomorphismClass.Extra ()+import IsomorphismClass.Isomorphism (Isomorphism, iso)+import NumHask (one, zero)+import NumHask.Algebra.Additive (Additive)+import NumHask.Algebra.Ring (Distributive)+import NumHask.Extra ()+import Prelude (Monad, flip, fromIntegral, iterate, pure, (!!), ($))+import qualified Prelude as P++-- | Backprop morphism.+-- #backprop#+-- Base type for an infinitely differentiable object.+-- It depends on categorical type @cat@ that is mostly common @(->)@,+-- see 'BackpropFunc' which by it's definition is equivalent to+--+-- @+-- data BackpropFunc input output = forall cache. MkBackpropFunc {+--  call     :: input -> output,+--  forward  :: BackpropFunc input (output, cache),+--  backward :: BackpropFunc (output, cache) input+-- }+-- @+--+-- The diagram below illustrates the how it works for the first derivative.+-- Consider the role of function @f@ in the derivative of the composition @g(f(h(...)))@.+-- #backprop_func#+--+-- @+--   h        ·                  f                   ·        g+--            ·                                      ·+--            ·               forward                ·+--            · --- input  >-----+-----> output >--- ·+--            ·                  V                   ·+--  ...       ·                  |                   ·       ...+--            ·                  | cache             ·+--            ·                  |                   ·+--            ·                  V                   ·+--            · --< dInput <-----+-----< dOutput <-- ·+--            ·               backward               ·+-- @+--+-- Notice that 'forward' and 'backward' are of type 'BackpropFunc' but not @(->)@.+-- This is needed for further differentiation.+-- However for the first derivative this difference can be ignored.+--+-- The return type of 'forward' contains additional term @cache@.+-- It is needed to save and transfer data calculated in the forward step to the backward step for reuse.+-- See an example in+--+-- [Differentiation with logging](#differentiation_with_logging)+-- section .+--+-- == __Remark__+-- Mathematically speaking we have to distinguish the types for 'forward' and for 'backward' methods because the second+-- acts on the cotangent bundle.+-- However, for simplicity and due to technical reasons we identify the types @input@ and @dInput@+-- as well as @output@ and @dOutput@ which is enough for our purposes because these types are usually real numbers+-- or arrays of real numbers.+data Backprop cat input output = forall cache.+  MkBackprop+  { -- | Simple internal category object extraction.+    call :: cat input output,+    -- | Returns forward category.+    -- In the case @cat = (->)@, the method coincides with 'Backprop'@ cat input output@ itself+    -- but the output contains an additional data term @cache@ with some calculation result that can be reused on in+    -- 'backward'.+    forward :: Backprop cat input (output, cache),+    -- | Returns backward category. In the case @cat = (->)@, the method takes the additional data term @cache@ that is+    -- calculated in 'forward'.+    backward :: Backprop cat (output, cache) input+  }++composition' ::+  forall cat x y z.+  (Isomorphism cat, CatBiFunctor (,) cat) =>+  Backprop cat x y ->+  Backprop cat y z ->+  Backprop cat x z+composition'+  (MkBackprop callF (forwardF :: Backprop cat x (y, hF)) (backwardF :: Backprop cat (y, hF) x))+  (MkBackprop callG (forwardG :: Backprop cat y (z, hG)) (backwardG :: Backprop cat (z, hG) y)) =+    MkBackprop call_ forward_ backward_+    where+      call_ :: cat x z+      call_ = callF >>> callG++      forward_ :: Backprop cat x (z, (hG, hF))+      forward_ =+        (forwardF `composition'` first forwardG) `composition'` (iso :: Backprop cat ((z, hG), hF) (z, (hG, hF)))++      backward_ :: Backprop cat (z, (hG, hF)) x+      backward_ =+        (iso :: Backprop cat (z, (hG, hF)) ((z, hG), hF)) `composition'` first backwardG `composition'` backwardF++iso' ::+  forall cat x y.+  (IsomorphicTo x y, Isomorphism cat, CatBiFunctor (,) cat) =>+  Backprop cat x y+iso' = MkBackprop call_ (forward_ :: Backprop cat x (y, ())) (backward_ :: Backprop cat (y, ()) x)+  where+    call_ :: cat x y+    call_ = iso++    forward_ :: Backprop cat x (y, ())+    forward_ = (iso :: Backprop cat x y) `composition'` (iso :: Backprop cat y (y, ()))++    backward_ :: Backprop cat (y, ()) x+    backward_ = (iso :: Backprop cat (y, ()) y) `composition'` (iso :: Backprop cat y x)++instance+  (Isomorphism cat, CatBiFunctor (,) cat) =>+  Category (Backprop cat)+  where+  id = iso'+  (.) = flip composition'++instance+  (Isomorphism cat, CatBiFunctor (,) cat) =>+  Isomorphism (Backprop cat)+  where+  iso = iso'++instance+  (Isomorphism cat, CatBiFunctor (,) cat) =>+  CatBiFunctor (,) (Backprop cat)+  where+  (***)+    (MkBackprop call1 (forward1 :: Backprop cat x1 (y1, h1)) (backward1 :: Backprop cat (y1, h1) x1))+    (MkBackprop call2 (forward2 :: Backprop cat x2 (y2, h2)) (backward2 :: Backprop cat (y2, h2) x2)) =+      MkBackprop call12 forward12 backward12+      where+        call12 :: cat (x1, x2) (y1, y2)+        call12 = call1 *** call2++        forward12 :: Backprop cat (x1, x2) ((y1, y2), (h1, h2))+        forward12 = forward1 *** forward2 >>> (iso :: Backprop cat ((y1, h1), (y2, h2)) ((y1, y2), (h1, h2)))++        backward12 :: Backprop cat ((y1, y2), (h1, h2)) (x1, x2)+        backward12 = (iso :: Backprop cat ((y1, y2), (h1, h2)) ((y1, h1), (y2, h2))) >>> backward1 *** backward2++-- | Implementation of the process illustrated in the+-- [diagram](#backprop_func).+-- The first argument is a backprop morphism @y -> dy@+-- The second argument is a backprop morphism @x -> y@+-- The output is the backprop @x -> dx@ build according the+-- [diagram](#backprop_func)+forwardBackward ::+  (Isomorphism cat, CatBiFunctor (,) cat) =>+  -- | backprop morphism between @y@ and @dy@+  -- that is inferred after the forward step for @f@ and before the backward step for @f@+  Backprop cat y y ->+  -- | some backprop morphism @f@ between @x@ and @y@+  Backprop cat x y ->+  -- | the output backprop morphism from @x@ to @dx@ that is the composition.+  Backprop cat x x+forwardBackward dy (MkBackprop _ forward_ backward_) = forward_ >>> first dy >>> backward_++-- | Interface for categories @cat@ and value types @x@ that support starting the backpropagation.+-- For example for @(->)@ and @Float@ we are able to start the backpropagation like+-- @f(g(x))@ -> @1 · f'(g(x)) · ...@+-- because @f@ is a @Float@ valued (scalar) function.+-- Calculating Jacobians is not currently implemented.+class Distributive x => StartBackprop cat x where+  -- | Morphism that connects forward and backward chain.+  -- Usually it is just @1@ that is supposed to be multiplied on the derivative of the top function.+  startBackprop :: Backprop cat x x++-- | Backpropagation derivative in terms of backprop morphisms.+numba ::+  (Isomorphism cat, CatBiFunctor (,) cat, StartBackprop cat y) =>+  Backprop cat x y ->+  Backprop cat x x+numba = forwardBackward startBackprop++-- | Backpropagation ns derivative in terms of backprop morphisms.+numbaN ::+  (Isomorphism cat, CatBiFunctor (,) cat, StartBackprop cat x) =>+  Natural ->+  Backprop cat x x ->+  Backprop cat x x+numbaN n f = iterate numba f !! fromIntegral n++-- | Backpropagation derivative as categorical object.+-- If @cat@ is @(->)@ the output is simply a function.+--+-- ==== __Examples of usage__+--+-- >>> import InfBackprop (sin)+-- >>> import Prelude (Float)+-- >>> derivative sin (0 :: Float)+-- 1.0+derivative ::+  (Isomorphism cat, CatBiFunctor (,) cat, StartBackprop cat y) =>+  Backprop cat x y ->+  cat x x+derivative = call . numba++-- | Backpropagation derivative of order n as categorical object.+-- If @cat@ is @(->)@ the output is simply a function.+--+-- ==== __Examples of usage__+--+-- >>> import InfBackprop (pow, const)+-- >>> import Prelude (Float, fmap)+-- >>> myFunc = (pow 2) :: Backprop (->) Float Float+--+-- >>> fmap (derivativeN 0 myFunc) [-3, -2, -1, 0, 1, 2, 3]+-- [9.0,4.0,1.0,0.0,1.0,4.0,9.0]+--+-- >>> fmap (derivativeN 1 myFunc) [-3, -2, -1, 0, 1, 2, 3]+-- [-6.0,-4.0,-2.0,0.0,2.0,4.0,6.0]+--+-- >>> fmap (derivativeN 2 myFunc) [-3, -2, -1, 0, 1, 2, 3]+-- [2.0,2.0,2.0,2.0,2.0,2.0,2.0]+--+-- >>> fmap (derivativeN 3 myFunc) [-3, -2, -1, 0, 1, 2, 3]+-- [0.0,0.0,0.0,0.0,0.0,0.0,0.0]+derivativeN ::+  (Isomorphism cat, CatBiFunctor (,) cat, StartBackprop cat x) =>+  Natural ->+  Backprop cat x x ->+  cat x x+derivativeN n = call . numbaN n++-- | Infinitely differentiable function.+-- The definition of the type synonym is equivalent to+--+-- @+-- data BackpropFunc input output = forall cache. MkBackpropFunc {+--    call     :: input -> output,+--    forward  :: BackpropFunc input (output, cache),+--    backward :: BackpropFunc (output, cache) input+--  }+-- @+--+-- See 'Backprop' for details.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (fmap, Float)+-- >>> import InfBackprop (pow, call, derivative)+-- >>> myFunc = pow 2 :: BackpropFunc Float Float+-- >>> f = call myFunc :: Float -> Float+-- >>> fmap f [-3, -2, -1, 0, 1, 2, 3]+-- [9.0,4.0,1.0,0.0,1.0,4.0,9.0]+-- >>> df = derivative myFunc :: Float -> Float+-- >>> fmap df [-3, -2, -1, 0, 1, 2, 3]+-- [-6.0,-4.0,-2.0,0.0,2.0,4.0,6.0]+type BackpropFunc = Backprop (->)++instance forall x. (Distributive x) => StartBackprop (->) x where+  startBackprop = const one++-- | Infinitely differentiable constant function.+--+-- === __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative, derivativeN)+--+-- >>> call (const 5) ()+-- 5+--+-- >>> derivative (const (5 :: Float)) 42+-- 0+--+-- >>> derivativeN 2 (const (5 :: Float)) 42+-- 0.0+const ::+  forall c x.+  (Additive c, Additive x) =>+  c ->+  BackpropFunc x c+const c = MkBackprop call' forward' backward'+  where+    call' :: x -> c+    call' = P.const c+    forward' :: BackpropFunc x (c, ())+    forward' = const c >>> (iso :: BackpropFunc c (c, ()))+    backward' :: BackpropFunc (c, ()) x+    backward' = (iso :: BackpropFunc (c, ()) c) >>> const zero++-- | Lifts a backprop function morphism to the corresponding pure Kleisli morphism.+pureBackprop :: forall a b m. Monad m => Backprop (->) a b -> Backprop (Kleisli m) a b+pureBackprop+  ( MkBackprop+      (call'' :: a -> b)+      (forward'' :: Backprop (->) a (b, c))+      (backward'' :: Backprop (->) (b, c) a)+    ) =+    MkBackprop call' forward' backward'+    where+      call' :: Kleisli m a b+      call' = Kleisli $ pure . call''++      forward' :: Backprop (Kleisli m) a (b, c)+      forward' = pureBackprop forward''++      backward' :: Backprop (Kleisli m) (b, c) a+      backward' = pureBackprop backward''++instance (Distributive x, Monad m) => StartBackprop (Kleisli m) x where+  startBackprop = pureBackprop startBackprop
+ src/InfBackprop/Tutorial.hs view
@@ -0,0 +1,474 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  InfBackprop.Tutorial+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Tutorial [inf-backprop](https://hackage.haskell.org/package/inf-backprop) package.+module InfBackprop.Tutorial+  ( -- * Quick start+    -- $quick_start++    -- * Derivatives for symbolic expressions+    -- $derivatives_for_symbolic_expressions++    -- * Symbolic expressions visualization+    -- $symbolic_expressions_visualization++    -- * How it works+    -- $how_it_works++    -- * Declaring custom derivative+    -- $declaring_custom_derivative++    -- * Differentiation of monadic function+    -- $differentiation_monadic_types++    -- * Differentiation with logging+    -- $differentiation_with_logging+  )+where++import Control.Arrow (Kleisli, (<<<), (>>>))+import Control.Monad.Logger (MonadLogger)+import Debug.SimpleExpr (SimpleExpr, simplify)+import InfBackprop+  ( Backprop,+    BackpropFunc,+    backward,+    call,+    cos,+    derivative,+    first,+    forward,+    pow,+    pureBackprop,+    second,+    (***),+  )+import Prelude (Maybe (Just, Nothing), Monad)++-- $quick_start+-- >>> :set -XNoImplicitPrelude+-- >>> import Prelude (Float, fmap)+-- >>> import InfBackprop (BackpropFunc, call, derivative, derivativeN, pow)+--+-- We can define differentiable function+--+-- \[+--   f(x) := x^2+-- \]+--+-- as follows+--+-- >>> smoothF = pow 2 :: BackpropFunc Float Float+--+-- where 'pow' is a power differentiable function and+-- 'BackpropFunc'@ :: * -> * -> * @+-- is a type for infinitely differentiable (smooth) functions.+-- We can get the function values by 'call' method like+--+-- >>> f = call smoothF :: Float -> Float+-- >>> fmap f [-3, -2, -1, 0, 1, 2, 3]+-- [9.0,4.0,1.0,0.0,1.0,4.0,9.0]+--+-- as well as the first derivative by 'derivative', which is+--+-- \[+--   f'(x) = 2 \cdot x+-- \]+--+-- >>> df = derivative smoothF :: Float -> Float+-- >>> fmap df [-3, -2, -1, 0, 1, 2, 3]+-- [-6.0,-4.0,-2.0,0.0,2.0,4.0,6.0]+--+-- or the second derivative+--+-- \[+--   f''(x) = 2+-- \]+--+-- >>> d2f = derivativeN 2 smoothF :: Float -> Float+-- >>> fmap d2f [-3, -2, -1, 0, 1, 2, 3]+-- [2.0,2.0,2.0,2.0,2.0,2.0,2.0]+--+-- and so on.+--+-- A composition of two functions like+--+-- \[+--   g(x) := \log x^3+-- \]+--+-- must be defined with the categorical composition '(>>>)' (or '(<<<)')+--+-- >>> import InfBackprop (log)+-- >>> import Control.Category ((>>>), (<<<))+-- >>> smoothG = pow 3 >>> log+--+-- For more complicated expressions, for example,+--+-- \[+--   h(x) := x^2 + x^3+-- \]+--+-- we use arrow notations '(***)', 'first' and 'second' as follows+--+-- >>> import InfBackprop ((+), dup)+-- >>> import Control.CatBifunctor ((***))+--+-- >>> smoothH = dup >>> (pow 2 *** pow 3) >>> (+) :: BackpropFunc Float Float+--+-- where+--+-- @+--   dup :: BackpropFunc a (a, a)+-- @+--+-- is differentiable function that simply splits the single implicit argument @x@ into the tuple '(x, x)'.+-- THis is needed path tje implicit @x@ to two independent functions 'pow' @2@ and 'pow' @3@.+-- The last+--+-- @+--   (+) :: BackpropFunc (a, a) a+-- @+--+-- operation transforms the pair of implicit arguments into their sum.++-- $derivatives_for_symbolic_expressions+--+-- >>> import Prelude (($))+-- >>> import Control.Category ((<<<))+-- >>> import InfBackprop (BackpropFunc, call, derivative, derivativeN, sin, pow, (**), pow, setSecond, const)+--+-- We use+-- [simple-expr](https://hackage.haskell.org/package/simple-expr)+-- package here.+--+-- >>> import Debug.SimpleExpr.Expr (SimpleExpr, variable, simplify)+--+-- For example a symbolic function+--+-- \[+--   f(x) := \sin x^2+-- \]+--+-- can be defined as follows+--+-- >>> x = variable "x"+-- >>> f = sin <<< pow 2 :: BackpropFunc SimpleExpr SimpleExpr+--+-- see 'Debug.SimpleExpr.Tutorial' for details.+-- We can call the symbolic function like+--+-- >>> call f x+-- sin(x·x)+--+-- and find the symbolic derivative+--+-- \[+--   \frac{d}{d x} f(x) = \frac{d}{d x} \sin x^2 = 2\, x \cos x^2+-- \]+--+-- as follows+--+-- >>> simplify $ derivative f x+-- cos(x·x)·(2·x)+--+-- as well as the second and higher derivatives+--+-- >>> simplify $ derivativeN 2 f x+-- (((2·x)·-(sin(x·x)))·(2·x))+(2·cos(x·x))++-- $symbolic_expressions_visualization+-- The+-- [simple-expr](https://hackage.haskell.org/package/simple-expr)+-- package is equipped with a visulaisation tool that can be used to illustrate how the differentiation works.+--+-- >>> import Control.Category ((<<<))+-- >>> import InfBackprop (call, backpropExpr)+-- >>> import Debug.SimpleExpr.Expr (SimpleExpr, variable, simplify)+-- >>> import Debug.SimpleExpr.GraphUtils (exprToGraph)+-- >>> import Data.Graph.VisualizeAlternative (plotDGraph)+--+-- As a warm up consider a trivial composition of two functions+--+-- \[+--   g(f(x))+-- \]+--+-- is defined as+--+-- >>> x = variable "x"+-- >>> call (backpropExpr "g" <<< backpropExpr "f") x+-- g(f(x))+--+-- It can be plotted by+--+-- @ plotExpr $ call (backpropExpr "g" <<< backpropExpr "f") x @+--+-- ![image description](doc/images/composition.png)+--+-- The graph for the first derivative can depicted by+--+-- @ plotExpr $ simplify $ derivative (backpropExpr "g" <<< backpropExpr "f") x @+--+-- ![image description](doc/images/composition_derivative.png)+--+-- where+-- 'simplify'@ :: @'SimpleExpr'@ -> @'SimpleExpr`+-- is a simple removal such things like @*1@ and @+0@.+--+-- As well as the second derivative is straightforward+--+-- @ plotExpr $ simplify $ derivativeN 2 (backpropExpr "g" <<< backpropExpr "f") x @+--+-- ![image description](doc/images/composition_second_derivative.png)++-- $how_it_works+-- The idea would be clear from the example of three functions composition+--+-- \[+--   g(f(h(x)))+-- \]+-- with a focus on function @f@.+--+-- Its first derivative over @x@ is+--+-- \[+--   g(f(h(x))).+-- \]+--+-- \[+--   h'(x) \cdot f'(h(x)) \cdot g'(f(h(x))).+-- \]+--+-- According to the backpropagation strategy, the order of the calculation should be as follows.+--+-- 1. Find @h(x)@.+--+-- 2. Find @f(h(x))@.+--+-- 3. Find @g(f(h(x)))@.+--+-- 4. Find the top derivative @g'(f(h(x)))@.+--+-- 5. Find the next to the top derivative @f'(h(x))@.+--+-- 6. Multiply @g'(f(h(x)))@ on @f'(h(x))@.+--+-- 7. Find the next derivative @h'(x)@.+--+-- 8. Multiply the output of point 6 on @h'(x)@.+--+-- The generalization for longer composition is straightforward.+--+-- All calculations related to the function @f@ can be divided into two parts.+-- We have to find @f@ of @h(x)@ first (forward step) and then the derivative @f'@ of the same argument @h(x)@ and+-- multiply it on the derivative @g'(f(h(x)))@ obtained during the similar calculations for @g@ (backward step).+-- Notice that the value of @h(x)@ is reused on the backward step.+-- To implement this, we define type 'Backprop' (see the corresponding+-- documentation for details).++-- $declaring_custom_derivative+-- >>> import Prelude (Float)+-- >>> import qualified Prelude+-- >>> import Control.Category ((>>>))+-- >>> import InfBackprop ((*), negate, dup, BackpropFunc, Backprop(MkBackprop), second)+--+-- As an illustrative example a differentiable version of 'cos' numerical function can be defined as follows+-- (see the documentation for 'Backprop' for details)+--+-- @+--   cos :: BackpropFunc Float Float+--   cos = MkBackprop call' forward' backward' where+--     call' :: Float -> Float+--     call' = Prelude.cos+--+--     forward' :: BackpropFunc Float (Float, Float)+--     forward' = dup >>> first cos+--+--     backward' :: BackpropFunc (Float, Float) Float+--     backward' = second (sin >>> negate) >>> (*)+--+--   sin :: BackpropFunc Float Float+--   sin = ...+-- @+--+-- Here we use @Prelude@ implementation for ordinary @cos@ function in 'call'.+-- The forward function is differentiable (which is needed for further derivatives) function+-- with two output values.+-- Roughly speaking 'forward' is+-- @x -> (sin x, x)@.+-- The first term of the tuple is just @sin@ and+-- the second terms @x@ in the tuple is the value to be reused on the backward step.+-- The 'backward' is+-- @(dy, x) -> dy * (-cos x)@,+-- where @dy@ is the derivative found on the previous backward step and the second value is @x@ stored by `forward`.+-- We simply multiply with @(*)@ the derivative @dy@ on the derivative of @sin@ that is @-cos@.+--+-- The stored value is not necessary just @x@. It could be anything useful for the backward step, see for example+-- the implementation for @exp@ and the corresponding+-- [example](InfBackprop.Tutorial#differentiation_with_logging)+-- below.++-- $differentiation_monadic_types #differentiation_monadic_types#+-- Differentiable versions of monadic functions @a -> m b@ can also be backpropagated.+-- For example, consider a real-valued power function defined for positive real numbers.+-- For a negative number, it returns 'Nothing', which is a signal to stop computing the derivative and return 'Nothing'+-- in the spirit of the behavior of the monad 'Maybe'.+-- For this purpose, we can use that the type 'Backprop' type is defined for any category,+-- not only for functions @(->)@.+-- In particular, we can try 'Backprop'@(@'Kleisli' 'Maybe'@)@ instead of 'Backprop'@(->)@ from the previous sections.+--+-- >>> import Prelude (Maybe, Maybe(Just, Nothing), ($), Ord, (>), Float)+-- >>> import InfBackprop (Backprop(MkBackprop), derivative, dup, (*), linear, pureBackprop, first, second)+-- >>> import Control.Arrow (Kleisli(Kleisli), runKleisli, (>>>))+-- >>> import qualified NumHask as NH+--+-- The functoin+--+-- @+--  pureBackprop :: Monad m => Backprop (->) a b -> Backprop (Kleisli m) a b+-- @+--+-- is to trivially lift an ordinary backpropagation functions to the monadic function type.+--+-- Define the power function as follows+--+-- >>> :{+--  powR :: forall a. (Ord a, NH.ExpField a) =>+--    a -> Backprop (Kleisli Maybe) a a+--  powR p = MkBackprop call' forward' backward'+--    where+--      call' :: Kleisli Maybe a a+--      call' = Kleisli $ \x -> if x > NH.zero+--        then Just $ x NH.** p+--        else Nothing+--      --+--      forward' :: Backprop (Kleisli Maybe) a (a, a)+--      forward' = pureBackprop dup >>> first (powR p)+--      --+--      backward' :: Backprop (Kleisli Maybe) (a, a) a+--      backward' = second der >>> pureBackprop (*) where+--        der = powR (p NH.- NH.one) >>> pureBackprop (linear p)+-- :}+--+-- and calculate+--+-- \[+--  \frac{d}{dx} x^{\frac12} = \frac{1}{2 \sqrt{x}}+-- \]+--+-- for @x=4@ and @x=-4@ like+--+-- >>> runKleisli (derivative (powR 0.5)) (4 :: Float)+-- Just 0.25+-- >>> runKleisli (derivative (powR 0.5)) (-4 :: Float)+-- Nothing++-- $differentiation_with_logging #differentiation_with_logging#+--+-- Our objective now is to add logging to the derivative calculation.+-- The type 'Backprop' @cat a b@ type is parametrized by a category @cat@, input @a@ and output @b@.+-- If @cat@ is @(->)@ the type is reduced to 'BackpropFunc' we worked with above.+-- To add logging to the calculation we shall replace @(->)@ by+-- 'MonadLogger' @m =>@ 'Kleisli' @m@.+-- We will need the imports below+--+-- >>> import Prelude (Integer, Float, ($), (+), (*))+-- >>> import Control.Monad.Logger (runStdoutLoggingT, MonadLogger)+-- >>> import Control.Arrow ((>>>), runKleisli, Kleisli)+-- >>> import InfBackprop (derivative, loggingBackpropExpr)+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> import Debug.LoggingBackprop (initUnaryFunc, initBinaryFunc, pureKleisli, exp, sin)+--+-- where the module 'Debug.loggingBackpropExpr' contains some useful functionality.+-- For example, lifts for unary functions+--+-- @+--  initUnaryFunc :: (Show a, Show b, MonadLogger m) => String -> (a -> b) -> Kleisli m a b+-- @+--+-- and binary functions+--+-- @+--  initBinaryFunc :: (Show a, Show b, Show c, MonadLogger m) => String -> (a -> b -> c) -> Kleisli m (a, b) c+-- @+--+-- These two terms map given functions to Kleisli category terms, that allows logging during their execution.+--+-- Let us first explain how it works with the following example.+--+-- \[+--  f(x) = y \cdot 3 + y \cdot 4, \quad y = x + 2.+-- \]+--+-- This function can be defined as follows+--+-- >>> :{+--  fLogging :: MonadLogger m => Kleisli m Integer Integer+--  fLogging =+--    initUnaryFunc "+2" (+2) >>>+--    (pureKleisli (\x -> (x, x))) >>>+--    (initUnaryFunc "*3" (*3) *** initUnaryFunc "*4" (*4)) >>>+--    initBinaryFunc "sum" (+)+-- :}+--+-- We run the calculation with @ x = 5 @ as follows+--+-- >>> runStdoutLoggingT $ runKleisli fLogging 5+-- [Info] Calculating +2 of 5 => 7+-- [Info] Calculating *3 of 7 => 21+-- [Info] Calculating *4 of 7 => 28+-- [Info] Calculating sum of 21 and 28 => 49+-- 49+--+-- We are now ready to consider an example with derivatives.+-- Let us calculate a simple example as follows+--+-- \[+--  \frac{d}{dx} \mathrm{f} (e^x) = e^x f'(e^x)+-- \]+--+-- We define symbolic function @f@ by+--+-- @+--  loggingBackpropExpr :: String -> BackpropFunc SimpleExpr SimpleExpr+-- @+--+-- and the entire derivative is+--+-- >>> runStdoutLoggingT $ runKleisli (derivative (exp >>> loggingBackpropExpr "f")) (variable "x")+-- [Info] Calculating exp of x => exp(x)+-- [Info] Calculating f of exp(x) => f(exp(x))+-- [Info] Calculating f' of exp(x) => f'(exp(x))+-- [Info] Calculating multiplication of 1 and f'(exp(x)) => 1·f'(exp(x))+-- [Info] Calculating multiplication of 1·f'(exp(x)) and exp(x) => (1·f'(exp(x)))·exp(x)+-- (1·f'(exp(x)))·exp(x)+--+-- For illustration we can set 'f = sin' and 'x=2'+--+-- \[+--  \left. \frac{d}{dx} \sin (e^x) \right|_{x=2} = e^2 \cos (e^2)+-- \]+--+-- >>> runStdoutLoggingT $ runKleisli (derivative (exp >>> sin)) (2 :: Float)+-- [Info] Calculating exp of 2.0 => 7.389056+-- [Info] Calculating sin of 7.389056 => 0.893855+-- [Info] Calculating cos of 7.389056 => 0.44835615+-- [Info] Calculating multiplication of 1.0 and 0.44835615 => 0.44835615+-- [Info] Calculating multiplication of 0.44835615 and 7.389056 => 3.312929+-- 3.312929+--+-- The first thing to mention in these logs is that the last forward step+-- @sin(exp x)@+-- is still computed, unlike the examples from the previous section.+-- This is due to the monadic nature of the calculation chain, that must disappear as soon as we return to+-- @(->)@ from 'Kleisli' @m@.+--+-- The second thing to mention here is that the exponent+-- @exp x@+-- is calculated only once thanks to the cache term passed from the `forward` to the `backward` method.
+ src/IsomorphismClass/Extra.hs view
@@ -0,0 +1,113 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  IsomorphismClass.Extra+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Extra instances for 'IsomorphicTo' typeclass from 'isomorphism-class' package.+module IsomorphismClass.Extra () where++import Control.Category (id)+import Data.Void (Void, absurd)+import IsomorphismClass (IsomorphicTo, to)+import Prelude (Either (Left, Right), fst, snd)++instance {-# INCOHERENT #-} IsomorphicTo a a where+  to = id++-- Type products++instance {-# INCOHERENT #-} IsomorphicTo a (a, ()) where+  to = fst++instance {-# INCOHERENT #-} IsomorphicTo (a, ()) a where+  to = (,())++instance {-# INCOHERENT #-} IsomorphicTo a ((), a) where+  to = snd++instance {-# INCOHERENT #-} IsomorphicTo ((), a) a where+  to = ((),)++-- | Type product commutativity+--+-- ==== __Examples of usage__+--+-- >>> import IsomorphismClass.Isomorphism (iso)+-- >>> (iso :: (->) (a, b) (b, a)) (1, "x")+-- ("x",1)+instance {-# INCOHERENT #-} IsomorphicTo (a, b) (b, a) where+  to (b, a) = (a, b)++instance {-# INCOHERENT #-} IsomorphicTo (a, (b, c)) ((a, b), c) where+  to ((a, b), c) = (a, (b, c))++instance {-# INCOHERENT #-} IsomorphicTo ((a, b), c) (a, (b, c)) where+  to (a, (b, c)) = ((a, b), c)++instance {-# INCOHERENT #-} IsomorphicTo ((a, b), (c, d)) ((a, c), (b, d)) where+  to ((a, c), (b, d)) = ((a, b), (c, d))++-- instance {-# INCOHERENT #-} IsomorphicTo (a, (b, (c, d))) (a, ((c, d), b)) where+--  to (a, ((c, d), b)) = (a, (b, (c, d)))+--+-- instance {-# INCOHERENT #-} IsomorphicTo (a, ((c, d), b)) (a, (b, (c, d))) where+--  to (a, (b, (c, d))) = (a, ((c, d), b))++-- Type sums++instance {-# INCOHERENT #-} IsomorphicTo a (Either a Void) where+  to (Left a) = a+  to (Right a) = absurd a++instance {-# INCOHERENT #-} IsomorphicTo (Either a Void) a where+  to = Left++-- | Type sum commutativity.+--+-- ==== __Examples of usage__+--+-- >>> import IsomorphismClass.Isomorphism (iso)+-- >>> (iso :: (->) (Either a b) (Either b a)) (Left 1)+-- Right 1+-- >>> (iso :: (->) (Either a b) (Either b a)) (Right "x")+-- Left "x"+instance {-# INCOHERENT #-} IsomorphicTo a (Either Void a) where+  to (Right a) = a+  to (Left a) = absurd a++instance {-# INCOHERENT #-} IsomorphicTo (Either Void a) a where+  to = Right++instance {-# INCOHERENT #-} IsomorphicTo (Either a b) (Either b a) where+  to (Left b) = Right b+  to (Right b) = Left b++instance {-# INCOHERENT #-} IsomorphicTo (Either a (Either b c)) (Either (Either a b) c) where+  to (Left (Left a)) = Left a+  to (Left (Right b)) = Right (Left b)+  to (Right c) = Right (Right c)++instance {-# INCOHERENT #-} IsomorphicTo (Either (Either a b) c) (Either a (Either b c)) where+  to (Left a) = Left (Left a)+  to (Right (Left b)) = Left (Right b)+  to (Right (Right c)) = Right c++instance {-# INCOHERENT #-} IsomorphicTo (Either (Either a b) (Either c d)) (Either (Either a c) (Either b d)) where+  to (Left (Left a)) = Left (Left a)+  to (Left (Right c)) = Right (Left c)+  to (Right (Left b)) = Left (Right b)+  to (Right (Right d)) = Right (Right d)++-- instance {-# INCOHERENT #-} IsomorphicTo (Either a (Either b (Either c d))) (Either a (Either (Either c d) b)) where+--  to (Left a) = Left a+--  to (Right (Left b)) = Right (Right b)+--  to (Right (Right (Left c))) =   Right+--+--+--  to (a, ((c, d), b)) = (a, (b, (c, d)))+--+-- instance {-# INCOHERENT #-} IsomorphicTo (Either a (Either (Either c d) b)) (Either a (Either b (Either c d))) where+--  to (a, (b, (c, d))) = (a, ((c, d), b))
+ src/IsomorphismClass/Isomorphism.hs view
@@ -0,0 +1,79 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  IsomorphismClass.Isomorphism+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Isomorphism class and instances.+module IsomorphismClass.Isomorphism+  ( Isomorphism,+    iso,+  )+where++import Control.Applicative (pure)+import Control.Arrow (Kleisli (Kleisli))+import Control.Category ((.))+import Control.Comonad (Cokleisli (Cokleisli), Comonad, extract)+import Control.Monad (Monad)+import GHC.Base (Type)+import IsomorphismClass (IsomorphicTo, from, to)+import Prelude (($))++-- | A generalization of isomorphism.+-- Type argument @c@ is usually a category.+class Isomorphism (c :: Type -> Type -> Type) where+  -- | Categorical morphism that that is related to an isomorphism map from @a@ to @b@.+  iso :: IsomorphicTo a b => c a b++-- | Trivial instance of 'Isomorphism' that is the map type @(->)@.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Int, fst, Either (Right))+-- >>> import Data.Void (Void)+-- >>> import IsomorphismClass.Extra ()+--+-- >>> (iso :: (->) (a, b) (b, a)) (1, "x")+-- ("x",1)+--+-- >>> (iso :: (->) (a, ()) a) (42, ())+-- 42+--+-- >>> (iso :: (->) (Either Void a) a) (Right 42)+-- 42+instance Isomorphism (->) where+  iso :: IsomorphicTo a b => a -> b+  iso = from++-- | Kleisli (monadic) instance of 'Isomorphism'.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Int, fst, Either (Right))+-- >>> import Data.Void (Void)+-- >>> import Control.Arrow (runKleisli)+-- >>> import IsomorphismClass.Extra ()+--+-- >>> runKleisli (iso :: (Kleisli []) (a, b) (b, a)) (1, "x")+-- [("x",1)]+instance Monad m => Isomorphism (Kleisli m) where+  iso :: IsomorphicTo a b => Kleisli m a b+  iso = Kleisli $ pure . to++-- | Cokleisli (comonadic) instance of 'Isomorphism'.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Int, fst, Either (Right), (+))+-- >>> import Data.Void (Void)+-- >>> import Control.Comonad (Cokleisli(Cokleisli), runCokleisli)+-- >>> import Control.Comonad.Store (store, runStore, Store)+-- >>> import IsomorphismClass.Extra ()+--+-- >>> runCokleisli (iso :: (Cokleisli (Store Int)) (a, b) (b, a)) (store (\x -> (x + 1, x + 2)) 0)+-- (2,1)+instance Comonad w => Isomorphism (Cokleisli w) where+  iso :: IsomorphicTo a b => Cokleisli w a b+  iso = Cokleisli $ to . extract
+ src/NumHask/Extra.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | Module    :  NumHask.Extra+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Additional orphan instances for+-- [mumhusk](https://hackage.haskell.org/package/numhask)+-- typeclasses.+module NumHask.Extra () where++import NumHask (Additive, zero, (+))+import Prelude hiding (Num, (+))++instance {-# INCOHERENT #-} Additive () where+  (+) = const+  zero = ()++instance {-# INCOHERENT #-} (Additive x, Additive y) => Additive (x, y) where+  zero = (zero, zero)+  (a, b) + (c, d) = (a + c, b + d)++instance {-# INCOHERENT #-} (Additive x, Additive y, Additive z) => Additive (x, y, z) where+  zero = (zero, zero, zero)+  (x1, y1, z1) + (x2, y2, z2) = (x1 + x2, y1 + y2, z1 + z2)++instance {-# INCOHERENT #-} (Additive x, Additive y, Additive z, Additive t) => Additive (x, y, z, t) where+  zero = (zero, zero, zero, zero)+  (x1, y1, z1, t1) + (x2, y2, z2, t2) = (x1 + x2, y1 + y2, z1 + z2, t1 + t2)++instance+  {-# INCOHERENT #-}+  (Additive x, Additive y, Additive z, Additive t, Additive s) =>+  Additive (x, y, z, t, s)+  where+  zero = (zero, zero, zero, zero, zero)+  (x1, y1, z1, t1, s1) + (x2, y2, z2, t2, s2) = (x1 + x2, y1 + y2, z1 + z2, t1 + t2, s1 + s2)
+ src/Prelude/InfBackprop.hs view
@@ -0,0 +1,623 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- | Module    :  Prelude.InfBackprop+-- Copyright   :  (C) 2023 Alexey Tochin+-- License     :  BSD3 (see the file LICENSE)+-- Maintainer  :  Alexey Tochin <Alexey.Tochin@gmail.com>+--+-- Backpropagation differentiable versions of basic functions.+module Prelude.InfBackprop+  ( -- * Elementary functions+    linear,+    (+),+    (-),+    negate,+    (*),+    (/),++    -- * Tuple manipulations+    dup,+    setFirst,+    setSecond,+    forget,+    forgetFirst,+    forgetSecond,++    -- * Exponential family functions+    log,+    logBase,+    exp,+    (**),+    pow,++    -- * Trigonometric functions+    cos,+    sin,+    tan,+    asin,+    acos,+    atan,+    atan2,+    sinh,+    cosh,+    tanh,+    asinh,+    acosh,+    atanh,++    -- * Tools+    simpleDifferentiable,+  )+where++import Control.CatBifunctor (first, second, (***))+import Control.Category ((<<<), (>>>))+import InfBackprop.Common (Backprop (MkBackprop), BackpropFunc, const)+import IsomorphismClass.Isomorphism (iso)+import NumHask (Additive, Distributive, Divisive, ExpField, Subtractive, TrigField, fromInteger, zero)+import qualified NumHask as NH+import NumHask.Prelude (one)+import qualified NumHask.Prelude as NHP+import Prelude (flip, uncurry, ($), (==))+import qualified Prelude as P++-- | Returns a differentiable morphism given forward function and backpropagation derivative differential morphism.+--+-- ==== __Examples of usage__+--+-- >>> import qualified NumHask as NH+-- >>> cos = simpleDifferentiable NH.cos (sin >>> negate)+simpleDifferentiable :: forall x. Distributive x => (x -> x) -> BackpropFunc x x -> BackpropFunc x x+simpleDifferentiable f df = MkBackprop call' forward' backward'+  where+    call' :: x -> x+    call' = f++    forward' :: BackpropFunc x (x, x)+    forward' = dup >>> first (simpleDifferentiable f df)++    backward' :: BackpropFunc (x, x) x+    backward' = second df >>> (*)++-- Tuple manipulations++-- | Duplication differentiable operation.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call dup (42.0 :: Float)+-- (42.0,42.0)+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> derivative (dup >>> (*)) x+-- (1·x)+(1·x)+dup ::+  forall x.+  Additive x =>+  BackpropFunc x (x, x)+dup = MkBackprop call' forward' backward'+  where+    call' :: x -> (x, x)+    call' x = (x, x)+    forward' :: BackpropFunc x ((x, x), ())+    forward' = dup >>> (iso :: BackpropFunc y (y, ()))+    backward' :: BackpropFunc ((x, x), ()) x+    backward' = (iso :: BackpropFunc (y, ()) y) >>> (+)++-- | Transforms any function to unit @()@.+-- It is not differentiable until @StartBackprop@ is defined for @()@.+-- However 'forget' is useful if need to remove some data in the differentiable pipeline.+--+-- ==== __Examples of usage__+--+-- >>> import InfBackprop (call, derivative)+--+-- >>> f = first forget >>> (iso :: BackpropFunc ((), a) a) :: Additive a => BackpropFunc (a, a) a+--+-- >>> call f (24, 42)+-- 42+--+-- >>> derivative f (24, 42)+-- (0,1)+forget ::+  forall x.+  Additive x =>+  BackpropFunc x ()+forget = const ()++-- | Remove the first element of a tuple.+--+-- ==== __Examples of usage__+--+-- >>> import InfBackprop (call, derivative)+--+-- >>> call forgetFirst (24, 42)+-- 42+--+-- >>> derivative forgetFirst (24, 42)+-- (0,1)+forgetFirst ::+  forall x y.+  Additive x =>+  BackpropFunc (x, y) y+forgetFirst = iso <<< first forget++-- | Remove the second element of a tuple.+--+-- ==== __Examples of usage__+--+-- >>> import InfBackprop (call, derivative)+--+-- >>> call forgetSecond (24, 42)+-- 24+--+-- >>> derivative forgetSecond (24, 42)+-- (1,0)+forgetSecond ::+  forall x y.+  Additive y =>+  BackpropFunc (x, y) x+forgetSecond = iso <<< second forget++-- | Transforms a 2-argument differentiable function into a single argument function by fixing its first argument.+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call (setFirst 8 (/)) 4 :: Float+-- 2.0+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> y = variable "y"+-- >>> derivative (setFirst x (*)) y+-- 1·x+setFirst ::+  forall x y c.+  Additive c =>+  c ->+  BackpropFunc (c, x) y ->+  BackpropFunc x y+setFirst c f = (iso :: BackpropFunc x ((), x)) >>> first (const c) >>> f++-- | Transforms a 2-argument differentiable function into a single argument function by fixing its second argument.+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call (setSecond 4 (/)) 8 :: Float+-- 2.0+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> y = variable "y"+-- >>> derivative (setSecond y (*)) x+-- 1·y+setSecond ::+  forall x y c.+  Additive c =>+  c ->+  BackpropFunc (x, c) y ->+  BackpropFunc x y+setSecond c f = (iso :: BackpropFunc x (x, ())) >>> second (const c) >>> f++-- Elementary functions++-- | Linear differentiable function.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (fmap, Float)+-- >>> import InfBackprop (pow, call, derivative)+-- >>> myFunc = linear 2 :: BackpropFunc Float Float+--+-- >>> f = call myFunc :: Float -> Float+-- >>> fmap f [-3, -2, -1, 0, 1, 2, 3]+-- [-6.0,-4.0,-2.0,0.0,2.0,4.0,6.0]+--+-- >>> df = derivative myFunc :: Float -> Float+-- >>> fmap df [-3, -2, -1, 0, 1, 2, 3]+-- [2.0,2.0,2.0,2.0,2.0,2.0,2.0]+linear ::+  forall x.+  NH.Distributive x =>+  x ->+  BackpropFunc x x+linear c = MkBackprop call' forward' backward'+  where+    call' :: x -> x+    call' = f c+      where+        f = (NH.*)+    forward' :: BackpropFunc x (x, ())+    forward' = linear c >>> (iso :: BackpropFunc y (y, ()))+    backward' :: BackpropFunc (x, ()) x+    backward' = (iso :: BackpropFunc (x, ()) x) >>> linear c++-- | Summation differentiable binary operation.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+--+-- >>> call (+) (2, 3) :: Float+-- 5.0+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> y = variable "y"+-- >>> derivative (+) (x, y)+-- (1,1)+(+) ::+  forall x.+  Additive x =>+  BackpropFunc (x, x) x+(+) = MkBackprop call' forward' backward'+  where+    call' :: (x, x) -> x+    call' = uncurry (NH.+)+    forward' :: BackpropFunc (x, x) (x, ())+    forward' = (+) >>> (iso :: BackpropFunc y (y, ()))+    backward' :: BackpropFunc (x, ()) (x, x)+    backward' = (iso :: BackpropFunc (x, ()) x) >>> dup++-- | Negate differentiable function.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float, ($))+-- >>> import InfBackprop (call, derivative)+--+-- >>> call negate 42 :: Float+-- -42.0+--+-- >>> derivative negate 42 :: Float+-- -1.0+negate ::+  forall x.+  Subtractive x =>+  BackpropFunc x x+negate = MkBackprop call' forward' backward'+  where+    call' :: x -> x+    call' = NH.negate+    forward' :: BackpropFunc x (x, ())+    forward' = negate >>> (iso :: BackpropFunc y (y, ()))+    backward' :: BackpropFunc (x, ()) x+    backward' = (iso :: BackpropFunc (y, ()) y) >>> negate++-- | Subtraction differentiable binary operation.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+--+-- >>> call (-) (5, 3) :: Float+-- 2.0+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> y = variable "y"+-- >>> derivative (-) (x, y)+-- (1,-(1))+(-) :: forall x. (Subtractive x) => BackpropFunc (x, x) x+(-) = MkBackprop call' forward' backward'+  where+    call' :: (x, x) -> x+    call' = uncurry (NH.-)+    forward' :: BackpropFunc (x, x) (x, ())+    forward' = (-) >>> (iso :: BackpropFunc y (y, ()))+    backward' :: BackpropFunc (x, ()) (x, x)+    backward' = (iso :: BackpropFunc (x, ()) x) >>> dup >>> second negate++-- | Product binnary operation+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call (*) (2, 3) :: Float+-- 6.0+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> y = variable "y"+-- >>> derivative (*) (x, y)+-- (1·y,1·x)+(*) :: Distributive x => BackpropFunc (x, x) x+(*) = MkBackprop call' forward' backward'+  where+    call' :: Distributive x => (x, x) -> x+    call' = uncurry (NH.*)+    forward' :: Distributive x => BackpropFunc (x, x) (x, (x, x))+    forward' = dup >>> first (*)+    backward' :: Distributive x => BackpropFunc (x, (x, x)) (x, x)+    backward' =+      first dup+        >>> (iso :: BackpropFunc ((dy, dy), (x1, x2)) ((dy, x1), (dy, x2)))+        >>> (iso :: BackpropFunc (a, b) (b, a))+        >>> (*) *** (*)++-- | Square differentiable operation+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call square 3 :: Float+-- 9.0+--+-- >>> derivative square 3 :: Float+-- 6.0+square :: Distributive x => BackpropFunc x x+square = dup >>> (*)++-- | Division binary differentiable operation+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call (/) (6, 3) :: Float+-- 2.0+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> y = variable "y"+-- >>> derivative (/) (x, y)+-- (1·(1/y),1·(-(x)·(1/(y·y))))+(/) ::+  forall x.+  (Divisive x, Distributive x, Subtractive x) =>+  BackpropFunc (x, x) x+(/) = MkBackprop call' forward' backward'+  where+    call' :: (x, x) -> x+    call' = uncurry (NH./)+    forward' :: BackpropFunc (x, x) (x, (x, x))+    forward' = dup >>> first (/)+    backward' :: BackpropFunc (x, (x, x)) (x, x)+    backward' =+      dup *** dup+        >>> second (d1 *** d2) -- ((dy, dy), ((x1, x2), (x1, x2)))+        >>> (iso :: BackpropFunc ((dy, dy), (x1, x2)) ((dy, x1), (dy, x2))) -- ((dy, dy), (1 / x2, - x1 * x2^(-2) ))+        >>> (*) *** (*)+      where+        d1 = (forget *** recip) >>> (iso :: BackpropFunc ((), x) x) -- (x1, x2) -> 1 / x2+        d2 = (negate *** (square >>> recip)) >>> (*) -- (x1, x2) -> - x1 * x2^(-2)++-- | The recip differentiable operation+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call recip 2 :: Float+-- 0.5+--+-- >>> derivative recip 2 :: Float+-- -0.25+recip ::+  forall x.+  (Divisive x, Distributive x, Subtractive x) =>+  BackpropFunc x x+recip = setFirst NH.one (/)++-- | Integer power differentiable operation+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call (pow 3) 2 :: Float+-- 8.0+--+-- >>> derivative (pow 3) 2 :: Float+-- 12.0+pow ::+  forall x.+  ( Divisive x,+    Distributive x,+    Subtractive x,+    NH.FromIntegral x NHP.Integer+  ) =>+  NHP.Integer ->+  BackpropFunc x x+pow n = MkBackprop call' forward' backward'+  where+    call' :: x -> x+    call' = flip (NH.^) (fromInteger n)+    forward' :: BackpropFunc x (x, x)+    forward' = dup >>> first (pow n :: BackpropFunc x x)+    backward' :: BackpropFunc (x, x) x+    backward' = second der >>> (*)+      where+        der =+          if n == 0+            then const zero+            else pow (n P.- 1) >>> linear (NH.fromIntegral n)++-- | Square root differentiable function.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call sqrt 16 :: Float+-- 4.0+--+-- >>> derivative sqrt 16 :: Float+-- 0.125+sqrt ::+  forall x.+  ExpField x =>+  BackpropFunc x x+sqrt = MkBackprop call' forward' backward'+  where+    call' :: x -> x+    call' = NH.sqrt+    forward' :: BackpropFunc x (x, x)+    forward' = (sqrt :: BackpropFunc x x) >>> dup+    backward' :: BackpropFunc (x, x) x+    backward' = second (recip >>> linear NH.half) >>> (*)++-- | Power binary differentiable operation.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import NumHask (half)+-- >>> import InfBackprop (call, derivative)+-- >>> call (**) (0.5, 9) :: Float+-- 3.0+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> n = variable "n"+-- >>> derivative (**) (n, x)+-- (1·(n·(x^(n-1))),1·((x^n)·log(x)))+(**) ::+  forall a.+  ( ExpField a,+    NH.FromIntegral a P.Integer+  ) =>+  BackpropFunc (a, a) a+(**) = MkBackprop call' forward' backward'+  where+    call' :: (a, a) -> a+    call' = uncurry $ flip (NH.**)+    forward' :: BackpropFunc (a, a) (a, (a, (a, a)))+    forward' =+      dup -- ((n, x), (n, x))+        >>> first ((**) >>> dup) -- ((x^n, x^n), (n, x))+        >>> (iso :: BackpropFunc ((a, b), c) (a, (b, c))) -- (x^n, (x^n, (n, x)))+    backward' :: BackpropFunc (a, (a, (a, a))) (a, a)+    backward' =+      dup *** (dup >>> (dn *** dx)) -- ((dy, dy), (dn, dx))+        >>> (iso :: BackpropFunc ((a, b), (c, d)) ((a, c), (b, d))) -- ((dy, dn), (dy, dx))+        >>> (*) *** (*)+      where+        -- (x^n, (n, x)) -> n * x^(n-1)+        dn :: BackpropFunc (a, (a, a)) a+        dn =+          forgetFirst -- (n, x)+            >>> first dup -- ((n, n), x)+            >>> (iso :: BackpropFunc ((a, b), c) (a, (b, c))) -- (n, (n, x))+            >>> second (first (setSecond (NH.fromIntegral (1 :: P.Integer)) (-))) -- (n, (n-1, x))+            >>> second (**) -- (n, x^(n-1))+            >>> (*) -- (n * x^(n-1))+            -- (x^n, (n, x)) -> log x * x^n+        dx :: BackpropFunc (a, (a, a)) a+        dx = second forgetFirst >>> second log >>> (*)++-- | Natural logarithm differentiable function.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call log 10 :: Float+-- 2.3025851+--+-- >>> derivative log 10 :: Float+-- 0.1+log :: ExpField x => BackpropFunc x x+log = simpleDifferentiable NH.log recip++-- | Natural logarithm differentiable function.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call logBase (2, 8) :: Float+-- 3.0+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> n = variable "n"+-- >>> derivative logBase (n, x)+-- ((1·(-(log(x))·(1/(log(n)·log(n)))))·(1/n),(1·(1/log(n)))·(1/x))+logBase :: ExpField a => BackpropFunc (a, a) a+logBase = (iso :: BackpropFunc (c, d) (d, c)) >>> log *** log >>> (/)++-- | Natural logarithm differentiable function.+--+-- ==== __Examples of usage__+--+-- >>> import Prelude (Float)+-- >>> import InfBackprop (call, derivative)+-- >>> call exp 2+-- 7.38905609893065+--+-- >>> import Debug.SimpleExpr.Expr (variable)+-- >>> x = variable "x"+-- >>> derivative exp x+-- 1·exp(x)+exp :: forall x. ExpField x => BackpropFunc x x+exp = MkBackprop call' forward' backward'+  where+    call' :: x -> x+    call' = NH.exp+    forward' :: BackpropFunc x (x, x)+    forward' = (exp :: BackpropFunc x x) >>> dup+    backward' :: BackpropFunc (x, x) x+    backward' = (*)++-- Trigonometric++-- | Sine differentiable function+sin :: TrigField x => BackpropFunc x x+sin = simpleDifferentiable NH.sin cos++-- | Cosine differentiable function.+cos :: TrigField x => BackpropFunc x x+cos = simpleDifferentiable NH.cos (sin >>> negate)++-- | Tangent differentiable function.+tan :: TrigField x => BackpropFunc x x+tan = simpleDifferentiable NH.tan (cos >>> square >>> recip)++-- | Arcsine differentiable function.+asin :: (TrigField x, ExpField x) => BackpropFunc x x+asin = simpleDifferentiable NH.tan (square >>> setFirst one (-) >>> sqrt >>> recip)++-- | Arccosine differentiable function.+acos :: (TrigField x, ExpField x) => BackpropFunc x x+acos = simpleDifferentiable NH.tan (square >>> setFirst one (-) >>> sqrt >>> recip >>> negate)++-- | Arctangent differentiable function.+atan :: TrigField x => BackpropFunc x x+atan = simpleDifferentiable NH.atan (square >>> setFirst one (+) >>> recip)++-- | 2-argument arctangent differentiable function.+atan2 :: TrigField a => BackpropFunc (a, a) a+atan2 = (/) >>> atan++-- | Hyperbolic sine differentiable function.+sinh :: TrigField x => BackpropFunc x x+sinh = simpleDifferentiable NH.sinh cosh++-- | Hyperbolic cosine differentiable function.+cosh :: TrigField x => BackpropFunc x x+cosh = simpleDifferentiable NH.cosh sinh++-- | Hyperbolic tanget differentiable function.+tanh :: TrigField x => BackpropFunc x x+tanh = simpleDifferentiable NH.tanh (cosh >>> square >>> recip)++-- | Hyperbolic arcsine differentiable function.+asinh :: (TrigField x, ExpField x) => BackpropFunc x x+asinh = simpleDifferentiable NH.asinh (square >>> setFirst one (+) >>> sqrt >>> recip)++-- | Hyperbolic arccosine differentiable function.+acosh :: (TrigField x, ExpField x) => BackpropFunc x x+acosh = simpleDifferentiable NH.tan (square >>> setSecond one (-) >>> sqrt >>> recip)++-- | Hyperbolic arctangent differentiable function.+atanh :: TrigField x => BackpropFunc x x+atanh = simpleDifferentiable NH.tan (square >>> setFirst one (-) >>> recip)