为什么replicateM (length xs) m 比sequenceA (fmap (const m) xs) 更高效？

Question

我对编程问题的两次提交仅在一个表达式上有所不同（其中anchors是一个非空列表，(getIntegrals n)是一个状态单子）：

提交1．replicateM (length anchors - 1) (getIntegrals n)

提交 2 .sequenceA $ const (getIntegrals n) <$> tail anchors

我想，这两个表达式的等价性在编译时本身应该很容易看出。然而，相对而言，速度sequenceA较慢，更重要的是，占用 >10 倍的内存：

代码	时间	记忆
复制M一	732 毫秒	22200 KB
序列A一	1435 毫秒	262100 KB

^{（第二个条目出现“测试 4 超出内存限制”错误，因此情况可能更糟）。}

为什么会这样呢？

预测哪些优化是自动的、哪些不是自动的变得非常困难！

编辑：按照建议，粘贴下面的提交 1代码。在这个交互问题中，“服务器”有一个大小为 的隐藏树n。我们的代码的工作是通过最少数量的 形式的查询来找出该树? k。宽松地说，服务器的响应是树的邻接距离矩阵中? k节点对应的行。我们的选择是：最初，然后从 获得一堆节点。kk1getAnchors

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}

import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Builder.Extra (flush) 
import System.IO

type St = StateT [B8.ByteString] Identity

solve :: St Bu.Builder
solve = do
  n <- getIntegral
  ds <- getIntegrals n  -- get the first row of adjacency matrix
  let
    anchors = getAnchors ds
    readFirst = if head anchors==1 then return ds else getIntegrals n
    readRest = replicateM (length anchors - 1) (getIntegrals n) -- get some other rows too
  adjss <- liftA2 (:) readFirst readRest  
  let
    adj1ss = [map snd $ filter ((1==).fst) (zip adjs [1..]) | adjs <- adjss]
    s0 = Bu.string7
    snl = Bu.string7 "\n" <> flush
    i0 = Bu.intDec
    printEdge src dst = i0 src <> s0 " " <> i0 dst <> snl
    printAdj (src,dsts) = mconcat [printEdge src dst | dst<-dsts]
    printAdjs = mconcat $ printAdj <$> zip anchors adj1ss
    ask k = s0 "? " <> i0 k <> snl
    askRest = mconcat $ ask <$> (dropWhile (==1) anchors)
  return $ ask 1 <> askRest <> s0 "!" <> snl <> printAdjs

getAnchors :: [Int]->[Int]
getAnchors xs = reverse $ go (zip xs [1..]) [] [] where
  go [] odds evens = if length odds < length evens then odds else evens
  go ((k,i):rest) odds evens
    | even k = go rest odds (i: evens)
    | odd k = go rest (i: odds) evens
 
getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)
 
getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x
 
getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  bytestrings <- B8.words <$> B8.getContents
  B8.putStr $ Bu.toLazyByteString $ evalState solve bytestrings

Answer 1

这里的问题与内联有关。我不完全理解，但这就是我的理解。

内联

首先，我们发现将 的定义replicateM复制并粘贴到提交 1 中会产生与提交 2 ( submission ) 相同的不良性能。但是，如果我们用INLINABLEpragma 替换 pragma of ，事情就会再次起作用（提交）。replicateMNOINLINE

pragma INLINABLEonreplicateM与 pragma 不同INLINE，后者比前者导致更多的内联。具体来说，如果我们replicateM在同一文件中定义内联的 Haskells 启发式决定内联，但replicateM在这种情况下，即使存在编译指示，它也会决定不内联INLINABLE。

sequenceA另一方面，traverse两者都有INLINE导致内联的编译指示。从上面的实验中得到提示，我们可以定义一个不可内联的sequenceA和死的，这使得解决方案 2 起作用（提交）。

{-# NOINLINE sequenceA' #-}
sequenceA' :: [St x] -> St [x]
sequenceA' = sequenceA

出了什么问题？

以下是我的一些相当严重的猜测。

但是内联是如何引起问题的呢？好吧，让我们看看以下两个核心转储之间的区别

带内联：

没有内联：

在这里，我们两次查看对应的内容，在第一个实例中是内联部分，在第二个实例中是对replicateM 的实际调用。

readRest = replicateM (length anchors - 1) (getIntegrals n)

现在有趣的一点是，在内联代码中，黄色突出显示的行在 的每个循环中运行replicateM，而在非内联部分中，它们在传递给 的 lambda 抽象之外计算一次replicateM。

但他们在做什么呢？ds核心中调用了多个变量，但是这个指的是这个：

这又对应于

solve = do
  n <- getIntegral

所以我认为正在发生的事情是，不是运行getIntegral一次并保存结果，而是保存它的起始状态，并且在循环的每次传递中都以该状态重新运行。事实上，将此行更改为以下内容（需要 BangPatterns 语言扩展）修复了所有版本（提交）。

solve = do
  !n <- getIntegral

我仍然不太确定，但这是我最好的猜测。

以下是两个核心转储供参考：Inline、 Noinline

这太疯狂了

是的，但我觉得这里的根本问题是你对惰性 IO 和惰性状态的使用。使用严格的状态转换器 Haskell 可能会发现不保留旧的状态（我不知道，只是猜测），但是我们不能在这里使用严格的状态，因为你依赖于惰性 IO，即获取所有输入在开始使用getContents并懒惰地强制它时，确保在强制太多之前提供输出。相反，逐行显式读取输入会更安全。即替换StateT [ByteString]为IO或更奇特的东西，例如Conduit或Pipe。