<p dir="ltr">Just out of curiosity, what is the advantage to using a newtype in this case when you will not be writing your own instances of typeclasses?</p>
<br><div class="gmail_quote"><div dir="ltr">On Mon, Jul 11, 2016, 15:56 David Feuer <<a href="mailto:david.feuer@gmail.com">david.feuer@gmail.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><p dir="ltr">Please repost your code, giving a type signature for each top-level binding. Without them, the code is very difficult to follow. I also strongly recommend using a newtype for your custom monad. Something like this:</p>
<p dir="ltr">{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, ... #-}</p>
<p dir="ltr">newtype StateReader s c a = SR {runSR :: StateT s (Reader c) a} deriving (Functor, Applicative, Monad)</p>
<p dir="ltr">deriving instance MonadReader c (StateReader s c)<br>
deriving instance MonadState s (StateReader s c)</p>
<div class="gmail_quote">On Jul 11, 2016 11:07 AM, "Christopher Howard" <<a href="mailto:ch.howard@zoho.com" target="_blank">ch.howard@zoho.com</a>> wrote:<br type="attribution"><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">-- I'm a bit embarrassed of this code because I haven't yet optimized<br>
-- the 'stamp' algorithm for reduced number of matrix operations. But<br>
-- even in this state I should think the memory requirements shouldn't<br>
-- exceed 1MB while generating the nth Matrix, unless Matrix n-1, n-2,<br>
-- etc. are being preserved in memory unnecessarily.<br>
<br>
-- Monad Stack<br>
<br>
type StateReader s c a = StateT s (Reader c) a<br>
<br>
evalStateReader m s c = (runReader (evalStateT m s)) c<br>
<br>
-- Helper function<br>
<br>
type Point = (Float, Float)<br>
type Metric = Point -> Point -> Float<br>
<br>
euclidean :: Metric<br>
euclidean (x1, y1) (x2, y2) = sqrt ((x2 - x1)**2 + (y2 - y1)**2)<br>
<br>
-- monadic function. haven't had chance yet to optimize algorithm to<br>
-- reduce number of matrix operations<br>
<br>
stamp = do radius <- ask<br>
           (oMatrix, walk) <- get<br>
           (wX, wY) <- (return . head) walk<br>
           let nMatrix = matrix (nrows oMatrix) (ncols oMatrix)<br>
                 (\(x, y) -> let (x', y') = (fromIntegral x, fromIntegral y)<br>
                             in if euclidean (x', y') (wX, wY) > radius<br>
                                then getElem x y oMatrix<br>
                                else getElem x y oMatrix + 1)<br>
             in put (nMatrix, tail walk) >> get<br>
<br>
<br>
<br>
-- sequences and gathers results as list<br>
<br>
stampingStates initMx radius walk =<br>
  map fst $ evalStateReader (sequence (repeat stamp)) (initMx, walk) radius<br>
<br>
<br>
-- Some quick experimentation code. h is the list<br>
<br>
h = stampingStates initMx radius walk'<br>
  where initMx = zero 250 250<br>
        radius = 40<br>
        walk' = walk 40 (125, 125) (mkStdGen 31415)<br>
<br>
-- get 2001st Matrix and convert to Gloss Picture, employing<br>
-- some color interpretation code<br>
<br>
intensityG = let mx = head (drop 2000 h)<br>
             in toImage mx (lightnessInt 272 (minMax mx))<br>
<br>
<br>
On 07/10/2016 10:30 AM, Tom Ellis wrote:<br>
> On Sun, Jul 10, 2016 at 07:41:31AM -0800, Christopher Howard wrote:<br>
>> issue: a Matrix itself should only be, I'm guessing, somewhere around<br>
>> 100KB. But instead I'm maxing out the 3GB of RAM on my old T60 laptop.<br>
>> Maybe I'm generating list elements (Matrices) a lot faster than memory<br>
>> management is releasing them...?<br>
><br>
> You have almost certainly got a space leak.  Can you post your code?<br>
> _______________________________________________<br>
> Haskell-Cafe mailing list<br>
> To (un)subscribe, modify options or view archives go to:<br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
> Only members subscribed via the mailman list are allowed to post.<br>
><br>
<br>
--<br>
<a href="http://qlfiles.net" rel="noreferrer" target="_blank">http://qlfiles.net</a><br>
To protect my privacy, please use PGP encryption. It's free and easy<br>
to use! My public key ID is 0x340EA95A (<a href="http://pgp.mit.edu" rel="noreferrer" target="_blank">pgp.mit.edu</a>).<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div>