{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   : (c) Edward Kmett 2010-2021
-- License     : BSD3
-- Maintainer  : ekmett@gmail.com
-- Stability   : experimental
-- Portability : GHC only
--
-----------------------------------------------------------------------------

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(x,y,z) 1
#endif

module Numeric.AD.Internal.Tower.Double
  ( TowerDouble(..)
  , List(..)
  , zeroPad
  , zeroPadF
  , transposePadF
  , d, dl
  , d', dl'
  , withD
  , tangents
  , bundle
  , apply
  , getADTower
  , tower
  ) where

import Prelude hiding (all, sum)
import Control.Monad (join)
import Data.Foldable
import Data.Data (Data)
import Data.Number.Erf
import Data.Typeable (Typeable)
import Numeric
import Numeric.AD.Internal.Combinators
import Numeric.AD.Jacobian
import Numeric.AD.Mode
import Text.Read
import GHC.Exts as Exts (IsList(..))
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif

-- spine lazy, value strict list of doubles
data List
  = Nil
  | {-# UNPACK #-} !Double :! List
  deriving (List -> List -> Bool
(List -> List -> Bool) -> (List -> List -> Bool) -> Eq List
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: List -> List -> Bool
== :: List -> List -> Bool
$c/= :: List -> List -> Bool
/= :: List -> List -> Bool
Eq,Eq List
Eq List =>
(List -> List -> Ordering)
-> (List -> List -> Bool)
-> (List -> List -> Bool)
-> (List -> List -> Bool)
-> (List -> List -> Bool)
-> (List -> List -> List)
-> (List -> List -> List)
-> Ord List
List -> List -> Bool
List -> List -> Ordering
List -> List -> List
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: List -> List -> Ordering
compare :: List -> List -> Ordering
$c< :: List -> List -> Bool
< :: List -> List -> Bool
$c<= :: List -> List -> Bool
<= :: List -> List -> Bool
$c> :: List -> List -> Bool
> :: List -> List -> Bool
$c>= :: List -> List -> Bool
>= :: List -> List -> Bool
$cmax :: List -> List -> List
max :: List -> List -> List
$cmin :: List -> List -> List
min :: List -> List -> List
Ord,Typeable,Typeable List
Typeable List =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> List -> c List)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c List)
-> (List -> Constr)
-> (List -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c List))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c List))
-> ((forall b. Data b => b -> b) -> List -> List)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> List -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> List -> r)
-> (forall u. (forall d. Data d => d -> u) -> List -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> List -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> List -> m List)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> List -> m List)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> List -> m List)
-> Data List
List -> Constr
List -> DataType
(forall b. Data b => b -> b) -> List -> List
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> List -> u
forall u. (forall d. Data d => d -> u) -> List -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> List -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> List -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> List -> m List
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> List -> m List
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c List
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> List -> c List
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c List)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c List)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> List -> c List
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> List -> c List
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c List
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c List
$ctoConstr :: List -> Constr
toConstr :: List -> Constr
$cdataTypeOf :: List -> DataType
dataTypeOf :: List -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c List)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c List)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c List)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c List)
$cgmapT :: (forall b. Data b => b -> b) -> List -> List
gmapT :: (forall b. Data b => b -> b) -> List -> List
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> List -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> List -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> List -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> List -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> List -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> List -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> List -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> List -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> List -> m List
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> List -> m List
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> List -> m List
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> List -> m List
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> List -> m List
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> List -> m List
Data)

infixr 5 :!


instance Semigroup List where
  List
Nil <> :: List -> List -> List
<> List
xs = List
xs
  (Double
x :! List
xs) <> List
ys = Double
x Double -> List -> List
:! (List
xs List -> List -> List
forall a. Semigroup a => a -> a -> a
<> List
ys)

instance Monoid List where
  mempty :: List
mempty = List
Nil
  mappend :: List -> List -> List
mappend = List -> List -> List
forall a. Semigroup a => a -> a -> a
(<>)

instance IsList List where
  type Item List = Double
  toList :: List -> [Item List]
toList List
Nil = []
  toList (Double
a :! List
as) = Double
a Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: List -> [Item List]
forall l. IsList l => l -> [Item l]
Exts.toList List
as
  fromList :: [Item List] -> List
fromList [] = List
Nil
  fromList (Item List
a : [Item List]
as) = Double
Item List
a Double -> List -> List
:! [Item List] -> List
forall l. IsList l => [Item l] -> l
Exts.fromList [Item List]
as

instance Show List where
  showsPrec :: Int -> List -> ShowS
showsPrec Int
d = Int -> [Double] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d ([Double] -> ShowS) -> (List -> [Double]) -> List -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List -> [Double]
List -> [Item List]
forall l. IsList l => l -> [Item l]
Exts.toList

instance Read List where
  readPrec :: ReadPrec List
readPrec = [Double] -> List
[Item List] -> List
forall l. IsList l => [Item l] -> l
Exts.fromList ([Double] -> List) -> ReadPrec [Double] -> ReadPrec List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [Double] -> ReadPrec [Double]
forall a. ReadPrec a -> ReadPrec a
step ReadPrec [Double]
forall a. Read a => ReadPrec a
readPrec

lmap :: (Double -> Double) -> List -> List
lmap :: (Double -> Double) -> List -> List
lmap Double -> Double
f (Double
a :! List
as) = Double -> Double
f Double
a Double -> List -> List
:! (Double -> Double) -> List -> List
lmap Double -> Double
f List
as
lmap Double -> Double
_ List
Nil = List
Nil


-- | @Tower@ is an AD 'Mode' that calculates a tangent tower by forward AD, and provides fast 'diffsUU', 'diffsUF'
newtype TowerDouble = Tower { TowerDouble -> List
getTower :: List }
  deriving (Typeable TowerDouble
Typeable TowerDouble =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TowerDouble -> c TowerDouble)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TowerDouble)
-> (TowerDouble -> Constr)
-> (TowerDouble -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TowerDouble))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TowerDouble))
-> ((forall b. Data b => b -> b) -> TowerDouble -> TowerDouble)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TowerDouble -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TowerDouble -> r)
-> (forall u. (forall d. Data d => d -> u) -> TowerDouble -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TowerDouble -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble)
-> Data TowerDouble
TowerDouble -> Constr
TowerDouble -> DataType
(forall b. Data b => b -> b) -> TowerDouble -> TowerDouble
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TowerDouble -> u
forall u. (forall d. Data d => d -> u) -> TowerDouble -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TowerDouble -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TowerDouble -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TowerDouble
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TowerDouble -> c TowerDouble
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TowerDouble)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TowerDouble)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TowerDouble -> c TowerDouble
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TowerDouble -> c TowerDouble
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TowerDouble
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TowerDouble
$ctoConstr :: TowerDouble -> Constr
toConstr :: TowerDouble -> Constr
$cdataTypeOf :: TowerDouble -> DataType
dataTypeOf :: TowerDouble -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TowerDouble)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TowerDouble)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TowerDouble)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TowerDouble)
$cgmapT :: (forall b. Data b => b -> b) -> TowerDouble -> TowerDouble
gmapT :: (forall b. Data b => b -> b) -> TowerDouble -> TowerDouble
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TowerDouble -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TowerDouble -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TowerDouble -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TowerDouble -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TowerDouble -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TowerDouble -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TowerDouble -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TowerDouble -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TowerDouble -> m TowerDouble
Data, Typeable)

instance Show TowerDouble where
  showsPrec :: Int -> TowerDouble -> ShowS
showsPrec Int
n (Tower List
as) = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Tower " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> List -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 List
as

-- Local combinators

zeroPad :: Num a => [a] -> [a]
zeroPad :: forall a. Num a => [a] -> [a]
zeroPad [a]
xs = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> [a]
forall a. a -> [a]
repeat a
0
{-# INLINE zeroPad #-}

zeroPadF :: (Functor f, Num a) => [f a] -> [f a]
zeroPadF :: forall (f :: * -> *) a. (Functor f, Num a) => [f a] -> [f a]
zeroPadF fxs :: [f a]
fxs@(f a
fx:[f a]
_) = [f a]
fxs [f a] -> [f a] -> [f a]
forall a. [a] -> [a] -> [a]
++ f a -> [f a]
forall a. a -> [a]
repeat (a
0 a -> f a -> f a
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f a
fx)
zeroPadF [f a]
_ = String -> [f a]
forall a. HasCallStack => String -> a
error String
"zeroPadF :: empty list"
{-# INLINE zeroPadF #-}

lnull :: List -> Bool
lnull :: List -> Bool
lnull List
Nil = Bool
True
lnull List
_ = Bool
False

transposePadF :: (Foldable f, Functor f) => Double -> f List -> [f Double]
transposePadF :: forall (f :: * -> *).
(Foldable f, Functor f) =>
Double -> f List -> [f Double]
transposePadF Double
pad f List
fx
  | (List -> Bool) -> f List -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all List -> Bool
lnull f List
fx = []
  | Bool
otherwise = (List -> Double) -> f List -> f Double
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap List -> Double
headPad f List
fx f Double -> [f Double] -> [f Double]
forall a. a -> [a] -> [a]
: Double -> f List -> [f Double]
forall (f :: * -> *).
(Foldable f, Functor f) =>
Double -> f List -> [f Double]
transposePadF Double
pad (List -> List
drop1 (List -> List) -> f List -> f List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f List
fx)
  where
    headPad :: List -> Double
headPad List
Nil = Double
pad
    headPad (Double
x :! List
_) = Double
x
    drop1 :: List -> List
drop1 (Double
_ :! List
xs) = List
xs
    drop1 List
xs = List
xs

d :: Num a => [a] -> a
d :: forall a. Num a => [a] -> a
d (a
_:a
da:[a]
_) = a
da
d [a]
_ = a
0
{-# INLINE d #-}

dl :: List -> Double
dl :: List -> Double
dl (Double
_ :! Double
da :! List
_) = Double
da
dl List
_ = Double
0
{-# INLINE dl #-}

d' :: Num a => [a] -> (a, a)
d' :: forall a. Num a => [a] -> (a, a)
d' (a
a:a
da:[a]
_) = (a
a, a
da)
d' (a
a:[a]
_)    = (a
a, a
0)
d' [a]
_        = (a
0, a
0)
{-# INLINE d' #-}

dl' :: List -> (Double, Double)
dl' :: List -> (Double, Double)
dl' (Double
a:!Double
da:!List
_) = (Double
a, Double
da)
dl' (Double
a:!List
_)     = (Double
a, Double
0)
dl' List
_          = (Double
0, Double
0)
{-# INLINE dl' #-}

tangents :: TowerDouble -> TowerDouble
tangents :: TowerDouble -> TowerDouble
tangents (Tower List
Nil) = List -> TowerDouble
Tower List
Nil
tangents (Tower (Double
_ :! List
xs)) = List -> TowerDouble
Tower List
xs
{-# INLINE tangents #-}

truncated :: TowerDouble -> Bool
truncated :: TowerDouble -> Bool
truncated (Tower List
Nil) = Bool
True
truncated TowerDouble
_ = Bool
False
{-# INLINE truncated #-}

bundle :: Double -> TowerDouble -> TowerDouble
bundle :: Double -> TowerDouble -> TowerDouble
bundle Double
a (Tower List
as) = List -> TowerDouble
Tower (Double
a Double -> List -> List
:! List
as)
{-# INLINE bundle #-}

withD :: (Double, Double) -> TowerDouble
withD :: (Double, Double) -> TowerDouble
withD (Double
a, Double
da) = List -> TowerDouble
Tower (Double
a Double -> List -> List
:! Double
da Double -> List -> List
:! List
Nil)
{-# INLINE withD #-}

apply :: (TowerDouble -> b) -> Double -> b
apply :: forall b. (TowerDouble -> b) -> Double -> b
apply TowerDouble -> b
f Double
a = TowerDouble -> b
f (List -> TowerDouble
Tower (Double
a Double -> List -> List
:! Double
1 Double -> List -> List
:! List
Nil))
{-# INLINE apply #-}

getADTower :: TowerDouble -> [Double]
getADTower :: TowerDouble -> [Double]
getADTower = List -> [Double]
List -> [Item List]
forall l. IsList l => l -> [Item l]
Exts.toList (List -> [Double])
-> (TowerDouble -> List) -> TowerDouble -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TowerDouble -> List
getTower
{-# INLINE getADTower #-}

tower :: [Double] -> TowerDouble
tower :: [Double] -> TowerDouble
tower = List -> TowerDouble
Tower (List -> TowerDouble)
-> ([Double] -> List) -> [Double] -> TowerDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> List
[Item List] -> List
forall l. IsList l => [Item l] -> l
Exts.fromList

primal :: TowerDouble -> Double
primal :: TowerDouble -> Double
primal (Tower (Double
x:!List
_)) = Double
x
primal TowerDouble
_ = Double
0

instance Mode TowerDouble where
  type Scalar TowerDouble = Double

  auto :: Scalar TowerDouble -> TowerDouble
auto Scalar TowerDouble
a = List -> TowerDouble
Tower (Double
Scalar TowerDouble
a Double -> List -> List
:! List
Nil)

  isKnownZero :: TowerDouble -> Bool
isKnownZero (Tower List
Nil) = Bool
True
  isKnownZero (Tower (Double
0 :! List
Nil)) = Bool
True
  isKnownZero TowerDouble
_ = Bool
False

  asKnownConstant :: TowerDouble -> Maybe (Scalar TowerDouble)
asKnownConstant (Tower List
Nil) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0
  asKnownConstant (Tower (Double
a :! List
Nil)) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
a
  asKnownConstant Tower {} = Maybe Double
Maybe (Scalar TowerDouble)
forall a. Maybe a
Nothing

  isKnownConstant :: TowerDouble -> Bool
isKnownConstant (Tower List
Nil) = Bool
True
  isKnownConstant (Tower (Double
_ :! List
Nil)) = Bool
True
  isKnownConstant Tower {} = Bool
False

  zero :: TowerDouble
zero = List -> TowerDouble
Tower List
Nil

  Scalar TowerDouble
a *^ :: Scalar TowerDouble -> TowerDouble -> TowerDouble
*^ Tower List
bs = List -> TowerDouble
Tower ((Double -> Double) -> List -> List
lmap (Double
Scalar TowerDouble
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*) List
bs)

  Tower List
as ^* :: TowerDouble -> Scalar TowerDouble -> TowerDouble
^* Scalar TowerDouble
b = List -> TowerDouble
Tower ((Double -> Double) -> List -> List
lmap (Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble
forall a. Num a => a -> a -> a
*Scalar TowerDouble
b) List
as)

  Tower List
as ^/ :: Fractional (Scalar TowerDouble) =>
TowerDouble -> Scalar TowerDouble -> TowerDouble
^/ Scalar TowerDouble
b = List -> TowerDouble
Tower ((Double -> Double) -> List -> List
lmap (Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble
forall a. Fractional a => a -> a -> a
/Scalar TowerDouble
b) List
as)

infixr 6 <+>

(<+>) :: TowerDouble -> TowerDouble -> TowerDouble
Tower List
Nil <+> :: TowerDouble -> TowerDouble -> TowerDouble
<+> TowerDouble
bs = TowerDouble
bs
TowerDouble
as <+> Tower List
Nil = TowerDouble
as
Tower (Double
a:!List
as) <+> Tower (Double
b:!List
bs) = List -> TowerDouble
Tower (Double
cDouble -> List -> List
:!List
cs) where
  c :: Double
c = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b
  Tower List
cs = List -> TowerDouble
Tower List
as TowerDouble -> TowerDouble -> TowerDouble
<+> List -> TowerDouble
Tower List
bs

instance Jacobian TowerDouble where
  type D TowerDouble = TowerDouble
  unary :: (Scalar TowerDouble -> Scalar TowerDouble)
-> D TowerDouble -> TowerDouble -> TowerDouble
unary Scalar TowerDouble -> Scalar TowerDouble
f D TowerDouble
dadb TowerDouble
b = Double -> TowerDouble -> TowerDouble
bundle (Scalar TowerDouble -> Scalar TowerDouble
f (TowerDouble -> Double
primal TowerDouble
b)) (TowerDouble -> TowerDouble
tangents TowerDouble
b TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble
TowerDouble
dadb)
  lift1 :: (Scalar TowerDouble -> Scalar TowerDouble)
-> (D TowerDouble -> D TowerDouble) -> TowerDouble -> TowerDouble
lift1 Scalar TowerDouble -> Scalar TowerDouble
f D TowerDouble -> D TowerDouble
df TowerDouble
b   = Double -> TowerDouble -> TowerDouble
bundle (Scalar TowerDouble -> Scalar TowerDouble
f (TowerDouble -> Double
primal TowerDouble
b)) (TowerDouble -> TowerDouble
tangents TowerDouble
b TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble -> D TowerDouble
df D TowerDouble
TowerDouble
b)
  lift1_ :: (Scalar TowerDouble -> Scalar TowerDouble)
-> (D TowerDouble -> D TowerDouble -> D TowerDouble)
-> TowerDouble
-> TowerDouble
lift1_ Scalar TowerDouble -> Scalar TowerDouble
f D TowerDouble -> D TowerDouble -> D TowerDouble
df TowerDouble
b = TowerDouble
a where
    a :: TowerDouble
a = Double -> TowerDouble -> TowerDouble
bundle (Scalar TowerDouble -> Scalar TowerDouble
f (TowerDouble -> Double
primal TowerDouble
b)) (TowerDouble -> TowerDouble
tangents TowerDouble
b TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble -> D TowerDouble -> D TowerDouble
df D TowerDouble
TowerDouble
a D TowerDouble
TowerDouble
b)

  binary :: (Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble)
-> D TowerDouble
-> D TowerDouble
-> TowerDouble
-> TowerDouble
-> TowerDouble
binary Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble
f D TowerDouble
dadb D TowerDouble
dadc TowerDouble
b TowerDouble
c = Double -> TowerDouble -> TowerDouble
bundle (Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble
f (TowerDouble -> Double
primal TowerDouble
b) (TowerDouble -> Double
primal TowerDouble
c)) (TowerDouble -> TowerDouble
tangents TowerDouble
b TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble
TowerDouble
dadb TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
+ TowerDouble -> TowerDouble
tangents TowerDouble
c TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble
TowerDouble
dadc)
  lift2 :: (Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble)
-> (D TowerDouble
    -> D TowerDouble -> (D TowerDouble, D TowerDouble))
-> TowerDouble
-> TowerDouble
-> TowerDouble
lift2 Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble
f D TowerDouble -> D TowerDouble -> (D TowerDouble, D TowerDouble)
df TowerDouble
b TowerDouble
c = Double -> TowerDouble -> TowerDouble
bundle (Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble
f (TowerDouble -> Double
primal TowerDouble
b) (TowerDouble -> Double
primal TowerDouble
c)) TowerDouble
tana where
     (D TowerDouble
dadb, D TowerDouble
dadc) = D TowerDouble -> D TowerDouble -> (D TowerDouble, D TowerDouble)
df D TowerDouble
TowerDouble
b D TowerDouble
TowerDouble
c
     tanb :: TowerDouble
tanb = TowerDouble -> TowerDouble
tangents TowerDouble
b
     tanc :: TowerDouble
tanc = TowerDouble -> TowerDouble
tangents TowerDouble
c
     tana :: TowerDouble
tana = case (TowerDouble -> Bool
truncated TowerDouble
tanb, TowerDouble -> Bool
truncated TowerDouble
tanc) of
       (Bool
False, Bool
False) -> TowerDouble
tanb TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble
TowerDouble
dadb TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
+ TowerDouble
tanc TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble
TowerDouble
dadc
       (Bool
True, Bool
False) -> TowerDouble
tanc TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble
TowerDouble
dadc
       (Bool
False, Bool
True) -> TowerDouble
tanb TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* D TowerDouble
TowerDouble
dadb
       (Bool
True, Bool
True) -> TowerDouble
forall t. Mode t => t
zero
  lift2_ :: (Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble)
-> (D TowerDouble
    -> D TowerDouble
    -> D TowerDouble
    -> (D TowerDouble, D TowerDouble))
-> TowerDouble
-> TowerDouble
-> TowerDouble
lift2_ Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble
f D TowerDouble
-> D TowerDouble -> D TowerDouble -> (D TowerDouble, D TowerDouble)
df TowerDouble
b TowerDouble
c = TowerDouble
a where
    a0 :: Scalar TowerDouble
a0 = Scalar TowerDouble -> Scalar TowerDouble -> Scalar TowerDouble
f (TowerDouble -> Double
primal TowerDouble
b) (TowerDouble -> Double
primal TowerDouble
c)
    da :: TowerDouble
da = TowerDouble -> TowerDouble
tangents TowerDouble
b TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* TowerDouble
dadb TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
+ TowerDouble -> TowerDouble
tangents TowerDouble
c TowerDouble -> TowerDouble -> TowerDouble
forall a. Num a => a -> a -> a
* TowerDouble
dadc
    a :: TowerDouble
a = Double -> TowerDouble -> TowerDouble
bundle Double
Scalar TowerDouble
a0 TowerDouble
da
    (TowerDouble
dadb, TowerDouble
dadc) = D TowerDouble
-> D TowerDouble -> D TowerDouble -> (D TowerDouble, D TowerDouble)
df D TowerDouble
TowerDouble
a D TowerDouble
TowerDouble
b D TowerDouble
TowerDouble
c

lzipWith :: (Double -> Double -> Double) -> List -> List -> List
lzipWith :: (Double -> Double -> Double) -> List -> List -> List
lzipWith Double -> Double -> Double
f (Double
a :! List
as) (Double
b :! List
bs) = Double -> Double -> Double
f Double
a Double
b Double -> List -> List
:! (Double -> Double -> Double) -> List -> List -> List
lzipWith Double -> Double -> Double
f List
as List
bs
lzipWith Double -> Double -> Double
_ List
_ List
_ = List
Nil

lsumProd3 :: List -> List -> List -> Double
lsumProd3 :: List -> List -> List -> Double
lsumProd3 List
as0 List
bs0 List
cs0 = List -> List -> List -> Double -> Double
go List
as0 List
bs0 List
cs0 Double
0 where
  go :: List -> List -> List -> Double -> Double
go (Double
a :! List
as) (Double
b :! List
bs) (Double
c :! List
cs) !Double
acc = List -> List -> List -> Double -> Double
go List
as List
bs List
cs (Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
acc)
  go List
_ List
_ List
_ Double
acc = Double
acc;

ltail :: List -> List
ltail :: List -> List
ltail (Double
_ :! List
as) = List
as
ltail List
_ = String -> List
forall a. HasCallStack => String -> a
error String
"ltail"

-- mul xs ys = [ sum [xs!!j * ys!!(k-j)*bin k j | j <- [0..k]] | k <- [0..] ]
-- adapted for efficiency and to handle finite lists xs, ys
mul:: TowerDouble -> TowerDouble -> TowerDouble
mul :: TowerDouble -> TowerDouble -> TowerDouble
mul (Tower List
Nil) TowerDouble
_ = List -> TowerDouble
Tower List
Nil
mul (Tower (Double
a :! List
as)) (Tower List
bs) = List -> TowerDouble
Tower (List -> List -> List -> List -> List
convs' (Double
1 Double -> List -> List
:! List
Nil) (Double
a Double -> List -> List
:! List
Nil) List
as List
bs)
  where convs' :: List -> List -> List -> List -> List
convs' List
_ List
_ List
_ List
Nil = List
Nil
        convs' List
ps List
ars List
as List
bs = List -> List -> List -> Double
lsumProd3 List
ps List
ars List
bs Double -> List -> List
:!
              case List
as of
                 List
Nil -> List -> List -> List -> List
convs'' (List -> List
next' List
ps) List
ars List
bs
                 Double
a:!List
as -> List -> List -> List -> List -> List
convs' (List -> List
next List
ps) (Double
aDouble -> List -> List
:!List
ars) List
as List
bs
        convs'' :: List -> List -> List -> List
convs'' List
_ List
_ List
Nil = List
forall a. HasCallStack => a
undefined -- convs'' never called with last argument empty
        convs'' List
_ List
_ (Double
_:! List
Nil) = List
Nil
        convs'' List
ps List
ars (Double
_:!List
bs) = List -> List -> List -> Double
lsumProd3 List
ps List
ars List
bs Double -> List -> List
:! List -> List -> List -> List
convs'' (List -> List
next' List
ps) List
ars List
bs
        next :: List -> List
next List
xs = Double
1 Double -> List -> List
:! (Double -> Double -> Double) -> List -> List -> List
lzipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) List
xs (List -> List
ltail List
xs) List -> List -> List
forall a. Semigroup a => a -> a -> a
<> (Double
1 Double -> List -> List
:! List
Nil) -- next row in Pascal's triangle
        next' :: List -> List
next' List
xs = (Double -> Double -> Double) -> List -> List -> List
lzipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) List
xs (List -> List
ltail List
xs) List -> List -> List
forall a. Semigroup a => a -> a -> a
<> (Double
1 Double -> List -> List
:! List
Nil) -- end part of next row in Pascal's triangle

#define HEAD TowerDouble
#define BODY1(x)
#define BODY2(x,y)
#define NO_Bounded
#include <instances.h>