I'm going through the "Programming in Haskell" book (second edition) and noticed that the "game of life" example is getting extremely slow after some iterations (it looks like it's getting exponentially slower with every iteration). I profiled it, but can't see anything suspicious in the prof
file.
I'm probably missing something obvious, can you help me figure out what it is?
Here's my code:
import System.IO
main = do
hSetBuffering stdout NoBuffering
life glider
type Position = (Int, Int)
type Board = [Position]
width :: Int
width = 10
height :: Int
height = 10
glider :: Board
glider = [(4,2),(2,3),(4,3),(3,4),(4,4)]
clear :: IO ()
clear = putStr "\ESC[2J"
writeAt :: Position -> String -> IO ()
writeAt position text = do
goto position
putStr text
goto :: Position -> IO ()
goto (x, y) = putStr ("\ESC[" ++ (show y) ++ ";" ++ (show x) ++ "H")
showCells :: Board -> IO ()
showCells board = sequence_ [writeAt singlePosition "0" | singlePosition <- board]
isAlive :: Board -> Position -> Bool
isAlive board position = elem position board
isEmpty :: Board -> Position -> Bool
isEmpty board position = not (isAlive board position)
neighbors :: Position -> [Position]
neighbors (x, y) =
[(x - 1, y - 1),
(x, y - 1),
(x + 1, y - 1),
(x - 1, y),
(x + 1, y),
(x - 1, y + 1),
(x, y + 1),
(x + 1, y + 1)]
wrap :: Position -> Position
wrap (x, y) =
(((x - 1) `mod` width) + 1,
((y - 1) `mod` height) + 1)
numberOfLiveNeighbors :: Board -> Position -> Int
numberOfLiveNeighbors board = length . filter (isAlive board) . neighbors
survivors :: Board -> [Position]
survivors board =
[singlePosition |
singlePosition <- board,
elem (numberOfLiveNeighbors board singlePosition) [2, 3]]
births :: Board -> [Position]
births board =
[singlePosition |
singlePosition <- removeDuplicates (concat (map neighbors board)),
isEmpty board singlePosition,
numberOfLiveNeighbors board singlePosition == 3]
removeDuplicates :: Eq a => [a] -> [a]
removeDuplicates [] = []
removeDuplicates (x:xs) = x:filter (/= x) xs
nextGeneration :: Board -> Board
nextGeneration board = (survivors board) ++ (births board)
life :: Board -> IO ()
life board = do
clear
showCells board
_ <- getChar
life (nextGeneration board)
And here's the prof
file:
Mon Apr 29 08:57 2019 Time and Allocation Profiling Report (Final)
Main.exe +RTS -p -RTS
total time = 0.00 secs (0 ticks @ 1000 us, 1 processor)
total alloc = 83,504 bytes (excludes profiling overheads)
COST CENTRE MODULE SRC %time %alloc
writeAt Main Main.hs:(30,1)-(32,15) 0.0 6.3
showCells Main Main.hs:38:1-82 0.0 1.8
life Main Main.hs:(86,1)-(90,31) 0.0 2.3
goto Main Main.hs:35:1-68 0.0 11.2
clear Main Main.hs:27:1-24 0.0 12.5
CAF GHC.IO.Exception <entire-module> 0.0 2.3
CAF GHC.IO.Handle.FD <entire-module> 0.0 62.4
individual inherited
COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc
MAIN MAIN <built-in> 109 0 0.0 0.8 0.0 100.0
CAF GHC.TopHandler <entire-module> 165 0 0.0 0.1 0.0 0.1
CAF GHC.IO.Handle.FD <entire-module> 145 0 0.0 62.4 0.0 62.4
CAF GHC.IO.Exception <entire-module> 143 0 0.0 2.3 0.0 2.3
CAF GHC.IO.Encoding.CodePage <entire-module> 136 0 0.0 0.2 0.0 0.2
CAF GHC.IO.Encoding <entire-module> 135 0 0.0 0.1 0.0 0.1
CAF Main <entire-module> 116 0 0.0 0.1 0.0 8.9
clear Main Main.hs:27:1-24 220 1 0.0 0.4 0.0 0.4
glider Main Main.hs:24:1-40 226 1 0.0 0.0 0.0 0.0
main Main Main.hs:(9,1)-(11,15) 218 1 0.0 0.1 0.0 8.4
life Main Main.hs:(86,1)-(90,31) 222 1 0.0 0.2 0.0 8.3
showCells Main Main.hs:38:1-82 225 1 0.0 1.8 0.0 8.1
writeAt Main Main.hs:(30,1)-(32,15) 228 5 0.0 0.7 0.0 6.3
goto Main Main.hs:35:1-68 230 5 0.0 5.6 0.0 5.6
main Main Main.hs:(9,1)-(11,15) 219 0 0.0 0.0 0.0 25.2
clear Main Main.hs:27:1-24 221 0 0.0 11.0 0.0 11.0
life Main Main.hs:(86,1)-(90,31) 223 0 0.0 2.0 0.0 14.2
clear Main Main.hs:27:1-24 224 0 0.0 1.1 0.0 1.1
showCells Main Main.hs:38:1-82 227 0 0.0 0.0 0.0 11.1
writeAt Main Main.hs:(30,1)-(32,15) 229 0 0.0 5.6 0.0 11.1
goto Main Main.hs:35:1-68 231 0 0.0 5.6 0.0 5.6
I printed length board
and in only a few steps it reached >1000 elements. Likely, you have many duplicates there that keep accumulating.
Indeed, you forgot the recursive call here:
removeDuplicates :: Eq a => [a] -> [a]
removeDuplicates [] = []
removeDuplicates (x:xs) = x:filter (/= x) (removeDuplicates xs)
-- ^^^^^^^^^^^^^^^^^^^ --
After this, the program became much faster.
Note that using lists for boards is quite suboptimal, and one should use arrays/vectors instead. Still, the bottleneck here was the number of duplicates which was exponentially blowing up, and even using lists it's still acceptable for reasonably small boards.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With