[Haskell-cafe] Memory Management and Lists

Tom Ellis tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk
Tue Jul 12 18:40:58 UTC 2016


I can't run this code because it's missing several things, including the
definition of Matrix and walk, and imports.

Certainly you are building up a large chain of thunks repeatedly applying
the calculation for nMatrix, but how to solve it I cannot say without more
information.

On Mon, Jul 11, 2016 at 07:01:24AM -0800, Christopher Howard wrote:
> -- I'm a bit embarrassed of this code because I haven't yet optimized
> -- the 'stamp' algorithm for reduced number of matrix operations. But
> -- even in this state I should think the memory requirements shouldn't
> -- exceed 1MB while generating the nth Matrix, unless Matrix n-1, n-2,
> -- etc. are being preserved in memory unnecessarily.
> 
> -- Monad Stack
> 
> type StateReader s c a = StateT s (Reader c) a
> 
> evalStateReader m s c = (runReader (evalStateT m s)) c
> 
> -- Helper function
> 
> type Point = (Float, Float)
> type Metric = Point -> Point -> Float
> 
> euclidean :: Metric
> euclidean (x1, y1) (x2, y2) = sqrt ((x2 - x1)**2 + (y2 - y1)**2)
> 
> -- monadic function. haven't had chance yet to optimize algorithm to
> -- reduce number of matrix operations
> 
> stamp = do radius <- ask
>            (oMatrix, walk) <- get
>            (wX, wY) <- (return . head) walk
>            let nMatrix = matrix (nrows oMatrix) (ncols oMatrix)
>                  (\(x, y) -> let (x', y') = (fromIntegral x, fromIntegral y)
>                              in if euclidean (x', y') (wX, wY) > radius
>                                 then getElem x y oMatrix
>                                 else getElem x y oMatrix + 1)
>              in put (nMatrix, tail walk) >> get
> 
> 
> 
> -- sequences and gathers results as list
> 
> stampingStates initMx radius walk =
>   map fst $ evalStateReader (sequence (repeat stamp)) (initMx, walk) radius
> 
> 
> -- Some quick experimentation code. h is the list
> 
> h = stampingStates initMx radius walk'
>   where initMx = zero 250 250
>         radius = 40
>         walk' = walk 40 (125, 125) (mkStdGen 31415)
> 
> -- get 2001st Matrix and convert to Gloss Picture, employing
> -- some color interpretation code
> 
> intensityG = let mx = head (drop 2000 h)
>              in toImage mx (lightnessInt 272 (minMax mx))
> 
> 
> On 07/10/2016 10:30 AM, Tom Ellis wrote:
> > On Sun, Jul 10, 2016 at 07:41:31AM -0800, Christopher Howard wrote:
> >> issue: a Matrix itself should only be, I'm guessing, somewhere around
> >> 100KB. But instead I'm maxing out the 3GB of RAM on my old T60 laptop.
> >> Maybe I'm generating list elements (Matrices) a lot faster than memory
> >> management is releasing them...?
> > 
> > You have almost certainly got a space leak.  Can you post your code?


More information about the Haskell-Cafe mailing list