为什么我的 haskell 程序这么慢? Haskell 编程,人生游戏

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

我正在阅读 "Programming in Haskell" 书(第二版)并注意到 "game of life" 示例在一些迭代后变得非常慢(看起来每次迭代都以指数方式变慢) .我分析了它,但在 prof 文件中看不到任何可疑的东西。

我可能遗漏了一些明显的东西,你能帮我弄清楚是什么吗?

这是我的代码:

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)

这是 prof 文件:

    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

我打印了 length board 并且只用了几步就达到了 >1000 个元素。很可能,你在那里有很多重复的东西不断积累。

确实,你忘记了这里的递归调用:

removeDuplicates :: Eq a => [a] -> [a]
removeDuplicates [] = []
removeDuplicates (x:xs) = x:filter (/= x) (removeDuplicates xs)
                                        -- ^^^^^^^^^^^^^^^^^^^ --

之后,程序变得更快了。

请注意,为看板使用列表并不是最佳选择,应该改用 arrays/vectors。不过,这里的瓶颈是重复的数量呈指数级增长,即使使用列表,对于相当小的板来说仍然是可以接受的。