haskell - 为什么我的 Haskell 程序这么慢？ Haskell 编程，人生游戏

Question

我正在阅读“Haskell 编程”一书(第二版)，并注意到“生命游戏”示例在经过一些迭代后变得非常慢(看起来每次迭代都以指数方式变慢)。我对它进行了分析，但在 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

Answer 1

我打印了 length board只需几步，它就达到了 >1000 个元素。很可能，您那里有许多重复项不断累积。

确实，您在这里忘记了递归调用:

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

在此之后，程序变得更快了。

请注意，对板使用列表是非常不理想的，应该使用数组/向量代替。尽管如此，这里的瓶颈还是成倍增加的重复数量，即使使用列表，对于相当小的董事会来说仍然可以接受。