[Haskell-cafe] ghci stack overflow
Daniel Fischer
daniel.is.fischer at web.de
Mon Nov 20 10:37:06 EST 2006
Hi Jim,
Am Montag, 20. November 2006 01:13 schrieb jim burton:
> This code produces a stack overflow in ghci when I call `makeSpiral' with
> large values, e.g. big enough to produce a 1001x1001 spiral. (makeSpiral
> produces a list of lists which form a clockwise 'spiral', it's a puzzle
> from mathschallenge.net.)
Problem 28 of Project Euler, I believe? If you stick to that approach for
problem 58, you'll have trouble again.
>
> I'm sure there is a way to increase the stack space in ghc which I will
> look into, but is there a way I could avoid the problem in the first place
> by attacking the problem differently?
Definitely. Just take a pen and a piece of paper and figure out which numbers
appear in the corners of a (2m+1)x(2m+1) spiral (write those numbers in terms
of m), prove the correctness of your result via induction and you'll be done
(it'll be certainly helpful to know the formulae for
sum [n^k | n <- [1 .. bound]] for small exponents k).
> Does stack space run out because the
> list is an argument being passed around (1001x1001 versions of it)? If so
> would the state monad help me?
I think the stack overflow is due to creating a lot of thunks, possibly
strictness could help, but you'd still use a fat lot of memory for keeping
the whole spiral (1001 lists of length 1001 will need roughly 4MB just for
the Ints, plus list-overhead..., probably you'd be better off if you used a
mutable unboxed array, say
spiral :: UArray (Int,Int) Int
spiral = runSTUArray
( do sp <- newArray ((-500,-500),(500,500)) 0
fill your array here
return sp)
) but even that would need a _huge_ memory for problem 58.
HTH,
Daniel
>
> data Dir = R | D | L | U deriving (Show, Eq, Enum)
> type Spiral = ([[Int]], Int, Dir) -- (rows, current row, next direction)
>
> rows :: Spiral -> [[Int]]
> rows (rs, i, d) = rs
> currentrow :: Spiral -> Int
> currentrow (rs, i, d) = i
> nextdir :: Spiral -> Dir
> nextdir (rs, i, d) = d
>
> getrow :: Int -> [[Int]] -> Maybe [Int]
> getrow i sp = if i < 0 || i >= length sp then Nothing else Just (sp!!i)
>
> ndir :: Dir -> Dir
> ndir d = if d == U then R else succ d
>
> newsp :: Spiral
> newsp = ([[1]], 0, R)
>
> makeSpiral :: Int -> Spiral
> makeSpiral i = makeSpiral' 2 newsp
> where makeSpiral' j sp = if j > i
> then sp
> else makeSpiral' (j+1) (update j sp)
>
> update :: Int -> Spiral -> Spiral
> update i (sp, cr, d) = (sp', cr', d')
> where oldrow = if (d == U && cr' == cr && cr == 0) ||
> (d == D && cr' == length sp)
> then []
> else fromJust $ getrow cr' sp
> cr' | d == L || d == R = cr
>
> | d == U = if cr == 0 then 0 else cr-1
> | otherwise = cr+1
>
> cr'' = if d == U && cr == 0 then -1 else cr'
> sp' = insertrow cr'' newrow sp
> newrow = case d of
> R -> oldrow++[i]
> D -> oldrow++[i]
> L -> i:oldrow
> U -> i:oldrow
> d' | d == R || d == L = if length oldrow == maximum (map length
> sp)
> then ndir d
> else d
>
> | d == U = if cr'' == -1 then ndir d else d
> | otherwise = if cr' == length sp then ndir d else d
>
> insertrow :: Int -> [Int] -> [[Int]] -> [[Int]]
> insertrow i r rs = if i == -1 then r:rs else front++[r]++back
> where (front, rest) = splitAt i rs
> back = if null rest then [] else tail rest
>
> printSpiral :: Spiral -> IO ()
> printSpiral (sp, i, d) = putStrLn (concat $ intersperse "\n" (map show sp))
>
> sumdiags :: Spiral -> Int
> sumdiags (sp, i, d) = (sumdiags' 0 0 (+1)) + (sumdiags' 0 end (subtract 1))
> - centre
> where row1 = sp!!0
> end = length row1 - 1
> halfx = (length row1 `div` 2)
> halfy = (length sp `div` 2)
> centre = (sp!!halfy)!!halfx
> sumdiags' row col f = if row == length sp
> then 0
> else (sp!!row)!!col + sumdiags' (row+1) (f
> col) f
More information about the Haskell-Cafe
mailing list