{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
---- |
---- Copyright   :  (c) Edward Kmett 2010-2021
---- License     :  BSD3
---- Maintainer  :  ekmett@gmail.com
---- Stability   :  experimental
---- Portability :  GHC only
----
---- Unsafe and often partial combinators intended for internal usage.
----
---- Handle with care.
-------------------------------------------------------------------------------

module Numeric.AD.Internal.Forward.Double
  ( ForwardDouble(..)
  , bundle
  , unbundle
  , apply
  , bind
  , bind'
  , bindWith
  , bindWith'
  , transposeWith
  ) where

import Data.Foldable (toList)
import Data.Traversable (mapAccumL)
import Control.Monad (join)
import Data.Number.Erf
import Numeric
import Numeric.AD.Internal.Combinators
import Numeric.AD.Internal.Identity
import Numeric.AD.Jacobian
import Numeric.AD.Mode

data ForwardDouble = ForwardDouble { ForwardDouble -> Double
primal, ForwardDouble -> Double
tangent :: {-# UNPACK #-} !Double }
  deriving (ReadPrec [ForwardDouble]
ReadPrec ForwardDouble
Int -> ReadS ForwardDouble
ReadS [ForwardDouble]
(Int -> ReadS ForwardDouble)
-> ReadS [ForwardDouble]
-> ReadPrec ForwardDouble
-> ReadPrec [ForwardDouble]
-> Read ForwardDouble
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ForwardDouble
readsPrec :: Int -> ReadS ForwardDouble
$creadList :: ReadS [ForwardDouble]
readList :: ReadS [ForwardDouble]
$creadPrec :: ReadPrec ForwardDouble
readPrec :: ReadPrec ForwardDouble
$creadListPrec :: ReadPrec [ForwardDouble]
readListPrec :: ReadPrec [ForwardDouble]
Read, Int -> ForwardDouble -> ShowS
[ForwardDouble] -> ShowS
ForwardDouble -> String
(Int -> ForwardDouble -> ShowS)
-> (ForwardDouble -> String)
-> ([ForwardDouble] -> ShowS)
-> Show ForwardDouble
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForwardDouble -> ShowS
showsPrec :: Int -> ForwardDouble -> ShowS
$cshow :: ForwardDouble -> String
show :: ForwardDouble -> String
$cshowList :: [ForwardDouble] -> ShowS
showList :: [ForwardDouble] -> ShowS
Show)

unbundle :: ForwardDouble -> (Double, Double)
unbundle :: ForwardDouble -> (Double, Double)
unbundle (ForwardDouble Double
a Double
da) = (Double
a, Double
da)
{-# INLINE unbundle #-}

bundle :: Double -> Double -> ForwardDouble
bundle :: Double -> Double -> ForwardDouble
bundle = Double -> Double -> ForwardDouble
ForwardDouble
{-# INLINE bundle #-}

apply :: (ForwardDouble -> b) -> Double -> b
apply :: forall b. (ForwardDouble -> b) -> Double -> b
apply ForwardDouble -> b
f Double
a = ForwardDouble -> b
f (Double -> Double -> ForwardDouble
bundle Double
a Double
1)
{-# INLINE apply #-}

instance Mode ForwardDouble where
  type Scalar ForwardDouble = Double

  auto :: Scalar ForwardDouble -> ForwardDouble
auto = (Double -> Double -> ForwardDouble)
-> Double -> Double -> ForwardDouble
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double -> Double -> ForwardDouble
ForwardDouble Double
0

  zero :: ForwardDouble
zero = Double -> Double -> ForwardDouble
ForwardDouble Double
0 Double
0

  isKnownZero :: ForwardDouble -> Bool
isKnownZero (ForwardDouble Double
0 Double
0) = Bool
True
  isKnownZero ForwardDouble
_ = Bool
False

  asKnownConstant :: ForwardDouble -> Maybe (Scalar ForwardDouble)
asKnownConstant (ForwardDouble Double
x Double
0) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x
  asKnownConstant ForwardDouble
_ = Maybe Double
Maybe (Scalar ForwardDouble)
forall a. Maybe a
Nothing
 
  isKnownConstant :: ForwardDouble -> Bool
isKnownConstant (ForwardDouble Double
_ Double
0) = Bool
True
  isKnownConstant ForwardDouble
_ = Bool
False

  Scalar ForwardDouble
a *^ :: Scalar ForwardDouble -> ForwardDouble -> ForwardDouble
*^ ForwardDouble Double
b Double
db = Double -> Double -> ForwardDouble
ForwardDouble (Double
Scalar ForwardDouble
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b) (Double
Scalar ForwardDouble
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
db)
  ForwardDouble Double
a Double
da ^* :: ForwardDouble -> Scalar ForwardDouble -> ForwardDouble
^* Scalar ForwardDouble
b = Double -> Double -> ForwardDouble
ForwardDouble (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
Scalar ForwardDouble
b) (Double
da Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
Scalar ForwardDouble
b)
  ForwardDouble Double
a Double
da ^/ :: Fractional (Scalar ForwardDouble) =>
ForwardDouble -> Scalar ForwardDouble -> ForwardDouble
^/ Scalar ForwardDouble
b = Double -> Double -> ForwardDouble
ForwardDouble (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
Scalar ForwardDouble
b) (Double
da Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
Scalar ForwardDouble
b)

(<+>) :: ForwardDouble -> ForwardDouble -> ForwardDouble
ForwardDouble Double
a Double
da <+> :: ForwardDouble -> ForwardDouble -> ForwardDouble
<+> ForwardDouble Double
b Double
db = Double -> Double -> ForwardDouble
ForwardDouble (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b) (Double
da Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
db)

instance Jacobian ForwardDouble where
  type D ForwardDouble = Id Double

  unary :: (Scalar ForwardDouble -> Scalar ForwardDouble)
-> D ForwardDouble -> ForwardDouble -> ForwardDouble
unary Scalar ForwardDouble -> Scalar ForwardDouble
f (Id Double
dadb) (ForwardDouble Double
b Double
db) = Double -> Double -> ForwardDouble
ForwardDouble (Scalar ForwardDouble -> Scalar ForwardDouble
f Double
Scalar ForwardDouble
b) (Double
dadb Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
db)

  lift1 :: (Scalar ForwardDouble -> Scalar ForwardDouble)
-> (D ForwardDouble -> D ForwardDouble)
-> ForwardDouble
-> ForwardDouble
lift1 Scalar ForwardDouble -> Scalar ForwardDouble
f D ForwardDouble -> D ForwardDouble
df (ForwardDouble Double
b Double
db) = Double -> Double -> ForwardDouble
ForwardDouble (Scalar ForwardDouble -> Scalar ForwardDouble
f Double
Scalar ForwardDouble
b) (Double
dadb Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
db) where
    Id Double
dadb = D ForwardDouble -> D ForwardDouble
df (Double -> Id Double
forall a. a -> Id a
Id Double
b)

  lift1_ :: (Scalar ForwardDouble -> Scalar ForwardDouble)
-> (D ForwardDouble -> D ForwardDouble -> D ForwardDouble)
-> ForwardDouble
-> ForwardDouble
lift1_ Scalar ForwardDouble -> Scalar ForwardDouble
f D ForwardDouble -> D ForwardDouble -> D ForwardDouble
df (ForwardDouble Double
b Double
db) = Double -> Double -> ForwardDouble
ForwardDouble Double
Scalar ForwardDouble
a Double
da where
    a :: Scalar ForwardDouble
a = Scalar ForwardDouble -> Scalar ForwardDouble
f Double
Scalar ForwardDouble
b
    Id Double
da = D ForwardDouble -> D ForwardDouble -> D ForwardDouble
df (Double -> Id Double
forall a. a -> Id a
Id Double
Scalar ForwardDouble
a) (Double -> Id Double
forall a. a -> Id a
Id Double
b) Id Double -> Scalar (Id Double) -> Id Double
forall t. Mode t => t -> Scalar t -> t
^* Double
Scalar (Id Double)
db

  binary :: (Scalar ForwardDouble
 -> Scalar ForwardDouble -> Scalar ForwardDouble)
-> D ForwardDouble
-> D ForwardDouble
-> ForwardDouble
-> ForwardDouble
-> ForwardDouble
binary Scalar ForwardDouble
-> Scalar ForwardDouble -> Scalar ForwardDouble
f (Id Double
dadb) (Id Double
dadc) (ForwardDouble Double
b Double
db) (ForwardDouble Double
c Double
dc) = Double -> Double -> ForwardDouble
ForwardDouble (Scalar ForwardDouble
-> Scalar ForwardDouble -> Scalar ForwardDouble
f Double
Scalar ForwardDouble
b Double
Scalar ForwardDouble
c) (Double -> ForwardDouble) -> Double -> ForwardDouble
forall a b. (a -> b) -> a -> b
$ Double
dadb Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
db Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dc Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dadc

  lift2 :: (Scalar ForwardDouble
 -> Scalar ForwardDouble -> Scalar ForwardDouble)
-> (D ForwardDouble
    -> D ForwardDouble -> (D ForwardDouble, D ForwardDouble))
-> ForwardDouble
-> ForwardDouble
-> ForwardDouble
lift2 Scalar ForwardDouble
-> Scalar ForwardDouble -> Scalar ForwardDouble
f D ForwardDouble
-> D ForwardDouble -> (D ForwardDouble, D ForwardDouble)
df (ForwardDouble Double
b Double
db) (ForwardDouble Double
c Double
dc) = Double -> Double -> ForwardDouble
ForwardDouble Double
Scalar ForwardDouble
a Double
da where
    a :: Scalar ForwardDouble
a = Scalar ForwardDouble
-> Scalar ForwardDouble -> Scalar ForwardDouble
f Double
Scalar ForwardDouble
b Double
Scalar ForwardDouble
c
    (Id Double
dadb, Id Double
dadc) = D ForwardDouble
-> D ForwardDouble -> (D ForwardDouble, D ForwardDouble)
df (Double -> Id Double
forall a. a -> Id a
Id Double
b) (Double -> Id Double
forall a. a -> Id a
Id Double
c)
    da :: Double
da = Double
dadb Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
db Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dc Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dadc

  lift2_ :: (Scalar ForwardDouble
 -> Scalar ForwardDouble -> Scalar ForwardDouble)
-> (D ForwardDouble
    -> D ForwardDouble
    -> D ForwardDouble
    -> (D ForwardDouble, D ForwardDouble))
-> ForwardDouble
-> ForwardDouble
-> ForwardDouble
lift2_ Scalar ForwardDouble
-> Scalar ForwardDouble -> Scalar ForwardDouble
f D ForwardDouble
-> D ForwardDouble
-> D ForwardDouble
-> (D ForwardDouble, D ForwardDouble)
df (ForwardDouble Double
b Double
db) (ForwardDouble Double
c Double
dc) = Double -> Double -> ForwardDouble
ForwardDouble Double
Scalar ForwardDouble
a Double
da where
    a :: Scalar ForwardDouble
a = Scalar ForwardDouble
-> Scalar ForwardDouble -> Scalar ForwardDouble
f Double
Scalar ForwardDouble
b Double
Scalar ForwardDouble
c
    (Id Double
dadb, Id Double
dadc) = D ForwardDouble
-> D ForwardDouble
-> D ForwardDouble
-> (D ForwardDouble, D ForwardDouble)
df (Double -> Id Double
forall a. a -> Id a
Id Double
Scalar ForwardDouble
a) (Double -> Id Double
forall a. a -> Id a
Id Double
b) (Double -> Id Double
forall a. a -> Id a
Id Double
c)
    da :: Double
da = Double
dadb Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
db Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dc Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dadc

#define HEAD ForwardDouble
#define BODY1(x)
#define BODY2(x,y)
#define NO_Bounded
#include "instances.h"

bind :: Traversable f => (f ForwardDouble -> b) -> f Double -> f b
bind :: forall (f :: * -> *) b.
Traversable f =>
(f ForwardDouble -> b) -> f Double -> f b
bind f ForwardDouble -> b
f f Double
as = (Int, f b) -> f b
forall a b. (a, b) -> b
snd ((Int, f b) -> f b) -> (Int, f b) -> f b
forall a b. (a -> b) -> a -> b
$ (Int -> Double -> (Int, b)) -> Int -> f Double -> (Int, f b)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Int -> Double -> (Int, b)
outer (Int
0 :: Int) f Double
as where
  outer :: Int -> Double -> (Int, b)
outer !Int
i Double
_ = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, f ForwardDouble -> b
f (f ForwardDouble -> b) -> f ForwardDouble -> b
forall a b. (a -> b) -> a -> b
$ (Int, f ForwardDouble) -> f ForwardDouble
forall a b. (a, b) -> b
snd ((Int, f ForwardDouble) -> f ForwardDouble)
-> (Int, f ForwardDouble) -> f ForwardDouble
forall a b. (a -> b) -> a -> b
$ (Int -> Double -> (Int, ForwardDouble))
-> Int -> f Double -> (Int, f ForwardDouble)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int -> Int -> Double -> (Int, ForwardDouble)
forall {a}. (Num a, Eq a) => a -> a -> Double -> (a, ForwardDouble)
inner Int
i) Int
0 f Double
as)
  inner :: a -> a -> Double -> (a, ForwardDouble)
inner !a
i !a
j Double
a = (a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j then Double -> Double -> ForwardDouble
bundle Double
a Double
1 else Scalar ForwardDouble -> ForwardDouble
forall t. Mode t => Scalar t -> t
auto Double
Scalar ForwardDouble
a)

bind' :: Traversable f => (f ForwardDouble -> b) -> f Double -> (b, f b)
bind' :: forall (f :: * -> *) b.
Traversable f =>
(f ForwardDouble -> b) -> f Double -> (b, f b)
bind' f ForwardDouble -> b
f f Double
as = ((Int, b), f b) -> (b, f b)
forall {a} {a} {b}. ((a, a), b) -> (a, b)
dropIx (((Int, b), f b) -> (b, f b)) -> ((Int, b), f b) -> (b, f b)
forall a b. (a -> b) -> a -> b
$ ((Int, b) -> Double -> ((Int, b), b))
-> (Int, b) -> f Double -> ((Int, b), f b)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int, b) -> Double -> ((Int, b), b)
outer (Int
0 :: Int, b
b0) f Double
as where
  outer :: (Int, b) -> Double -> ((Int, b), b)
outer (!Int
i, b
_) Double
_ = let b :: b
b = f ForwardDouble -> b
f (f ForwardDouble -> b) -> f ForwardDouble -> b
forall a b. (a -> b) -> a -> b
$ (Int, f ForwardDouble) -> f ForwardDouble
forall a b. (a, b) -> b
snd ((Int, f ForwardDouble) -> f ForwardDouble)
-> (Int, f ForwardDouble) -> f ForwardDouble
forall a b. (a -> b) -> a -> b
$ (Int -> Double -> (Int, ForwardDouble))
-> Int -> f Double -> (Int, f ForwardDouble)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int -> Int -> Double -> (Int, ForwardDouble)
forall {a}. (Num a, Eq a) => a -> a -> Double -> (a, ForwardDouble)
inner Int
i) (Int
0 :: Int) f Double
as in ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, b
b), b
b)
  inner :: a -> a -> Double -> (a, ForwardDouble)
inner !a
i !a
j Double
a = (a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j then Double -> Double -> ForwardDouble
bundle Double
a Double
1 else Scalar ForwardDouble -> ForwardDouble
forall t. Mode t => Scalar t -> t
auto Double
Scalar ForwardDouble
a)
  b0 :: b
b0 = f ForwardDouble -> b
f (Double -> ForwardDouble
Scalar ForwardDouble -> ForwardDouble
forall t. Mode t => Scalar t -> t
auto (Double -> ForwardDouble) -> f Double -> f ForwardDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
as)
  dropIx :: ((a, a), b) -> (a, b)
dropIx ((a
_,a
b),b
bs) = (a
b,b
bs)

bindWith :: Traversable f => (Double -> b -> c) -> (f ForwardDouble -> b) -> f Double -> f c
bindWith :: forall (f :: * -> *) b c.
Traversable f =>
(Double -> b -> c) -> (f ForwardDouble -> b) -> f Double -> f c
bindWith Double -> b -> c
g f ForwardDouble -> b
f f Double
as = (Int, f c) -> f c
forall a b. (a, b) -> b
snd ((Int, f c) -> f c) -> (Int, f c) -> f c
forall a b. (a -> b) -> a -> b
$ (Int -> Double -> (Int, c)) -> Int -> f Double -> (Int, f c)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Int -> Double -> (Int, c)
outer (Int
0 :: Int) f Double
as where
  outer :: Int -> Double -> (Int, c)
outer !Int
i Double
a = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Double -> b -> c
g Double
a (b -> c) -> b -> c
forall a b. (a -> b) -> a -> b
$ f ForwardDouble -> b
f (f ForwardDouble -> b) -> f ForwardDouble -> b
forall a b. (a -> b) -> a -> b
$ (Int, f ForwardDouble) -> f ForwardDouble
forall a b. (a, b) -> b
snd ((Int, f ForwardDouble) -> f ForwardDouble)
-> (Int, f ForwardDouble) -> f ForwardDouble
forall a b. (a -> b) -> a -> b
$ (Int -> Double -> (Int, ForwardDouble))
-> Int -> f Double -> (Int, f ForwardDouble)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int -> Int -> Double -> (Int, ForwardDouble)
forall {a}. (Num a, Eq a) => a -> a -> Double -> (a, ForwardDouble)
inner Int
i) Int
0 f Double
as)
  inner :: a -> a -> Double -> (a, ForwardDouble)
inner !a
i !a
j Double
a = (a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j then Double -> Double -> ForwardDouble
bundle Double
a Double
1 else Scalar ForwardDouble -> ForwardDouble
forall t. Mode t => Scalar t -> t
auto Double
Scalar ForwardDouble
a)

bindWith' :: Traversable f => (Double -> b -> c) -> (f ForwardDouble -> b) -> f Double -> (b, f c)
bindWith' :: forall (f :: * -> *) b c.
Traversable f =>
(Double -> b -> c)
-> (f ForwardDouble -> b) -> f Double -> (b, f c)
bindWith' Double -> b -> c
g f ForwardDouble -> b
f f Double
as = ((Int, b), f c) -> (b, f c)
forall {a} {a} {b}. ((a, a), b) -> (a, b)
dropIx (((Int, b), f c) -> (b, f c)) -> ((Int, b), f c) -> (b, f c)
forall a b. (a -> b) -> a -> b
$ ((Int, b) -> Double -> ((Int, b), c))
-> (Int, b) -> f Double -> ((Int, b), f c)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int, b) -> Double -> ((Int, b), c)
outer (Int
0 :: Int, b
b0) f Double
as where
  outer :: (Int, b) -> Double -> ((Int, b), c)
outer (!Int
i, b
_) Double
a = let b :: b
b = f ForwardDouble -> b
f (f ForwardDouble -> b) -> f ForwardDouble -> b
forall a b. (a -> b) -> a -> b
$ (Int, f ForwardDouble) -> f ForwardDouble
forall a b. (a, b) -> b
snd ((Int, f ForwardDouble) -> f ForwardDouble)
-> (Int, f ForwardDouble) -> f ForwardDouble
forall a b. (a -> b) -> a -> b
$ (Int -> Double -> (Int, ForwardDouble))
-> Int -> f Double -> (Int, f ForwardDouble)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int -> Int -> Double -> (Int, ForwardDouble)
forall {a}. (Num a, Eq a) => a -> a -> Double -> (a, ForwardDouble)
inner Int
i) (Int
0 :: Int) f Double
as in ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, b
b), Double -> b -> c
g Double
a b
b)
  inner :: a -> a -> Double -> (a, ForwardDouble)
inner !a
i !a
j Double
a = (a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j then Double -> Double -> ForwardDouble
bundle Double
a Double
1 else Scalar ForwardDouble -> ForwardDouble
forall t. Mode t => Scalar t -> t
auto Double
Scalar ForwardDouble
a)
  b0 :: b
b0 = f ForwardDouble -> b
f (Double -> ForwardDouble
Scalar ForwardDouble -> ForwardDouble
forall t. Mode t => Scalar t -> t
auto (Double -> ForwardDouble) -> f Double -> f ForwardDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
as)
  dropIx :: ((a, a), b) -> (a, b)
dropIx ((a
_,a
b),b
bs) = (a
b,b
bs)

transposeWith :: (Functor f, Foldable f, Traversable g) => (b -> f a -> c) -> f (g a) -> g b -> g c
transposeWith :: forall (f :: * -> *) (g :: * -> *) b a c.
(Functor f, Foldable f, Traversable g) =>
(b -> f a -> c) -> f (g a) -> g b -> g c
transposeWith b -> f a -> c
f f (g a)
as = (f [a], g c) -> g c
forall a b. (a, b) -> b
snd ((f [a], g c) -> g c) -> (g b -> (f [a], g c)) -> g b -> g c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f [a] -> b -> (f [a], c)) -> f [a] -> g b -> (f [a], g c)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL f [a] -> b -> (f [a], c)
go f [a]
xss0 where
  go :: f [a] -> b -> (f [a], c)
go f [a]
xss b
b = ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
xss, b -> f a -> c
f b
b ([a] -> a
forall a. HasCallStack => [a] -> a
head ([a] -> a) -> f [a] -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
xss))
  xss0 :: f [a]
xss0 = g a -> [a]
forall a. g a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (g a -> [a]) -> f (g a) -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g a)
as

mul :: ForwardDouble -> ForwardDouble -> ForwardDouble
mul :: ForwardDouble -> ForwardDouble -> ForwardDouble
mul = (Scalar ForwardDouble
 -> Scalar ForwardDouble -> Scalar ForwardDouble)
-> (D ForwardDouble
    -> D ForwardDouble -> (D ForwardDouble, D ForwardDouble))
-> ForwardDouble
-> ForwardDouble
-> ForwardDouble
forall t.
Jacobian t =>
(Scalar t -> Scalar t -> Scalar t)
-> (D t -> D t -> (D t, D t)) -> t -> t -> t
lift2 Double -> Double -> Double
Scalar ForwardDouble
-> Scalar ForwardDouble -> Scalar ForwardDouble
forall a. Num a => a -> a -> a
(*) (\D ForwardDouble
x D ForwardDouble
y -> (D ForwardDouble
y, D ForwardDouble
x))