[Haskell-cafe] Define variable types

Martijn van Steenbergen martijn at van.steenbergen.nl
Thu Feb 5 07:41:39 EST 2009


Hallo Tsunkiet,

Looking at

http://www.cs.uu.nl/wiki/bin/view/Helium/ATourOfTheHeliumPrelude

it seems you're looking for the /. operator, which is division on 
floating points. The / you're using only works on integers.

Groetjes,

Martijn.


Tsunkiet Man wrote:
> Hello,
>  
> I'm new to Haskell and it seems like a very nice language to learn. 
> However I'm not really familiar with the errormessages it produces. I am 
> using a Helium interpreter. I've created the following module (however 
> it is just a small sketch). I've written the following code:
>  
> fac :: Int -> Int
> fac n = product[1..n]
>  
> boven :: Int -> Int -> Int
> boven n k = (fac n) `div` fac k * fac (n-k)
>  
> bin :: Int -> Int -> Int -> Int
> bin n k p   |(n-k)>0 && k>0 = (boven n k) * (p^k) * (1-p)^(n-k)
>             |(n-k)<0 && k>0 = (boven n k) * (p^k) * (1/((1-p)^(-(n-k))))
>             |(n-k)<0 && k<0 = (boven n k) * (1/(p^(-k))) * 
> (1/((1-p)^(-(n-k))))
>  
> When I load this into my interpreter it says:
>  
> Compiling ./Test.hs
> (11,55): Type error in infix application
>  expression       : 1 / ((1 - p) ^ (-(n - k)))
>  operator         : /
>    type           : Float -> Float -> Float
>    does not match : Int   -> Int   -> Int 
> (12,47): Type error in infix application
>  expression       : 1 / (p ^ (-k))
>  operator         : /
>    type           : Float -> Float -> Float
>    does not match : Int   -> Int   -> a   
> (12,62): Type error in infix application
>  expression       : 1 / ((1 - p) ^ (-(n - k)))
>  operator         : /
>    type           : Float -> Float -> Float
>    does not match : Int   -> Int   -> a   
> Compilation failed with 3 errors
>  
> Some details that might be usefull:
>  
> Line 11 is |(n-k)<0 && k>0 = (boven n k) * (p^k) * (1/((1-p)^(-(n-k))))
> Line 12 is |(n-k)<0 && k<0 = (boven n k) * (1/(p^(-k))) * 
> (1/((1-p)^(-(n-k))))
>  
> So my question is: how can I fix these errors?
>  
> (I used these lines of codes because it is not possible to use a 
> negative exponent in the Helium interpreter.)
>  
> Thank you for answering my question!
>  
> Greetings JTKM
> 
> 
> ------------------------------------------------------------------------
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list