[Haskell-cafe] Automated Differentiation Type Question
Dominic Steinitz
dominic at steinitz.org
Tue Apr 23 11:44:09 CEST 2013
Can anyone tell me why I get a type error with testGrad2? What are my options? Clearly I would like to be able find the gradient of my cost function for different sets of observations.
Thanks, Dominic.
> {-# LANGUAGE NoMonomorphismRestriction #-}
>
> import Numeric.AD
>
> default()
>
> costFn :: Floating a => [a] -> [[a]] -> [a] -> a
> costFn ys xss thetas = (/ (2*m)) $ sum $ map (^ (2 :: Int)) $
> zipWith (\y xs -> costFnAux y xs thetas) ys xss
> where
> m = fromIntegral $ length xss
> costFnAux :: Floating a => a -> [a] -> [a] -> a
> costFnAux y xs thetas = y - head thetas - sum (zipWith (*) xs (tail thetas))
>
> ys :: Floating a => [a]
> ys = [1.0, 2.0, 3.0]
>
> xss :: Floating a => [[a]]
> xss = [[1.0], [2.0], [3.0]]
>
> thetas :: Floating a => [a]
> thetas = [0.0, 1.0]
>
> test :: Floating a => a
> test = costFn ys xss thetas
>
> testGrad0 = grad (costFn ys xss)
>
> testGrad1 :: Floating a => [a] -> [[a]] -> [a] -> [a]
> testGrad1 ys xss = grad (costFn (undefined :: Floating a => [a]) (undefined :: Floating a => [[a]]))
>
> testGrad2 :: Floating a => [a] -> [[a]] -> [a] -> [a]
> testGrad2 ys xss = grad (costFn ys xss)
> [1 of 1] Compiling Main ( /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs, interpreted )
>
> /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs:33:33:
> Could not deduce (a ~ ad-3.4:Numeric.AD.Internal.Types.AD s a)
> from the context (Floating a)
> bound by the type signature for
> testGrad2 :: Floating a => [a] -> [[a]] -> [a] -> [a]
> at /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs:32:14-53
> or from (Numeric.AD.Internal.Classes.Mode s)
> bound by a type expected by the context:
> Numeric.AD.Internal.Classes.Mode s =>
> [ad-3.4:Numeric.AD.Internal.Types.AD s a]
> -> ad-3.4:Numeric.AD.Internal.Types.AD s a
> at /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs:33:20-39
> `a' is a rigid type variable bound by
> the type signature for
> testGrad2 :: Floating a => [a] -> [[a]] -> [a] -> [a]
> at /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs:32:14
> Expected type: [ad-3.4:Numeric.AD.Internal.Types.AD s a]
> Actual type: [a]
> In the first argument of `costFn', namely `ys'
> In the first argument of `grad', namely `(costFn ys xss)'
> In the expression: grad (costFn ys xss)
>
> /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs:33:36:
> Could not deduce (a ~ ad-3.4:Numeric.AD.Internal.Types.AD s a)
> from the context (Floating a)
> bound by the type signature for
> testGrad2 :: Floating a => [a] -> [[a]] -> [a] -> [a]
> at /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs:32:14-53
> or from (Numeric.AD.Internal.Classes.Mode s)
> bound by a type expected by the context:
> Numeric.AD.Internal.Classes.Mode s =>
> [ad-3.4:Numeric.AD.Internal.Types.AD s a]
> -> ad-3.4:Numeric.AD.Internal.Types.AD s a
> at /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs:33:20-39
> `a' is a rigid type variable bound by
> the type signature for
> testGrad2 :: Floating a => [a] -> [[a]] -> [a] -> [a]
> at /Users/dom/Dropbox/Private/Whales/ADTypePuzzle.hs:32:14
> Expected type: [[ad-3.4:Numeric.AD.Internal.Types.AD s a]]
> Actual type: [[a]]
> In the second argument of `costFn', namely `xss'
> In the first argument of `grad', namely `(costFn ys xss)'
> In the expression: grad (costFn ys xss)
> Failed, modules loaded: none.
More information about the Haskell-Cafe
mailing list