[Haskell-cafe] Automatic differentiation (AD) with respect to list of matrices in Haskell

Moritz Kiefer moritz.kiefer at purelyfunctional.org
Sun May 8 17:14:25 UTC 2016


There are two orthogonal errors going on here:

1. You need to use auto to embed constants. See the comments at the code
below on how to use it.

2. You need to wrap [Matrix a] in a newtype. grad requires you to
provide a function f a -> a, however sc2 _ has the type [Matrix a] -> a
so if you replace [] by f you end up with f (Matrix a) -> a which
results in the error you’re seeing.

Miguel A. Santos <miguel.a.santos.l at gmail.com> writes:

> mv _ [] = []
> mv (M []) _ = []
> mv ( M m ) v = ( dot (head m)  v ) :  (mv (M (tail m)) v )
> --- two matrices

You need explicit type annotations to make this polymorphic here because of the monomorphism
restriction.

mbW1 :: Num a => Matrix a
> mbW1 = M $ [[1,0,0],[-1,5,1],[1,2,-3]]
> mbW2 = M $ [[0,0,0],[1,3,-1],[-2,4,6]]
> --- two different scoring functions

-- Provide a type signature and map auto over the constants
sc1 :: (Floating b, Mode b) => [Scalar b] -> Matrix b -> b
sc1 v m = foldr (+) 0 $ (phi' . (mv m) ) (map auto v)

-- Provide a type signature, use auto and use the newtype
newtype MatrixList a = MatrixList [Matrix a] deriving
(Functor,Foldable,Traversable)

sc2 :: (Floating a,Mode a) => [Scalar a] -> MatrixList a -> a
sc2 v [m1, m2] = foldr (+) 0 $ (phi' . (mv m2) . phi' . (mv m1) ) (map
auto v)

> strToInt = read :: String -> Double
> strLToIntL = map strToInt--- testing
> main = do
>         putStrLn $ "mbW1:" ++ (show mbW1)
>         putStrLn $ "mbW2:" ++ (show mbW2)
>         rawInput <-  readFile "/dev/stdin"
>         let xin= strLToIntL $ lines rawInput
>         putStrLn "sc xin mbW1"

-- That needs an explicit type annotation because mbW1 is polymorphic
         print $ sc1 xin (mbW1 :: Matrix Double) --- ok. =

>         putStrLn "grad (sc1 xin) mbW1"
>         print $ grad ( sc1 xin) mbW1   -- yields an error: expects xin
> [Reverse s Double] instead of [Double]
>         putStrLn "grad (sc1 [3,5,7]) mbW1"
>         print $ grad ( sc1 [3,5,7]) mbW1   --- ok. =
>         putStrLn "sc2 xin [mbW1,mbW2]"
>         print $ sc2 xin [mbW1, mbW2]
>         putStrLn "grad (sc2 [3,5,7) [mbW1,mbW2]"

-- Use the newtype defined above
         print $ grad ( sc2 [3,5,7]) (MatrixList [mbW1, mbW2])  --- Error: see text

Also as a general recommendation, write your type signatures explicitely
at least for top level definitions.

Cheers

Moritz
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 818 bytes
Desc: not available
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20160508/537c26b5/attachment.sig>


More information about the Haskell-Cafe mailing list