无法理解为什么这个 Haskell 代码运行得这么快

Question

在我尝试学习 Haskell 的过程中，我编写了以下代码来解决一个经典的优化问题。当前的问题是计算销售最大化价格，其中价格单调递增，给定 i 个买家序列，每个买家将以 v_i 的最大价格购买。用数学术语来说：给定 [v_i] ，找到 [p_i] st p_{i+1} >= p_i 最大化 \sum_i q(v_i,p_i) 其中 q(a,b)=0，如果 b>a, q( a,b)=b b<=a

我已经实现了以下代码，使用我认为的自上而下的动态编程方法来解决问题。该算法在每一步都通过最大化剩余序列来决定是否提高价格

maxP::Int->[Int]->(Int,Int)
maxP p [] = (0,p)
maxP p q 
   | a<p = (fst (maxP p (tail q)),p)
   | a==p = (p+fst (maxP p (tail q)),p)
   | otherwise =(maximum l,p+argmax l)
     where a=head q
           pc=[p..a]
           l=zipWith (+) pc $ map (fst)  ( map ((flip maxP) (tail q)) pc )

正如使用 Haskell 时所预期的那样，该代码几乎是 DP 算法的 1-1 实现。该代码返回（销售额，价格水平）

并且，为了获得所有价格序列，为所有 [v_i] 调用一个函数

maxPI::Int->[Int]->[Int]->[Int]
maxPI a [] b = reverse b
maxPI a c b = maxPI q (tail c) (q:b)
     where (p,q) = maxP a c 

我还实现了辅助功能

argmax::[Int]->Int
argmax x = mP x (-1) 0 0

mP::[Int]->Int->Int->Int->Int
mP [] maxi pos cpos = pos
mP a maxi pos cpos
     | ((head a)> maxi) = mP (tail a) (head a) cpos (cpos+1)
     |otherwise = mP (tail a) maxi pos (cpos+1)

显然，该函数可以（应该）进行优化，仅在列表中使用一次算法运行但我的问题是，即使没有上述优化，该算法的运行速度也快得惊人。所以我的问题如下：为什么这个算法运行得这么快？

我是否只是误解了 DP 算法的复杂性？Haskell 是否默认使用函数 maxP 的记忆？

此外，我不喜欢我的代码的 Haskell 风格。您能提出什么建议吗？

我原以为性能要慢得多

Answer 1

我不知道为什么你对它应该多快的直觉是错误的。但我会回答你提出的具体问题，不需要我住在你的脑海里：

Haskell 是否默认使用函数 maxP 的记忆？

Haskell 语言对于是否maxP应该通过语言实现来记忆没有意见。GHC 是最流行的实现，不会maxP像此处所写的那样进行记忆。

我不喜欢我的代码的 Haskell 风格。您能提出什么建议吗？

我有一些建议。最明显的一个是使用模式匹配而不是headand tail。像这样：

maxP::Int->[Int]->(Int,Int)
maxP p [] = (0,p)
maxP p (a:as)
   | a<p = (fst (maxP p as),p)
   | a==p = (p+fst (maxP p as),p)
   | otherwise =(maximum l,p+argmax l)
     where pc=[p..a]
           l=zipWith (+) pc $ map (fst)  ( map ((flip maxP) as) pc )

maxPI::Int->[Int]->[Int]->[Int]
maxPI a [] b = reverse b
maxPI a c@(_:ct) b = maxPI q ct (q:b)
     where (p,q) = maxP a c 

mP::[Int]->Int->Int->Int->Int
mP [] maxi pos cpos = pos
mP (a:as) maxi pos cpos
     | (a> maxi) = mP as a cpos (cpos+1)
     |otherwise = mP as maxi pos (cpos+1)

你有很多无关的括号。有时这对于可读性很有用，但在这种情况下他们并没有真正为我做这件事。

-           l=zipWith (+) pc $ map (fst)  ( map ((flip maxP) as) pc )
+           l=zipWith (+) pc $ map fst (map (flip maxP as) pc)
-     | (a> maxi) = mP as a cpos (cpos+1)
+     | a>maxi = mP as a cpos (cpos+1)

在 中maxP，您可以用来compare同时计算所有三个守卫。

maxP::Int->[Int]->(Int,Int)
maxP p [] = (0,p)
maxP p (a:as) = case compare a p of
   LT -> (fst (maxP p as),p)
   EQ -> (p+fst (maxP p as),p)
   GT -> (maximum l,p+argmax l)
     where pc=[p..a]
           l=zipWith (+) pc $ map fst (map (flip maxP as) pc)

l您可以使用单个map或通过列表理解更清楚地完成 的计算。

-     where pc=[p..a]
-           l=zipWith (+) pc $ map fst (map (flip maxP as) pc)
+     where l=map (\p' -> p'+fst (maxP p' as)) [p..a] -- OR
+     where l=[p'+fst (maxP p' as) | p' <- [p..a]]

您可以考虑在同一次遍历中计算最大值的索引和最大值本身，并重用现有的库函数，如下所示：

   GT -> (maxv,p+maxi)
     where l=[p'+fst (maxP p' as) | p' <- [p..a]]
           (maxv, maxi) = maximum (zip l [0..])

这argmax将返回最新的最大值，与您的解决方案不同，它返回最早的最大值。我不确定这是否重要。如果是这样，您可以避免Arg在比较中使用索引或Down“以其他方式”使用它。

你提到过fst (maxP _ as)几次。可能值得在那里做一些干燥的事情。

maxP::Int->[Int]->(Int,Int)
maxP p [] = (0,p)
maxP p (a:as) = case compare a p of
   LT -> (go p,p)
   EQ -> (p+go p,p)
   GT -> (maxv,p+maxi)
     where l=[p'+go p' | p' <- [p..a]]
           (maxv, maxi) = maximum (zip l [0..])
           go p' = fst (maxP p' as)

实际上，仔细阅读后，我发现p+maxi您所做的整个计算只是为了恢复p'您手中已有的值！所以，更好的是：

   GT -> maximum [(p'+go p', p') | p' <- [p..a]]

我一直为这最后一点而纠结。是一样的吗maximum [maxP p' as | p' <- [p..a]]？无论如何，在这一点上，现在很清楚，案例EQ和GT案例实际上在做同样的事情。所以让我们合并它们。实际上，我们现在就搬回警卫处，哈哈！

maxP::Int->[Int]->(Int,Int)
maxP p [] = (0,p)
maxP p (a:as)
   | a<p = (go p,p)
   | otherwise = maximum [(p'+go p', p') | p' <- [p..a]]
     where go p' = fst (maxP p' as)

在 中maxPI，没有真正的理由向后构建列表，而reverse您可以从一开始就向前构建列表。

maxPI::Int->[Int]->[Int]
maxPI a [] = []
maxPI a c@(_:ct) = q:maxPI q ct
     where (p,q) = maxP a c

这可能可以通过扫描来完成，尽管我对这种转变不太有信心。

maxPI::Int->[Int]->[Int]
maxPI a cs = scanl (\a' cs' -> snd (maxP a' cs')) a (tails cs)

我不确定我是否喜欢这一变化，但这是一个需要注意的变化。总而言之，我们得到了这段代码：

maxP::Int->[Int]->(Int,Int)
maxP p [] = (0,p)
maxP p (a:as)
   | a<p = (go p,p)
   | otherwise = maximum [(p'+go p', p') | p' <- [p..a]]
     where go p' = fst (maxP p' as)

maxPI::Int->[Int]->[Int]
maxPI a cs = scanl (\a' cs' -> snd (maxP a' cs')) a (tails cs)

对我来说，这感觉就像非常惯用的 Haskell。如果你想从这里往上走，你需要开始考虑算法的改变，而不是风格的改变。

下面是调整该算法以使其适当地共享计算的情况，即动态编程解决方案。首先，我们定义一种类型来跟踪我们感兴趣的信息，即当前解决方案适用的最低价格、假设我们总是支付高于最低价格的情况下我们可以获得的支出，以及我们应该提供的实际价格付款。

import Data.List

data Path = Path
    { payout :: Int
    , minPrice :: Int
    , prices :: [Int]
    } deriving (Eq, Ord, Read, Show)

我们将命名这些表条目的一些简单操作。第一个是在假定当前客户愿意支付的最高价格的情况下要求当前客户提供最低价格的假设下扩展当前表条目。

demandMin :: Int -> Path -> Path
demandMin maxPrice path = path
    { payout = payout path + if curPrice <= maxPrice then curPrice else 0
    , prices = curPrice : prices path
    } where
    curPrice = minPrice path

第二个操作表达了我们对支出的偏好。它会在我们的表中选取两个条目，然后选择赔率更好的一个。如果我们足够稳健，我们也会采用较小的最低价格，但我们将安排第一个参数始终具有较小的最低价格，因此我们可以作弊并始终采用该价格。

maxPayout :: Path -> Path -> Path
maxPayout p p' = if payout p >= payout p' then p else p' { minPrice = minPrice p }

完成这些操作后，我们就可以编写表更新运算符了。我们表的每一列都有每个可能的最低价格的条目，我们假设传入的列按从最低价格到最高价格的顺序排列它们。鉴于此，我们可以为每一行填写左边的下一列，以更好的方式要求当前的最低价格或下面一行提出的任何优秀计划。像这样：

maxPayouts :: Int -> [Path] -> [Path]
maxPayouts maxPrice = scanr1 maxPayout . map (demandMin maxPrice)

现在，要运行该算法，我们只需初始化最右边的列，然后迭代地填充左侧的列，最后将表的左上角元素作为我们的答案。我们必须设置假设的不变量，即行按排序顺序排列，但否则这里几乎不需要编写代码。所以：

top :: [Int] -> Path
top prices = head $ foldr maxPayouts [Path 0 price [] | price <- sort prices] prices

在 ghci 中尝试一下：

> top [1,2]
Path {payout = 3, startingPrice = 1, prices = [1,2]}
> top [1,3]
Path {payout = 4, startingPrice = 1, prices = [1,3]}
> top [2,1]
Path {payout = 2, startingPrice = 1, prices = [1,1]}
> top [3,1]
Path {payout = 3, startingPrice = 1, prices = [3,3]}
> top [1,5,3]
Path {payout = 7, startingPrice = 1, prices = [1,3,3]}
> top [1,7,3]
Path {payout = 8, startingPrice = 1, prices = [1,7,7]}

（通常您不会关心该startingPrice字段，但返回它比创建一个没有它返回的新数据类型更容易。）

扩展性良好；例如，top [5,10..1000]即使没有编译或优化，对我来说基本上也是立即返回。理论上，它应该大约缩放为 O(n^2)，其中 n 是输入列表的长度，尽管我没有尝试凭经验验证这一点。