[Haskell-cafe] Array use breaks when I make it unboxed?

Phil pbeadling at mail2web.com
Sat Feb 21 19:49:49 EST 2009


Hi,

The code below compiles fine as it is, but if I change the import statement
to:

import Data.Array.Unboxed

I get the following error:

philip-beadlings-imac-g5:MonteCarlo phil$ ghc -O2 --make test.hs
[2 of 5] Compiling InverseNormal    ( InverseNormal.hs, InverseNormal.o )

InverseNormal.hs:28:38:
    No instance for (IArray a1 Double)
      arising from a use of `!' at InverseNormal.hs:28:38-40
    Possible fix: add an instance declaration for (IArray a1 Double)
    In the first argument of `(*)', namely `c ! 1'
    In the first argument of `(+)', namely `c ! 1 * q'
    In the first argument of `(*)', namely `(c ! 1 * q + c ! 2)'

....and so on


My understanding is that I should just be able to use them like-for-like?
Anyone seen this before?

Thanks,

Phil.


module InverseNormal
    where

import Array

a = listArray (1,6) [-3.969683028665376e+01, 2.209460984245205e+02,
                     -2.759285104469687e+02, 1.383577518672690e+02,
                     -3.066479806614716e+01, 2.506628277459239e+00]
    
b = listArray (1,5) [-5.447609879822406e+01, 1.615858368580409e+02,
                     -1.556989798598866e+02, 6.680131188771972e+01,
                     -1.328068155288572e+01]

c = listArray (1,6) [-7.784894002430293e-03, -3.223964580411365e-01,
                     -2.400758277161838e+00, -2.549732539343734e+00,
                     4.374664141464968e+00,  2.938163982698783e+00]
    
d = listArray (1,4) [7.784695709041462e-03,  3.224671290700398e-01,
                     2.445134137142996e+00,  3.754408661907416e+00]

invnorm :: Double -> Double
invnorm p | p < 0.02425 = let q = sqrt ( -2*log(p) )
                         in (((((c!1*q+c!2)*q+c!3)*q+c!4)*q+c!5)*q+c!6) /
((((d!1*q+d!2)*q+d!3)*q+d!4)*q+1)
                   
          | p > (1-0.02425) = let q = sqrt ( -2*log(1-p) )
                             in -(((((c!1*q+c!2)*q+c!3)*q+c!4)*q+c!5)*q+c!6)
/ ((((d!1*q+d!2)*q+d!3)*q+d!4)*q+1)

          | otherwise = let q = p-0.5
                            r = q*q
                            in (((((a!1*r+a!2)*r+a!3)*r+a!4)*r+a!5)*r+a!6)*q
/ (((((b!1*r+b!2)*r+b!3)*r+b!4)*r+b!5)*r+1)


-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090222/5628da5a/attachment.htm


More information about the Haskell-Cafe mailing list