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

Posted

技术标签:

【中文标题】为啥我的haskell程序这么慢? Haskell 编程,人生游戏【英文标题】:Why is my haskell program so slow? Programming in Haskell, game of life为什么我的haskell程序这么慢? Haskell 编程,人生游戏 【发布时间】:2019-04-29 08:48:57 【问题描述】:

我正在阅读“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

【问题讨论】:

也许这更适合codereview.stackexchange.com? "Exponentially slow" 暗示了一个惰性错误。但是,您会认为打印出整个电路板可以巧妙地避免这个问题。此外,配置文件说程序运行了“0.00 秒”,这似乎有点短。嗯…… 感谢您的 cmets。我同意,它更适合代码审查。把它移到那里:codereview.stackexchange.com/questions/219355/…(接近投票是我的) 您不应该使用列表来代替数组是更好的选择。在本节末尾查看一个极快的 Game of Life 实现:github.com/lehins/massiv#stencil 【参考方案1】:

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

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

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

在这之后,程序变得更快了。

请注意,对板子使用列表是非常不理想的,应该使用数组/向量来代替。尽管如此,这里的瓶颈是重复的数量呈指数级增长,即使使用列表,对于相当小的板来说它仍然是可以接受的。

【讨论】:

以上是关于为啥我的haskell程序这么慢? Haskell 编程,人生游戏的主要内容,如果未能解决你的问题,请参考以下文章

Haskell Thrift 库在性能测试中比 C++ 慢 300 倍

为啥这个 Haskell 程序表现如此糟糕?

为啥我的 Haskell 函数参数必须是 Bool 类型?

在 Haskell 中,为啥没有 TypeClass 用于可以像列表一样的东西?

为啥这个 Haskell 程序会产生反斜杠?

为啥我的 Haskell 代码与 Swift 和 C 相比如此缓慢 [重复]