在这个动态编程示例中如何使 fromList 变得懒惰？

Question

module Main where
  import System.Random
  import Data.Foldable
  import Control.Monad
  import qualified Data.Map as M
  import qualified Data.Vector as V
  import Debug.Trace
  import Data.Maybe
  import Data.Ord

  -- Represents the maximal integer. maxBound is no good because it overflows.
  -- Ideally should be something like a billion.
  maxi = 1000

  candies :: V.Vector Int -> Int --M.Map (Int, Int) Int
  candies ar = ff [l (V.length ar - 1) x | x <- [0..maxi]]
    where
      go :: Int -> Int -> Int
      go _ 0 = maxi
      go 0 j = j
      go i j =
        case compare (ar V.! (i-1)) (ar V.! i) of
          LT -> ff [l (i-1) x + j | x <- [0..j-1]]
          GT -> ff [l (i-1) x + j | x <- [j+1..maxi]]
          EQ -> ff [l (i-1) x + j | x <- [0..maxi]]
      l :: Int -> Int -> Int
      l i j = fromMaybe maxi (M.lookup (i,j) cs)
      ff l = --minimum l
        case l of
          l:ls -> if l < maxi then l else ff ls
          [] -> maxi

      -- I need to make this lazy somehow.
      cs :: M.Map (Int, Int) Int
      cs = M.fromList [((i,j), go i j) | i <- [0..V.length ar - 1], j <- [0..maxi]]


  main :: IO ()
  main = do
    --ar <- fmap (V.fromList . map read . tail . words) getContents
    g <- fmap (V.fromList . take 5 . randomRs (1,50)) getStdGen
    print $ candies g

以上代码用于HackerRank Candies 挑战。我认为代码本质上是正确的，即使它在提交时给了我运行时错误。 HackerRank 没有说明这些错误是什么，但很可能是因为我用完了分配的内存。

为了完成上述工作，我需要重写上述内容，以便 fromList 得到懒惰的评估或类似的效果。我喜欢上面的形式并重写函数，以便它们作为参数传递映射是我非常想避免的。

我知道 Haskell 有各种关于 Hackage 的 memoization 库，但是在线评委不允许他们使用。

由于 Haskell 的纯洁性，我可能把自己编码到了一个洞里。

编辑：

我做了一些实验来弄清楚这些折叠和 lambda 是如何工作的。毕竟，我认为这肯定与延续传递有关，因为延续是沿着折叠建立的。为了说明我的意思，我将用一个简单的程序进行演示。

module Main where
  trans :: [Int] -> [Int]
  trans m =
    foldr go (\_ -> []) m 0 where
      go x f y = (x + y) : f x

  main = do
    s <- return $ trans [1,2,3]
    print s

让我吃惊的是，当我插入一个打印件时，它以相反的方式执行，从左到右，这让我一开始以为我误解了 foldr 的工作原理。事实证明并非如此。

上面所做的就是打印出[1,3,5]。

这是它如何执行的解释。尝试在上面打印出f x 不会提供任何信息，并且会导致它无处不在。

它从这样的事情开始。 fold 显然执行了 3 个go 函数。

go x f y = (x + y) : f x
go x f y = (x + y) : f x
go x f y = (x + y) : f x

上述说法并不完全正确。必须记住，所有fs 都是独立的。

go x f'' y = (x + y) : f'' x
go x f' y = (x + y) : f' x
go x f y = (x + y) : f x

为了清楚起见，分离出 lambda 也应该是有益的。

go x f'' = \y -> (x + y) : f'' x
go x f' = \y -> (x + y) : f' x
go x f = \y -> (x + y) : f x

现在折叠从顶部开始。最上面的语句被评估为...

go 3 (\_ -> []) = \y -> (3 + y) : (\_ -> []) 3

这简化为：

go 3 (\_ -> []) = (\y -> (3 + y) : [])

结果是上面未完成的 lambda。现在折叠计算第二个语句。

go 2 (\y -> (3 + y) : []) = \y -> (2 + y) : (\y -> (3 + y) : []) 2

这简化为：

go 2 (\y -> (3 + y) : []) = (\y -> (2 + y) : 5 : [])

折叠转到最后一条语句。

go 1 (\y -> (2 + y) : 5 : []) = \y -> (1 + y) : (\y -> (2 + y) : 5 : []) 1

这简化为：

go 1 (\y -> (2 + y) : 5 : []) = \y -> (1 + y) : 3 : 5 : []

折叠外的 0 被应用，最终的 lambda 被减少到

1 : 3 : 5 : []

这只是它的开始。当f x 被替换为f y 时，这个案例变得更有趣了。

这里是一个与之前类似的程序。

module Main where
  trans :: [Int] -> [Int]
  trans m =
    foldr go (\_ -> []) m 1 where
      go x f y = (x + y) : f (2*y+1)

  main = do
    s <- return $ trans [1,2,3]
    print s

让我再一次从上到下。

go x f'' = \y -> (x + y) : f'' (2*y+1)
go x f' = \y -> (x + y) : f' (2*y+1)
go x f = \y -> (x + y) : f (2*y+1)

最上面的语句。

go 3 (\_ -> []) = \y -> (3 + y) : (\_ -> []) (2*y+1)

中间语句：

go 2 (\y -> (3 + y) : (\_ -> []) (2*y+1)) = \y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)

最后一句话：

go 1 (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) = \y -> (1 + y) : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 2*y+1

注意表达式是如何建立的，因为ys 无法应用。只有在插入 0 之后才能计算整个表达式。

(\y -> (1 + y) : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 2*y+1) 1

2 : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 3

2 : 5 : (\y -> (3 + y) : (\_ -> []) (2*y+1)) 7

2 : 5 : 10 : (\_ -> []) 15

2 : 5 : 10 : []

由于评估顺序，存在累积。

编辑：所以...

go (candy, score) f c s = (candy', score): f candy' score
    where candy' = max candy $ if s < score then c + 1 else 1

实际上，上面的代码在每次迭代中都会遍历列表 3 次。

第一个 foldr 必须先移动到列表的后面才能开始。然后由于 candi' 依赖于不能立即应用的 s 和 c 变量，因此需要像上一个示例一样构建延续。

然后当两个 0 0 在折叠结束时被输入时，整个事情才会被评估。

这有点难以推理。

Answer 1

好吧，关于我自己在顶部的问题，可能使事情变得懒惰的方法是只使用一个列表（列表列表或列表向量。）上面不可能使懒惰的原因是因为 Map 类型的值是惰性的，而键是严格的。

更重要的是，我对折叠基本上进行了两次通过的分析是完全正确的。起初，反向执行这些构建的延续的方式完全让我感到困惑，但我已经调整了 @behzad.nouri 代码，使其仅使用单个循环。

module Main where
  import Control.Monad (replicateM)
  import Control.Applicative ((<$>))
  import Debug.Trace


  solve :: [Int] -> Int
  solve = sum . loop
      where
      loop :: [Int] -> [Int]
      loop = (\(_,_,x) -> x 0 0) . foldr go (0, 0, \_ _ -> [])
      go :: Int -> (Int, Int, Int -> Int -> [Int]) -> (Int, Int, Int -> Int -> [Int])
      go score (candyP,scoreP,f) =
        let
          candyP' = if scoreP < score then candyP + 1 else 1
          in
            (candyP', score,
              \candyN scoreN ->
                let
                  candy' = max candyP' $ if scoreN < score then candyN + 1 else 1
                  in candy' : f candy' score) -- This part could be replaced with a sum

  main = do
      n <- read <$> getLine
      solve . fmap read <$> replicateM n getLine >>= print

以上通过了所有测试，没有问题，这就是上述分析正确的令人信服的证明。

Answer 2

您链接到的问题有一个干净的 Haskell 解决方案，使用 右折叠。换句话说，您可以通过使用更实用的样式来跳过懒惰的 fromList、memoization 和所有这些问题。

这个想法是您维护一个(candy, score) 对的列表，其中candy 最初对所有人都是零（repeat 0 在下面的代码中）。然后你从左到右走一次，如果这个项目的分数超过了之前的分数，则增加 candy 值：

-- s is the score and c is the candy of the guy before
-- if s < score then this guy should get at least c + 1 candies
candy' = max candy $ if s < score then c + 1 else 1

然后朝另一个方向做同样的事情：

import Control.Monad (replicateM)
import Control.Applicative ((<$>))

solve :: [Int] -> Int
solve = sum . map fst . loop . reverse . loop . zip  (repeat 0)
    where
    loop cs = foldr go (\_ _ -> []) cs 0 0
    go (candy, score) f c s = (candy', score): f candy' score
        where candy' = max candy $ if s < score then c + 1 else 1

main = do
    n <- read <$> getLine
    solve . fmap read <$> replicateM n getLine >>= print

这会线性执行，并通过 HackerRank 上的所有测试。