3

语境

前几天我询问了如何修补递归定义的列表。我现在正试图通过对 2D 列表（列表列表）进行操作来提升它的水平。

我将以帕斯卡三角形为例，例如这个美丽的三角形：

pascals = repeat 1 : map (scanl1 (+)) pascals
[1,1,1,1,1,1...
[1,2,3,4,5...
[1,3,6,10...
[1,4,10...
[1,5...
[1...

问题

我想这样表达：

  1. 我将使用我自己的第一行和第一列（上面的示例假设第一行是repeat 1，这是可以修复的，而第一列是repeat (head (head pascals))，这将更加棘手）

  2. 每个元素仍然是上面一个元素和它左边一个元素的函数。

  3. 作为一个整体，它本身就是一个函数，足以在定义中插入一个补丁函数并让它传播补丁。

所以从外面看，我想找到一个f可以这样定义的函数pascal：

pascal p = p (f pascal)

...所以这pascal id与示例中的相同，并pascal (patch (1,3) to 16)产生如下内容：

[1,1,1,1, 1,1...
[1,2,3,16,17...
[1,3,6,22...
[1,4,10...
[1,5...
[1...

我在哪里

让我们首先定义并提取第一行和第一列，这样我们就可以让它们可用，而不会试图滥用它们的内容。

element0 = 1
row0 = element0 : repeat 1
col0 = element0 : repeat 1

更新要使用的定义row0很容易：

pascals = row0 : map (scanl1 (+)) pascals

但第一列仍然是element0. 更新以从以下位置获取它们col0：

pascals = row0 : zipWith newRow (tail col0) pascals
  where
    newRow leftMost prevRow = scanl (+) leftMost (tail prevRow)

现在我们可以满足第一个要求（自定义第一行和第一列）。没有补丁，第二个还是不错的。

我们甚至得到了第三部分的一部分：如果我们修补一个元素，它会向下传播，因为它newRow是根据prevRow. 但它不会向右传播，因为(+)操作在scanl的内部累加器和 fromleftMost上，这在这种情况下是显式的。

我试过的

从那里开始，似乎正确的做法是真正分离关注点。我们希望我们的初始化程序在定义row0中col0尽可能明确，并找到一种方法来独立定义矩阵的其余部分。存根：

pascals = row0 : zipWith (:) (tail col0) remainder
[1,1,1,1,1,1,1,1,1,1...
[1,/-------------------
[1,|
[1,|
[1,|
[1,|  remainder
[1,|
[1,|
[1,|
[1,|

然后我们希望直接根据整体定义余数。自然的定义是：

remainder = zipWith genRow pascals (tail pascals)
  where genRow prev cur = zipWith (+) (tail prev) cur
[1,1,1,1,1,1,1,1,1,1...
<<loop>>

第一行出来很好。为什么是循环？评估后有帮助： pascals被定义为一个缺点，他的车很好（并且打印）。什么是cdr？是zipWith (:) (tail col0) remainder。这个表达式是 a[]还是(:)？它是其论点中最短的，tail col0并且remainder. 是无限的，它与, iecol0一样为空。那是还是？好吧，已经评估为，但尚未找到 WHNF。我们已经在尝试，所以。remainder zipWith genRow pascals (tail pascals)[](:)pascals(:)(tail pascals)<<loop>>

（很抱歉用单词拼写出来，但我真的不得不像这样在脑海中追踪它才能第一次理解它）。

出路？

根据我的定义，似乎所有定义都是正确的，数据流明智的。循环现在看起来很简单，因为评估器无法确定生成的结构是否是有限的。我找不到办法让它成为一个承诺“它是无限的”。

我觉得我需要一些惰性匹配的逆向：一些惰性返回，我可以告诉评估者这个 WHNF 出来(:)，但你仍然需要稍后调用这个 thunk 来找出其中的内容。

它仍然感觉像是一个固定点，但我还没有设法以一种有效的方式表达。

4

2 回答 2

4

这是一个懒惰的版本，zipWith可以使您的示例富有成效。它假定第二个列表至少与第一个列表一样长，而不是强制它。

zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' f (i : is) ~(j : js) = f i j : zipWith' f is js

-- equivalently --

zipWith' f (i : is) jjs = f i (head j) : zipWith' f is (tail js)

查看我们要定义的矩阵：

matrix =
  [1,1,1,1,1,1,1...
  [1,/-------------
  [1,|
  [1,|  remainder
  [1,|
  ...

矩阵和余数之间有一个简单的关系，它描述了这样一个事实：余数中的每个条目都是通过将其左侧的条目与其上方的条目相加得到的：取矩阵的总和，不包括第一行，并且没有第一列的矩阵。

remainder = (zipWith . zipWith) (+) (tail matrix) (map tail matrix)

从那里，我们可以对剩余部分应用补丁/填充功能，以填充第一行和第一列，并编辑任何元素。这些修改将通过matrix. 这导致了以下的广义定义pascals：

-- parameterized by the patch
-- and the operation to generate each entry from its older neighbors
pascals_ :: ([[a]] -> [[a]]) -> (a -> a -> a) -> [[a]]
pascals_ pad (+) = self where
  self = pad ((zipWith . zipWith) (+) (tail self) (map tail self))

例如，最简单的填充函数是用初始行和列完成矩阵。

rowCol :: [a] -> [a] -> [[a]] -> [[a]]
rowCol row col remainder = row : zipWith' (:) col remainder

在这里，我们必须小心在其余部分中保持惰性，因为我们正在定义它，因此使用zipWith'上面定义的。换句话说，我们必须确保如果我们传递undefined给，rowCol row col我们仍然可以看到可以从中生成矩阵其余部分的初始值。

现在pascals可以定义如下。

pascals :: [[Integer]]
pascals = pascals_ (rowCol (repeat 1) (repeat 1)) (+)

截断无限矩阵的助手：

trunc :: [[Integer]] -> [[Integer]]
trunc = map (take 10) . take 10
于 2019-01-08T17:21:45.700 回答
2

为了比较起见，我Data.IntTrie按照@luqui 的建议编写了一个替代版本。

pascal :: Trie2D Int
pascal = overwriteRow 0 1 $ overwriteCol 0 1 $
         liftA2 (+) (shiftDown pascal) (shiftRight pascal)

使用以下Trie2D结构：

newtype Trie2D a = T2 { unT2 :: IntTrie (IntTrie a) }

instance Functor Trie2D where
  fmap f (T2 t) = T2 (fmap f <$> t)

instance Applicative Trie2D where
  pure = T2 . pure . pure
  ~(T2 f) <*> ~(T2 a) = T2 $ (<*>) <$> f <*> a -- took some head-scratching

apply2d :: Trie2D a -> Int -> Int -> a
apply2d (T2 t) i j = t `apply` i `apply` j

和支持代码：

overwriteRow,overwriteCol :: Int -> a -> Trie2D a -> Trie2D a
overwriteRow i x = T2 . overwrite i (pure x) . unT2
overwriteCol j x = T2 . fmap (overwrite j x) . unT2

shiftUp, shiftDown, shiftLeft, shiftRight :: Trie2D a -> Trie2D a
shiftUp    (T2 t) = T2 (shiftL t)
shiftDown  (T2 t) = T2 (shiftR t)
shiftLeft  (T2 t) = T2 (shiftL <$> t)
shiftRight (T2 t) = T2 (shiftR <$> t)

shiftL, shiftR :: IntTrie a -> IntTrie a
shiftL t = apply t . succ @Int <$> identity
shiftR t = apply t . pred @Int <$> identity

t2dump :: Show a => Trie2D a -> IO ()
t2dump t2 = mapM_ print [ [ apply2d t2 i j | j <- [0..9] ] | i <- [0..9] ]

我们不要忘记修补功能，它是整个问题的根本原因：

overwrite2d :: Int -> Int -> a -> Trie2D a -> Trie2D a
overwrite2d i j x = T2 . modify i (overwrite j x) . unT2

花了一些时间，但结果非常令人满意。感谢您给我这个尝试的机会！

一旦支持代码启动并运行，我确实喜欢编写的轻松。

欢迎评论！请原谅我对Bits实例进行Int了很多强制，但代码已经足够多毛了。

于 2019-01-11T15:19:13.820 回答