Question

我有以下代码：

pB :: [(Integer, Integer, Integer)] -> Integer -> Integer -> [(Integer, Integer, Integer)]
pB lst x y
    | screenList lst x y /= -1 = lst
    | abs x > y = lst++[(x, y, 0)]
    | y == 1 = lst++[(x, y, 1)]
    | otherwise = lst++newEls
  where
    newEls = (pB lst x (y-1))++(pB lst (x-1) (y-1))++(pB lst (x+1) (y-1))

getFirst :: (Integer, Integer, Integer) -> Integer
getFirst (x, _, _) = x

getSecond :: (Integer, Integer, Integer) -> Integer
getSecond (_, y, _) = y

getThird :: (Integer, Integer, Integer) -> Integer
getThird (_, _, z) = z

screenList :: [(Integer, Integer, Integer)] -> Integer -> Integer -> Integer
screenList [] _ _ = -1
screenList lst x y
    | getFirst leader == x && getSecond leader == y = getThird leader
    | otherwise = screenList (tail lst) x y
  where
    leader = head lst

通过运行一个低效的解决方案（即：没有跟踪已经计算过的值的一个），返回值51，输入x = 0，y = 5.现在，用输入运行[ ] 0 5我应该能够在输出中找到（0,5,51），遗憾的是我没有。

我一直在看它几个小时，但似乎无法理解我哪里出错了。

有人有任何建议吗？

编辑：效率不高的版本：

nPB :: Integer -> Integer -> Integer
nPB x y
    | abs x > y = 0
    | y == 1 = 1
    | otherwise = (nPB x (y-1)) + (nPB (x-1) (y-1)) + (nPB (x+1) (y-1))

Answer 1

<强>文案

很难说出你在问什么，但我知道你有一个非常慢的功能，你试图手动记忆这个功能。我不认为有人试图理解您的尝试，所以如果这个问题主要是关于手动记忆功能和/或修复您的代码，那么请提交另一个更清楚地概述其设计的问题。

在本问题的其余部分，我将向您展示如何使用monad-memo和memo-trie来记忆您已命名为nPB的函数。

使用monad-memo

记住nPB

nPB函数是记忆的主要目标。通过浏览它的三个递归调用可以很明显地看出这一点。下面的小基准测试需要1秒才能运行，让我们看看能否做得更好。

nPB :: Integer -> Integer -> Integer
nPB x y
    | abs x > y = 0
    | y == 1 = 1
    | otherwise = (nPB x (y-1)) + (nPB (x-1) (y-1)) + (nPB (x+1) (y-1))

main = print (nPB 10 20)

在previous answer我使用monad-memo包。使用monad-memo涉及使你的函数monadic，这在语法上比我知道的其他包更具侵略性，但我总是有很好的表现。

要使用该软件包，您只需：

确保使用目标函数作为第一个参数调用其中一个memo函数。
请务必return您的最终结果
调整您的类型签名以包含MonadMemo的约束，并将结果调整为某些monad m。
使用startEvalMemo

代码是：

{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Memo

nPB :: (MonadMemo (Integer,Integer) Integer m) => Integer -> Integer -> m Integer
nPB x y
    | abs x > y = return 0
    | y == 1 = return 1
    | otherwise = do
        t1 <- for2 memo nPB x (y-1)
        t2 <- for2 memo nPB (x-1) (y-1)
        t3 <- for2 memo nPB (x+1) (y-1)
        return (t1+t2+t3)

main = print (startEvalMemo $ nPB 10 20)

使用MemoTrie记忆nPB

使用的最常见的Haskell memoization包是MemoTrie。这也是一个语法上更清晰的memoization包，因为它不需要任何类型的monad，但它在使用Integer时会遇到轻微的性能问题，我们很快就会看到（已报告错误，使用Int和其他类型似乎很好。）

使用MemoTrie要做的事情要少得多，只需用memoN替换你的递归调用，其中N是参数的数量：

import Data.MemoTrie

nPB :: Integer -> Integer -> Integer
nPB x y
    | abs x > y = 0
    | y == 1 = 1
    | otherwise = (memo2 nPB x (y-1)) + (memo2 nPB (x-1) (y-1)) + (memo2 nPB (x+1) (y-1))

main = print (nPB 10 20)

<强>性能

使用Integer类型的表现是：

$ ghc original.hs -O2 && time ./original
8533660    
real    0m1.047s

$ ghc monad-memo.hs -O2 && time ./monad-memo
8533660
real    0m0.002s

$ ghc memotrie.hs -O2 && time ./memotrie
8533660
real    0m0.331s

使用Int：

$ ghc original.hs -O2 && time ./original
8533660
real    0m0.190s

$ ghc monad-memo.hs -O2 && time ./monad-memo
8533660
real    0m0.002s

$ ghc memotrie.hs -O2 && time ./memotrie
8533660    
real    0m0.002s

Answer 2

我想这个问题是关于记忆的。我不确定你是如何尝试实现这一点的，但有两个＆＃34;标准＆＃34;记忆功能的方法：使用其中一个库，或者自己明确地记忆数据。

import Data.Function.Memoize (memoize)
import Data.MemoTrie (memo2)
import Data.Map (fromList, (!))
import System.Environment

test0 :: Integer -> Integer -> Integer
test0 x y
       | abs x > y = 0
       | y == 1 = 1
       | otherwise = (test0 x (y-1)) + (test0 (x-1) (y-1)) + (test0 (x+1) (y-1))

test1 :: Integer -> Integer -> Integer
test1 = memoize test0

test2 :: Integer -> Integer -> Integer
test2 = memo2 test0

但它看起来不像我试过的备忘录库能够解决这个问题，或者我做错了什么，我从来没有真正使用过这些库:(测试代码位于底部 - 这些来自x,y = 0,18）的结果

test0 : Total time  9.06s 
test1 : Total time  9.08s
test2 : Total time 32.78s

让我们尝试手动记忆。原理很简单：以后面的元素只需要早期元素的值的方式构建域。这里非常简单，因为你的函数总是在y-1上进行递归，所以你只需要构建向上移动行的域。然后编写一个函数，查找表中的早期值（这里我使用Data.Map.Map），并映射到域：

test3 :: Integer -> Integer -> Integer
test3 x' y' = m ! (x', y')
  where
    xs = concat [ map (flip (,) y) [-x + x' .. x + x'] | (x, y) <- zip [y', y' - 1 .. 1] [1..]]

    m = fromList [ ((x,y), go x y) | (x,y) <- xs]

    go x y
       | abs x > y = 0
       | y == 1 = 1
       | otherwise = m ! (x, y-1) + m ! (x-1, y-1) + m ! (x+1, y-1)

我实际上构建了一个非常简单所需的域，但是性能损失很小，因为额外的域无论如何都是0。看一下性能，它几乎是即时的（Total time 0.02s）。即使使用x,y=0,1000，它仍然只需要7秒钟。虽然输入量很大，但最终会浪费大量时间在GC上。

-- usage: ghc --make -O2 -rtsopts Main.hs && Main n x y +RTS -sstderr
main = do 
  [n, x, y] <- getArgs
  print $ (d !! (read n)) x y
    where d = [test0, test1, test2, test3]

以下是使用memoFix2编写的版本。比任何其他版本更好的性能。

test4 :: Integer -> Integer -> Integer
test4 = memoFix2 go where 
  go r x y
       | abs x > y = 0
       | y == 1 = 1
       | otherwise = (r x (y-1)) + (r (x-1) (y-1)) + (r (x+1) (y-1))

记忆功能无法正常运行

2 个答案: