<table cellspacing="0" cellpadding="0" border="0" ><tr><td valign="top" style="font: inherit;">I'm mapping a function over a list of data, where the mapping function is<br>determined from the data.<br><br>g f l = map (g l) l<br><br>So<br><br>g serialize "prolog" -> [4,5,3,2,3,1]<br><br>But I'm having typing problems trying to do a similar thing with a function<br>that statistically normalizes data.<br><br>See:<br>http://people.revoledu.com/kardi/tutorial/Similarity/Normalization.html#Statistic<br><br>So<br><br>g normalize [2,5,3,2] -> [-0.7071067811865475,1.414213562373095,0.0,-0.7071067811865475]<br><br>Is my typing for normalize too loose. Should I be using Floating rather than Num?<br><br>Michael<br><br>=======Code==============<br>{-<br>See Problem 42, pg. 63, Prolog by Example, Coelho & Cotta<br><br>Generate a list of serial numbers for the items of a given list,<br>the members of which are to be numbered in
alphabetical order.<br><br>*Main> serialize "prolog"<br>[4,5,3,2,3,1]<br>*Main> serialize "int.artificial"<br>[5,7,9,1,2,8,9,5,4,5,3,5,2,6]<br><br>*Main> ["prolog"] >>= serialize<br>[4,5,3,2,3,1]<br>*Main> ["int.artificial"] >>= serialize<br>[5,7,9,1,2,8,9,5,4,5,3,5,2,6]<br>-}<br><br>import Data.Map hiding (map)<br>import Data.List<br><br>{-<br>serialize :: [Char] -> [Int]<br>serialize l = map (f l) l <br> where<br> f = ((!) . fromList . ((flip zip) [1..]) . (sort . nub))<br>-}<br><br>serialize :: (Ord a, Integral b) => [a] -> a -> b<br>serialize = ((!) . fromList . ((flip zip) [1..]) . (sort . nub))<br><br>g f l = map (f l) l<br><br>normalize :: (Num a, Num b) => [a] -> a -> b<br>normalize l = let (total,len) = sumlen
l<br> avg = total/len<br> stdev = sqrt $ ((/) (len-1)) $ sum $ map ((** 2.0) . (subtract avg)) l<br> in ((/) stdev) . (subtract avg) <br> <br>sumlen :: (Num a, Integral b) => [a] -> (a,b)<br>sumlen l = sumlen' l 0 0<br> where sumlen' [] sum len = (sum,len)<br> sumlen' (h:t) sum len = sumlen' t (sum+h) (len+1)<br>=========================<br><br>Prelude> :r<br>[1 of 1] Compiling
Main ( serialize2.hs, interpreted )<br><br>serialize2.hs:34:32:<br> Could not deduce (Integral a) from the context (Num a, Num b)<br> arising from a use of `sumlen' at serialize2.hs:34:32-39<br> Possible fix:<br> add (Integral a) to the context of<br> the type signature for `normalize'<br> In the expression: sumlen l<br> In a pattern binding: (total, len) = sumlen l<br> In the expression:<br> let<br> (total, len) = sumlen l<br> avg = total / len<br> stdev =
sqrt<br> $ ((/) (len - 1)) $ sum $ map ((** 2.0) . (subtract avg)) l<br> in (/ stdev) . (subtract avg)<br><br>serialize2.hs:36:61:<br> Could not deduce (Floating a) from the context (Num a, Num b)<br> arising from a use of `**' at serialize2.hs:36:61-66<br> Possible fix:<br> add (Floating a) to the context of<br> the type signature for `normalize'<br> In the first argument of `(.)', namely `(** 2.0)'<br> In the first argument of `map', namely<br> `((** 2.0) . (subtract avg))'<br> In the second argument of `($)', namely<br> `map ((** 2.0) .
(subtract avg)) l'<br><br>serialize2.hs:37:18:<br> Couldn't match expected type `b' against inferred type `a'<br> `b' is a rigid type variable bound by<br> the type signature for `normalize' at serialize2.hs:33:25<br> `a' is a rigid type variable bound by<br> the type signature for `normalize' at serialize2.hs:33:18<br> In the expression: (/ stdev) . (subtract avg)<br> In the expression:<br> let<br> (total, len) = sumlen l<br> avg = total / len<br> stdev =
sqrt<br> $ ((/) (len - 1)) $ sum $ map ((** 2.0) . (subtract avg)) l<br> in (/ stdev) . (subtract avg)<br> In the definition of `normalize':<br> normalize l = let<br> (total, len) = sumlen l<br> avg = total / len<br>
....<br> in (/ stdev) . (subtract avg)<br>Failed, modules loaded: none.<br><br></td></tr></table><br>