Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Why is my haskell program so slow? Programming in Haskell, game of life

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
like image 784
Piotr Justyna Avatar asked Apr 29 '19 08:04

Piotr Justyna


1 Answers

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.

like image 189
chi Avatar answered Nov 15 '22 03:11

chi