Haskell program out of memory (infinite recursion? Loop? Something?)

EDIT: Updated to include all code.

I am new to Haskell and I have a problem with a program that I wrote to do some entropy calculations for assigning a course (assignment is computing, using Haskell is a choice, I don’t ask someone to do my homework for me, it took me would be a trivial amount of time and effort to do this in Python). The code accepts a 1D array:

--- first input (length 2): 
---     0,0   0,1   1,0   1,1
---    [.48,  .02,  .02,  .48]
--- or:
---     0    1   
---    .48  .02  0
---               
---    .02  .48  1

Then I defined a couple of common functions:

log2 :: Float -> Float
log2 x =
  logBase 2 x

entropy :: [Float] -> Float
entropy probArray =
  sum(map (\i -> (i * (log2 (1/i)))) probArray)

As well as functions for each specific calculation:

-- calculate joint entropy
jointEntropy :: [Float] -> Float
jointEntropy probArray =
  entropy probArray

-- calculate entropy of X
splitByCol :: Int -> [Float] -> [[Float]]
splitByCol length probArray =
  [(take length probArray)] ++ (splitByCol length (drop length probArray))

xEntropy :: Int -> [Float] -> Float
xEntropy length probArray =
  entropy (map sum (splitByCol length probArray))

-- calculate entropy of Y
ithElements :: Int -> Int -> [Float] -> [Float]
ithElements level length matrixArray =
  let indexArray = zip [0..(length^2 - 1)] matrixArray
  in [snd x | x <- indexArray, fst x `mod` length == level]

splitByRow :: Int -> Int -> [[Float]] -> [[Float]]
splitByRow level length lists =
  if level == length
  then
    tail lists -- return list sans full matrix array which was being carried at the front
  else
    splitByRow (level+1) length (lists ++ [(ithElements level length (lists !! 0))]) 

yEntropy :: Int -> [Float] -> Float
yEntropy length probArray =
  entropy (map sum (splitByRow 0 length [probArray]))

--calculate mutual information
mutualInfo :: Float -> Float -> Float
mutualInfo xEnt yEnt =
  xEnt - yEnt

-- calculate conditional of X given Y - (X|Y)
xCond :: Float -> Float -> Float
xCond xEnt mInfo =
  xEnt - mInfo

-- calculate conditional of Y given X - (Y|X)
yCond :: Float -> Float -> Float
yCond yEnt mInfo =
  yEnt - mInfo

They then join together to return an array with each of the calculations I wanted to perform:

-- caller functions -> resArray ends up looking like [H(X,Y), H(X), H(Y), I(X;Y), H(X|Y), H(Y|X)]
calcJointEnt :: [Float] -> [Float]
calcJointEnt probArray =
  calcVarEnt probArray [(jointEntropy probArray)]

calcVarEnt :: [Float] -> [Float] -> [Float]
calcVarEnt probArray resArray =
  let len = floor (sqrt (fromIntegral (length probArray)))
  in calcMutual probArray (resArray ++ [(xEntropy len probArray), (yEntropy len probArray)])

calcMutual :: [Float] -> [Float] -> [Float]
calcMutual probArray resArray =
  calcCond probArray (resArray ++ [(mutualInfo (resArray !! 1) (resArray !! 2))])

calcCond :: [Float] -> [Float] -> [Float]
calcCond probArray resArray =
  resArray ++ [(xCond (resArray !! 1) (resArray !! 3)), (yCond (resArray !! 2) (resArray !! 3))]

And so on ... I then have some functions for formatting the print string and the main function to collect all of this:

-- prepare printout
statString :: (String, String) -> String
statString t =  
  (fst t) ++ ": " ++ (snd t)

printOut :: [Float] -> String
printOut resArray =
  let statArray = zip ["H(X,Y)", "H(X)", "H(Y)", "H(X;Y)", "H(X|Y)", "H(Y|X)"] (map show resArray)
  in "results:\n\t" ++ intercalate "\n\t" (map statString statArray) ++ "\n\n---\n"

-- main
main :: IO()
main = 
  let inputs = [[0.48,  0.02,  0.02,  0.48], [0.31,  0.02,  0.00,  0.02,  0.32,  0.02,  0.00,  0.02,  0.29]]
  in putStrLn (intercalate "" (map printOut (map calcJointEnt inputs)))

, , , , haskell , esqe, .

, , :

bash-4.2$ ./noise 
results:
    H(X,Y): 1.2422923
noise: out of memory (requested 1048576 bytes)

. ghci ( ), , , resArray printOut, , resArray :

calcCond :: [Float] -> [Float] -> [Float]
calcCond probArray resArray =
  resArray ++ [(xCond (resArray !! 1) (resArray !! 3)), (yCond (resArray !! 2) (resArray !! 3))]

:

[noise.hs:101:3-96] *Main> seq _t1 ()
()
[noise.hs:101:3-96] *Main> :print resArray
resArray = (_t2::Float) : (_t3::[Float])
[noise.hs:101:3-96] *Main> seq _t2 ()
()
[noise.hs:101:3-96] *Main> :print resArray
resArray = 1.2422923 : (_t4::[Float])
[noise.hs:101:3-96] *Main> seq _t3 ()
()
[noise.hs:101:3-96] *Main> :print resArray
resArray = 1.2422923 : (_t5::Float) : (_t6::[Float])
[noise.hs:101:3-96] *Main> seq _t5 ()
^C^C^C^C^CInterrupted.
[noise.hs:101:3-96] *Main> 

RTS, , , , + RTS -xc, . , RTS, , , , , ?

, , , , , IO - , , - . , , , , , . , ( , Haskell), .

+3
1

H(X) , , , .. xEntropy. xEntropy splitByCol, . ! , entropy , sum .

0

All Articles