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

让我感到惊讶的一件事是，当我插入一个印刷品时，它从左到右以相反的方式执行，这让我首先想到我误解了折叠是如何工作的。结果并非如此。

以上所做的是打印[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

同样为了清楚起见，将lambdas分开也是有益的。

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。现在，fold评估第二个语句。

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

请注意表达式是如何构建的，因为y无法应用。只有在插入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'取决于无法立即应用的s和c变量，因此需要像上一个示例中那样构建延续。

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

有点难以推理。

Answer 1

您链接到的问题是使用右侧折叠的干净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上的所有测试。

Answer 2

好吧，关于我自己在顶部的问题，可能让事情变得懒惰的方法就是只使用一个列表（一个列表列表或一个列表向量。）之所以上述是不可能做出懒惰的原因是因为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

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

如何在这个动态编程示例中使用fromList lazy？

2 个答案: