如何在这个动态规划示例中使 fromList 变得惰性?

How to make fromList lazy in this dynamic programming example?

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 不会提供任何信息,并且会导致它到处都是。

开头是这样的。折叠显然执行了 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

以上说法并不完全正确。必须记住,所有 f 都是分开的。

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 次。

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

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

有点难推理。

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

这个想法是你维护一个 (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 上的所有测试。

好吧,关于我自己在顶部的问题,可能使事情变得懒惰的方法是只使用列表(列表的列表或列表的向量。)以上不可能的原因make lazy 是因为 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

以上通过所有测试,没有问题,足以证明上述分析是正确的。