代码之家 › 专栏 › 技术社区 › JB.

双安全地定义一个双重无限列表

tying-the-knot haskell

2

JB. · 技术社区 · 6 年前

语境

我问 patching a recursively-defined list 前几天。我现在正试图通过操作一个二维列表(列表列表)来提高它的级别。

我将使用帕斯卡三角形作为示例,例如 this beautiful one :

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...

问题

我想表达如下:

我将带上自己的第一行和第一列(上面的示例假设第一行是 repeat 1 ,它是足够固定的,第一列是 repeat (head (head pascals)) ,这将更加棘手)
每个元素都是上面和左边元素的函数。
作为一个整体,它本身就是一个函数,足以让它在定义中插入一个修补函数并传播修补程序。

所以从外面看, 我想找一个 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 的内部收集器,以及 leftMost ,在此上下文中是显式的。

我试过什么

从那里看来,正确的做法似乎是真正分离关注点。我们需要初始值设定项 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 . 那个表达方式是 [] 或 (:) ?这是最短的论点 tail col0 和 remainder . COL0 因为是无限的,它就像 余数 , 即 zipWith genRow pascals (tail pascals) . 那是 [] 或 (:) ?好, 帕斯卡 已评估为 (:) 但是 (tail pascals) 还没有找到WHNF。我们已经在尝试了,所以 <<loop>> .

(很抱歉用词拼写出来,但我真的必须在精神上像这样追溯才能第一次理解它)。

出路?

根据我的定义,似乎所有的定义都是正确的,数据流方面的。现在的循环似乎只是因为评估器无法决定生成的结构是否是有限的。我找不到一种方法让它成为一个承诺“它是无限的,好吧”。

我觉得我需要一些关于懒惰匹配的对话:一些懒惰的返回,在那里我可以告诉评估者这其中的原因是 (:) 但是你还是需要稍后再打电话给thunk来找出里面有什么。

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

2 回复 | 直到 6 年前

1

3

Li-yao Xia 6 年前

这里有一个更懒惰的版本 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 :: [[Integer]]
pascals = pascals_ (rowCol (repeat 1) (repeat 1)) (+)

帮助截断无限矩阵:

trunc :: [[Integer]] -> [[Integer]]
trunc = map (take 10) . take 10

2

1

JB. 6 年前

为了比较起见,我用 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 很多,但代码已经足够多了。