{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Numeric.AD.Newton.Double
(
findZero
, inverse
, fixedPoint
, extremum
, conjugateGradientDescent
, conjugateGradientAscent
) where
import Data.Foldable (all, sum)
import Data.Traversable
import Numeric.AD.Internal.Combinators
import Numeric.AD.Internal.Forward (Forward)
import Numeric.AD.Internal.Forward.Double (ForwardDouble)
import Numeric.AD.Internal.On
import Numeric.AD.Internal.Or
import Numeric.AD.Internal.Type (AD(..))
import Numeric.AD.Mode
import Numeric.AD.Rank1.Kahn.Double as Kahn (KahnDouble, grad)
import qualified Numeric.AD.Rank1.Newton.Double as Rank1
import Prelude hiding (all, mapM, sum)
findZero :: (forall s. AD s ForwardDouble -> AD s ForwardDouble) -> Double -> [Double]
findZero :: (forall s. AD s ForwardDouble -> AD s ForwardDouble)
-> Double -> [Double]
findZero forall s. AD s ForwardDouble -> AD s ForwardDouble
f = (ForwardDouble -> ForwardDouble) -> Double -> [Double]
Rank1.findZero (forall s a. AD s a -> a
runADforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s. AD s ForwardDouble -> AD s ForwardDouble
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. a -> AD s a
AD)
{-# INLINE findZero #-}
inverse :: (forall s. AD s ForwardDouble -> AD s ForwardDouble) -> Double -> Double -> [Double]
inverse :: (forall s. AD s ForwardDouble -> AD s ForwardDouble)
-> Double -> Double -> [Double]
inverse forall s. AD s ForwardDouble -> AD s ForwardDouble
f = (ForwardDouble -> ForwardDouble) -> Double -> Double -> [Double]
Rank1.inverse (forall s a. AD s a -> a
runADforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s. AD s ForwardDouble -> AD s ForwardDouble
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. a -> AD s a
AD)
{-# INLINE inverse #-}
fixedPoint :: (forall s. AD s ForwardDouble -> AD s ForwardDouble) -> Double -> [Double]
fixedPoint :: (forall s. AD s ForwardDouble -> AD s ForwardDouble)
-> Double -> [Double]
fixedPoint forall s. AD s ForwardDouble -> AD s ForwardDouble
f = (ForwardDouble -> ForwardDouble) -> Double -> [Double]
Rank1.fixedPoint (forall s a. AD s a -> a
runADforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s. AD s ForwardDouble -> AD s ForwardDouble
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. a -> AD s a
AD)
{-# INLINE fixedPoint #-}
extremum :: (forall s. AD s (On (Forward ForwardDouble)) -> AD s (On (Forward ForwardDouble))) -> Double -> [Double]
extremum :: (forall s.
AD s (On (Forward ForwardDouble))
-> AD s (On (Forward ForwardDouble)))
-> Double -> [Double]
extremum forall s.
AD s (On (Forward ForwardDouble))
-> AD s (On (Forward ForwardDouble))
f = (On (Forward ForwardDouble) -> On (Forward ForwardDouble))
-> Double -> [Double]
Rank1.extremum (forall s a. AD s a -> a
runADforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s.
AD s (On (Forward ForwardDouble))
-> AD s (On (Forward ForwardDouble))
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. a -> AD s a
AD)
{-# INLINE extremum #-}
conjugateGradientDescent
:: Traversable f
=> (forall s. Chosen s => f (Or s (On (Forward ForwardDouble)) KahnDouble) -> Or s (On (Forward ForwardDouble)) KahnDouble)
-> f Double -> [f Double]
conjugateGradientDescent :: forall (f :: * -> *).
Traversable f =>
(forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble)
-> f Double -> [f Double]
conjugateGradientDescent forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble
f = forall (f :: * -> *).
Traversable f =>
(forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble)
-> f Double -> [f Double]
conjugateGradientAscent (forall a. Num a => a -> a
negate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble
f)
{-# INLINE conjugateGradientDescent #-}
lfu :: Functor f => (f (Or F a b) -> Or F a b) -> f a -> a
lfu :: forall (f :: * -> *) a b.
Functor f =>
(f (Or F a b) -> Or F a b) -> f a -> a
lfu f (Or F a b) -> Or F a b
f = forall a b. Or F a b -> a
runL forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Or F a b) -> Or F a b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Or F a b
L
rfu :: Functor f => (f (Or T a b) -> Or T a b) -> f b -> b
rfu :: forall (f :: * -> *) a b.
Functor f =>
(f (Or T a b) -> Or T a b) -> f b -> b
rfu f (Or T a b) -> Or T a b
f = forall a b. Or T a b -> b
runR forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Or T a b) -> Or T a b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b a. b -> Or T a b
R
conjugateGradientAscent
:: Traversable f
=> (forall s. Chosen s => f (Or s (On (Forward ForwardDouble)) KahnDouble) -> Or s (On (Forward ForwardDouble)) KahnDouble)
-> f Double -> [f Double]
conjugateGradientAscent :: forall (f :: * -> *).
Traversable f =>
(forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble)
-> f Double -> [f Double]
conjugateGradientAscent forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble
f f Double
x0 = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Double
a -> Double
a forall a. Eq a => a -> a -> Bool
== Double
a)) (f Double -> f Double -> f Double -> Double -> [f Double]
go f Double
x0 f Double
d0 f Double
d0 Double
delta0)
where
dot :: f a -> t a -> a
dot f a
x t a
y = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a b c.
(Foldable f, Traversable g) =>
(a -> b -> c) -> f a -> g b -> g c
zipWithT forall a. Num a => a -> a -> a
(*) f a
x t a
y
d0 :: f Double
d0 = forall (f :: * -> *).
Traversable f =>
(f KahnDouble -> KahnDouble) -> f Double -> f Double
Kahn.grad (forall (f :: * -> *) a b.
Functor f =>
(f (Or T a b) -> Or T a b) -> f b -> b
rfu forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble
f) f Double
x0
delta0 :: Double
delta0 = forall {a} {t :: * -> *} {f :: * -> *}.
(Num a, Foldable f, Traversable t) =>
f a -> t a -> a
dot f Double
d0 f Double
d0
go :: f Double -> f Double -> f Double -> Double -> [f Double]
go f Double
xi f Double
_ri f Double
di Double
deltai = f Double
xi forall a. a -> [a] -> [a]
: f Double -> f Double -> f Double -> Double -> [f Double]
go f Double
xi1 f Double
ri1 f Double
di1 Double
deltai1
where
ai :: Double
ai = forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
20 forall a b. (a -> b) -> a -> b
$ (On (Forward ForwardDouble) -> On (Forward ForwardDouble))
-> Double -> [Double]
Rank1.extremum (\On (Forward ForwardDouble)
a -> forall (f :: * -> *) a b.
Functor f =>
(f (Or F a b) -> Or F a b) -> f a -> a
lfu forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble
f forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (g :: * -> *) a b c.
(Foldable f, Traversable g) =>
(a -> b -> c) -> f a -> g b -> g c
zipWithT (\Double
x Double
d -> forall t. Mode t => Scalar t -> t
auto Double
x forall a. Num a => a -> a -> a
+ On (Forward ForwardDouble)
a forall a. Num a => a -> a -> a
* forall t. Mode t => Scalar t -> t
auto Double
d) f Double
xi f Double
di) Double
0
xi1 :: f Double
xi1 = forall (f :: * -> *) (g :: * -> *) a b c.
(Foldable f, Traversable g) =>
(a -> b -> c) -> f a -> g b -> g c
zipWithT (\Double
x Double
d -> Double
x forall a. Num a => a -> a -> a
+ Double
aiforall a. Num a => a -> a -> a
*Double
d) f Double
xi f Double
di
ri1 :: f Double
ri1 = forall (f :: * -> *).
Traversable f =>
(f KahnDouble -> KahnDouble) -> f Double -> f Double
Kahn.grad (forall (f :: * -> *) a b.
Functor f =>
(f (Or T a b) -> Or T a b) -> f b -> b
rfu forall s.
Chosen s =>
f (Or s (On (Forward ForwardDouble)) KahnDouble)
-> Or s (On (Forward ForwardDouble)) KahnDouble
f) f Double
xi1
deltai1 :: Double
deltai1 = forall {a} {t :: * -> *} {f :: * -> *}.
(Num a, Foldable f, Traversable t) =>
f a -> t a -> a
dot f Double
ri1 f Double
ri1
bi1 :: Double
bi1 = Double
deltai1 forall a. Fractional a => a -> a -> a
/ Double
deltai
di1 :: f Double
di1 = forall (f :: * -> *) (g :: * -> *) a b c.
(Foldable f, Traversable g) =>
(a -> b -> c) -> f a -> g b -> g c
zipWithT (\Double
r Double
d -> Double
r forall a. Num a => a -> a -> a
+ Double
bi1 forall a. Num a => a -> a -> a
* Double
d) f Double
ri1 f Double
di
{-# INLINE conjugateGradientAscent #-}