I have a program that, to all appearances, is behaving properly. It uses
very little memory to run, it has the profile I would expect looking at
+RTS -hc. I have no reason to believe there is a memory leak (in the sense
that it's not lazily holding on to things it no longer needs or strictly
generating things it doesn't need yet). But it's slow, and according to
-sstderr, most of the time is spent garbage-collecting.
Why is the garbage-collector consuming so much running time? How can I deal
with it?
The program is a solution to this problem:
https://open.kattis.com/problems/tourist
The input data can be found here:
http://heim.ifi.uio.no/~db/nm-i-programmering/nm2004/testdata/h.in
module Main(main) where
import Control.DeepSeq
import Control.Monad
import Data.Array
import Data.List
type Col = Int
newtype MInt = M {fromM :: Int}
deriving (Eq, Ord)
instance NFData MInt
main::IO()
main = do
numCases <- readLn
replicateM_ numCases doProb
doProb :: IO()
doProb = do
[width,height] <- liftM (map read . words) getLine :: IO [Int]
rows <- replicateM height getLine
let rowArrays = map (listArray (1, width)) rows
let initPoints =
listArray
((1, 1), (width, width))
(m0 : repeat mnone) :: Scores
let resPoints = foldl' maxPoints initPoints rowArrays
print . fromM $ resPoints ! (width, width)
type Scores = Array (Col, Col) MInt
type GridRow = Array Col Char
maxPoints :: Scores -> GridRow -> Scores
maxPoints curVals gr = force x1x2
where
(_, width) = bounds gr
blocked :: Col -> Bool
blocked c = gr ! c == '#'
grVal :: Col -> MInt
grVal = getVal . (gr !)
grVal1 :: (Col, Col) -> MInt
grVal1 (c1, c2)
| blocked c1 = mnone
| c1 < c2 = grVal c1
| otherwise = m0
grVal2 :: (Col, Col) -> MInt
grVal2 (_, c2) = grVal c2
i1i2 :: Scores
i1i2 = mapWithIdx go curVals
where
go :: (Col, Col) -> MInt -> MInt
go pr = ((grVal1 pr +^ grVal2 pr) +^)
computeNext :: Scores -> ((Col, Col) -> MInt) -> Scores
computeNext prev fun = funArray ((1,1),(width,width)) go
where
go (c1, c2) =
max
(prev ! (c1, c2))
(fun (c1, c2))
x1i2 :: Scores
x1i2 =
computeNext i1i2 go
where
go pr@(i, j) =
x1i2 !^ (i - 1, j) +^ grVal1 pr
x1x2 =
computeNext x1i2 go
where
go pr@(i, j) =
x1x2 !^ (i, j - 1) +^ grVal2 pr
funArray :: Ix i => (i, i) -> (i -> e) -> Array i e
funArray bs f = listArray bs . map f $ range bs
(!^) :: Ix ix => Array ix MInt -> ix -> MInt
(!^) arr i
| inRange (bounds arr) i = arr ! i
| otherwise = mnone
m0 :: MInt
m0 = M 0
mnone :: MInt
mnone = M (-1)
(+^) :: MInt -> MInt -> MInt
M (-1) +^ _ = mnone
_ +^ M (-1) = mnone
M x +^ M y = M (x + y)
infixl 6 +^
mapWithIdx :: Ix i => (i -> a -> b) -> Array i a -> Array i b
mapWithIdx f arr = listArray (bounds arr) . map (uncurry f) $ assocs arr
getVal :: Char -> MInt
getVal '#' = M (-1)
getVal '*' = M 1
getVal '.' = M 0
getVal _ = error "Unrecognized char"
_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
