module LevMar.AD
(
LMA.Model
, LMA_I.LevMarable
, levmar
, LinearConstraints
, noLinearConstraints
, Matrix
, LMA_I.Options(..)
, LMA_I.defaultOpts
, LMA_I.Info(..)
, LMA_I.StopReason(..)
, CovarMatrix
, LMA_I.LevMarError(..)
, Z, S, Nat
, SizedList(..)
, NFunction
)
where
import qualified LevMar as LMA
import qualified LevMar.Intermediate as LMA_I
import LevMar.Utils ( LinearConstraints
, noLinearConstraints
, Matrix
, CovarMatrix
, convertLinearConstraints
, convertResult
)
import TypeLevelNat ( Z, S, Nat )
import SizedList ( SizedList(..), toList, unsafeFromList )
import NFunction ( NFunction, ($*) )
import LevMar.Utils.AD ( value, firstDeriv, constant, idDAt )
import Data.Derivative ( (:~>) )
import Data.VectorSpace ( VectorSpace, Scalar )
import Data.Basis ( HasBasis, Basis )
import Data.List ( transpose )
levmar :: forall m n k r.
( Nat m
, Nat n
, Nat k
, HasBasis r
, Basis r ~ ()
, VectorSpace (Scalar r)
, LMA_I.LevMarable r
)
=> (LMA.Model m n (r :~> r))
-> SizedList m r
-> SizedList n r
-> Integer
-> LMA_I.Options r
-> Maybe (SizedList m r)
-> Maybe (SizedList m r)
-> Maybe (LinearConstraints k m r)
-> Maybe (SizedList m r)
-> Either LMA_I.LevMarError (SizedList m r, LMA_I.Info r, CovarMatrix m r)
levmar model params ys itMax opts mLowBs mUpBs mLinC mWghts =
fmap convertResult $ LMA_I.levmar (convertModel model)
(Just $ jacobianOf model)
(toList params)
(toList ys)
itMax
opts
(fmap toList mLowBs)
(fmap toList mUpBs)
(fmap convertLinearConstraints mLinC)
(fmap toList mWghts)
where
convertModel :: LMA.Model m n (r :~> r) -> LMA_I.Model r
(convertModel mdl) ps = fmap value $ toList
(mdl $* pDs :: SizedList n (r :~> r))
where
pDs :: SizedList m (r :~> r)
pDs = unsafeFromList $ fmap constant ps
jacobianOf :: LMA.Model m n (r :~> r) -> LMA_I.Jacobian r
(jacobianOf mdl) ps = fmap (\fs -> zipWith (firstDeriv .) fs ps)
. transpose
. fmap (\pD -> toList (mdl $* (pD :: SizedList m (r :~> r)) :: SizedList n (r :~> r)))
$ pDs
where
pDs :: [SizedList m (r :~> r)]
pDs = [unsafeFromList $ idDAt n ps | n <- [0 .. length ps 1]]