[Haskell-cafe] Typing problem
Daniel Fischer
daniel.is.fischer at googlemail.com
Mon Jan 31 19:38:22 CET 2011
On Monday 31 January 2011 18:29:59, michael rice wrote:
> I'm mapping a function over a list of data, where the mapping function
> is determined from the data.
>
> g f l = map (g l) l
g f l = map (f l) l
probably
>
> So
>
> g serialize "prolog" -> [4,5,3,2,3,1]
>
> But I'm having typing problems trying to do a similar thing with a
> function that statistically normalizes data.
>
> See:
> http://people.revoledu.com/kardi/tutorial/Similarity/Normalization.html#
>Statistic
>
> So
>
> g normalize [2,5,3,2] ->
> [-0.7071067811865475,1.414213562373095,0.0,-0.7071067811865475]
>
> Is my typing for normalize too loose.
You can omit the type signatures and see what the compiler infers as the
type. In this case,
> normalize :: (Num a, Num b) => [a] -> a -> b
> normalize l = let (total,len) = sumlen l
> avg = total/len
> stdev = sqrt $ ((/) (len-1)) $ sum $ map ((** 2.0) .
> (subtract avg)) l in ((/) stdev) . (subtract avg)
In the final result, I suppose it should be (/ stdev) and not ((/) stdev)
[the latter is (stdev /), i.e. \x -> stdev / x].
by sumlen's type, len has an Integral type. You want to use (/) to divide,
which gives a Fractional constraint,
(/) :: Fractional a => a -> a -> a
Since it is not sensible for a type to be a member of both, the Fractional
and Integral classes, you should convert len to the appropriate type with
fromIntegral. For stdev, you call
sqrt :: Floating a => a -> a
and
(**) :: Floating a => a -> a
which means the list elements must have a type belonging to Floating
(you could replace the (** 2.0) with (^ 2), which would probably be better,
but the Floating constraint remains due to the sqrt).
Finally, the resulting function is \x -> (x - avg) / stdev, hence x must
have the same type as abg and stdev, and the final result has the same
type. Altogether,
normalize :: Floating a => [a] -> a -> a
normalize l =
let (total, len0) = sumlen l
len = fromIntegral len0
avg = total/len
stdev = sqrt $ sum [(x-avg)^2 | x <- l] / (len-1)
in (/ stdev) . subtract avg
but that gives nonsense if you pass a complex-valued list, so it might be
better to restrict the type to
normalize :: RealFloat a => [a] -> a -> a
> Should I be using Floating rather than Num?
You have to, and one number type only (well, you could use two or three
types if you compose with conversion functions, realToFrac for example).
More information about the Haskell-Cafe
mailing list