[Haskell-cafe] Automated Differentiation of Matrices (hmatrix)
Dominic Steinitz
dominic at steinitz.org
Tue Apr 9 16:46:17 CEST 2013
Hi Cafe,
Suppose I want to find the grad of a function then it's easy I just
use http://hackage.haskell.org/package/ad-3.4:
import Numeric.AD
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
data MyMatrix a = MyMatrix (a, a)
deriving (Show, Functor, Foldable, Traversable)
f :: Floating a => MyMatrix a -> a
f (MyMatrix (x, y)) = exp $ negate $ (x^2 + y^2) / 2.0
main :: IO ()
main = do
putStrLn $ show $ f $ MyMatrix (0.0, 0.0)
putStrLn $ show $ grad f $ MyMatrix (0.0, 0.0)
But now suppose I am doing some matrix calculations
http://hackage.haskell.org/package/hmatrix-0.14.1.0 and I want to find
the grad of a function of a matrix:
import Numeric.AD
import Numeric.LinearAlgebra
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
g :: (Element a, Floating a) => Matrix a -> a
g m = exp $ negate $ (x^2 + y^2) / 2.0
where r = (toLists m)!!0
x = r!!0
y = r!!1
main :: IO ()
main = do
putStrLn $ show $ g $ (1 >< 2) ([0.0, 0.0] :: [Double])
putStrLn $ show $ grad g $ (1 >< 2) ([0.0, 0.0] :: [Double])
Then I am in trouble:
/Users/dom/Dropbox/Private/Whales/MyAD.hs:24:21:
No instance for (Traversable Matrix) arising from a use of `grad'
Possible fix: add an instance declaration for (Traversable Matrix)
In the expression: grad g
In the second argument of `($)', namely
`grad g $ (1 >< 2) ([0.0, 0.0] :: [Double])'
In the second argument of `($)', namely
`show $ grad g $ (1 >< 2) ([0.0, 0.0] :: [Double])'
/Users/dom/Dropbox/Private/Whales/MyAD.hs:24:26:
Could not deduce (Element
(ad-3.4:Numeric.AD.Internal.Types.AD s Double))
arising from a use of `g'
from the context (Numeric.AD.Internal.Classes.Mode s)
bound by a type expected by the context:
Numeric.AD.Internal.Classes.Mode s =>
Matrix (ad-3.4:Numeric.AD.Internal.Types.AD s Double)
-> ad-3.4:Numeric.AD.Internal.Types.AD s Double
at /Users/dom/Dropbox/Private/Whales/MyAD.hs:24:21-26
Possible fix:
add an instance declaration for
(Element (ad-3.4:Numeric.AD.Internal.Types.AD s Double))
In the first argument of `grad', namely `g'
In the expression: grad g
In the second argument of `($)', namely
`grad g $ (1 >< 2) ([0.0, 0.0] :: [Double])'
What are my options here? Clearly I can convert my matrix into a list
(which is traversable), find the grad and convert it back into a
matrix but given I am doing numerical calculations and speed is an
important factor, this seems undesirable.
I think I would have the same problem with:
http://hackage.haskell.org/package/repa
http://hackage.haskell.org/package/yarr-1.3.1
although I haven'¯t checked.
Thanks, Dominic.
More information about the Haskell-Cafe
mailing list