Haskell列表理解速度不一致

Question

我正在尝试优化程序的执行速度,我遇到了一些有趣的结果,我希望有人可以回答.似乎在我的一个列表推导中做了一些小改动,大大改变了执行速度,但我不知道为什么.

这是我现在的程序.

import Data.Ord
import Control.Monad
import Data.Array
import Data.Ix
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List (minimumBy, foldl')


arrayMatrix lists = let rlen = length lists
                        clen = length $ head lists
                        r    = ((1,1), (rlen, clen))
                    in array r . zip (range r) $ concat lists

a_star start goal h m = search S.empty (S.singleton start) 
                        (M.singleton start (m ! start)) 
                        $ M.singleton start (m ! start + h ! start)
    where neighbors (r,c) = filter (inRange $ bounds m) [ (r-1,c), (r,c+1), (r+1,c) , (r,c-1)]
          search closed open gs fs
              | S.null open     = 0
              | current == goal = gs M.! goal
              | otherwise       = let open'   = S.delete current open
                                      closed' = S.insert current closed
                                      neighbs = [(n, ts) | n <- neighbors current, S.notMember n closed
                                                , let ts = gs M.! current + m ! n ]
                                      actionable = filter (\(n,ts) -> S.notMember n open' || ts < (gs M.! n)) neighbs
                                      (op',gs',fs') = foldl' (\(o,ng,nf) (n,ts) -> (S.insert n o, M.insert n ts ng, M.insert n (ts + h ! n) nf)) (open',gs,fs) actionable
                                  in search closed' op' gs' fs'
              where current = minimumBy (comparing (fs M.!)) $ S.toList open

main = do
  matrix <- liftM (arrayMatrix . map (read . ('[':) . (++"]")) . lines) 
            $ readFile "matrix.txt"
  let bds       = bounds matrix
      ulim      = snd bds
      heuristic = let m   = minimum $ elems matrix
                    in listArray bds . map (\(r,c) -> (uncurry (+) ulim)-r-c) $ range bds
  print $ a_star (1,1) ulim heuristic matrix

现在,程序在我的计算机上运行~350ms(用GHC 7.8.2 -O2编译)和Project Euler提供的matrix.txt.

如果我改变邻居

neighbs = [(n, ts) | n <- neighbors current, S.notMember n closed
          , let ts = gs M.! current + m ! n ]

至

neighbs = [(n, gs M.! current + m ! n) | n <- neighbors current, S.notMember n closed]

执行时间增加到1秒以上.
其他一些小改动,例如将下一行的过滤器移动到列表解析中会产生相同的结果:~1秒.
谁能解释为什么会这样？

编辑:似乎在早期版本的GHC上不会发生这种情况.我尝试了GHC 7.6.3并且每个都执行了相同的操作.

我已经ghc -O2 -ddump-simpl -dsuppress-all按照cdk的建议包含了来自运行的转储.我真的不知道我在看什么,所以如果有人能够解释,那将是一个很大的帮助,谢谢.

链接到两个转储

EDIT2(对Priyatham的回应):我认为不是这样的.我变了

neighbs = [(n, ts) | n <- neighbors current, S.notMember n closed
          , let ts = gs M.! current + m ! n ]
actionable = filter ((n,ts) -> S.notMember n open' || ts < (gs M.! n)) neighbs

至

neighbs = [(n, gs M.! current + m ! n) | n <- neighbors current, S.notMember n closed ]
actionable = filter ((n,!ts) -> S.notMember n open' || ts < (gs M.! n)) neighbs

使用BangPatterns,它仍然运行一秒钟.事实上,修改neigbs

neighbs = [(n, ts) | n <- neighbors current, S.notMember n closed
          , let ts = gs M.! current + m ! n ]

至

neighbs = [(n, ts) | n <- neighbors current, S.notMember n closed
          , let !ts = gs M.! current + m ! n ]  -- Added bang before ts

将运行时间增加到超过1秒.

Answer 1

这是对let ts =vs.发生的情况的一种猜测let !ts =。我通过查看-ddump-stranal（转储严格性分析注释）的输出并阅读GHC 中的需求分析器得到了它。

let !ts =和之间的区别let ts =在于，如果ts是 底部（即undefined），那么根本不会n被求值，因为将首先求值，然后求值将停止。两个程序之间的区别似乎在于，一对整数在一个版本中是严格的且未装箱的，但在另一个版本中则不然（请参阅和的输出；上面的链接描述了输出）。tsn-ddump-stranal-ddump-simpl

如何影响!ts或不!ts影响 的严格性n？我认为如果 ts是底部，那么程序在评估或其任何元素之前必须失败（我不确定它是它本身还是它的元素）。因此，当需要严格时， ghc 似乎做了正确的事情来保持 非严格，因为 首先评估并且可能在不同的地方失败可能是一个错误。nn :: (Int, Int)ntsn

接下来，如何强制!ts对 不产生影响n？请注意，如果 、 、或已知ts 不是底部（这些是表达式中除 之外的所有元素）并且已经被求值，那么如果不首先求值，则不能是底部（我认为，如果不首先评估它们的参数，可能永远不会是底部） 。所以我们需要强加一个条件“是底部意味着 是底部并且已经被评估”，以便 ghc 知道首先评估是安全的。ngscurrentmnM.!!tsnn

我的解决方案：将刘海图案添加到current、gs和m。对于我的 ghc 7.8.2，这似乎解决了问题。看来也只能current勉强了。

我不太确定关于将 的 表达式移动 ts到元组中的原始问题，但相同的解决方案似乎有效。

PS请注意

filter (\x -> x > 5) [x | x <- [1..10]] == [x | x <- [1..10], x > 5]

所以在你的列表中neighbs， actionable将过滤谓词带入列表理解本身会更干净，如下所示：

[(n, ts)
| n <- neighbors current
, S.notMember n closed
, let ts = gs M.! current + m ! n
, S.notMember n open' || ts < (gs M.! n)
]