Birecursively defining a doubly infinite list of lists

问题

Context

I asked about patching a recursively-defined list the other day. I'm now trying to bring it up a level by operating on a 2D list instead (a list of lists).

I'll use Pascal's triangle as an example, like for example 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...

Question

I'd like to express it such that:

1. I'll come with my own first rows and columns (example above assumes first row is repeat 1, which is fixable enough, and that first column is repeat (head (head pascals)), which is going to be more tricky)

2. Each element remains a function of the one above and the one left of it.

3. As a whole, it is a function of itself enough for it to be possible to insert a patching function in the definition and have it propagate patches.

So from the outside, I'd like to find an f function such that I can define pascal as such:

pascal p = p (f pascal)

...so that pascal id is the same as in the example, and pascal (patch (1,3) to 16) yields something like:

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

Where I'm at

Let's first define and extract the first row and column, so we can have them available and not be tempted to abuse their contents.

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

Updating the definition to use row0 is easy enough:

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

But the first column is still element0. Updating to take them from col0:

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

Now we're good with the first requirement (custom first row and column). With no patching, the second is still good.

We even get part of the third: if we patch an element, it will propagate downwards since newRow is defined in terms of prevRow. But it won't propagate rightwards, since the (+) operates on scanl's internal accumulator, and from leftMost, which is an explicit in this context.

What I've tried

From there, it seems like the right way to do is to really separate concerns. We want our initializers row0 and col0 as explicit as possible in the definition, and find a way to define the rest of the matrix independently. Stub:

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

and then we'd want the remainder defined directly in terms of the whole. The natural definition would be:

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

The first row comes out fine. Why the loop? Following the evaluation helps: pascals is defined as a cons, whose car is fine (and printed). What's is cdr? It's zipWith (:) (tail col0) remainder. Is that expression a [] or (:)? It's the shortest of its arguments tail col0 and remainder. col0 being infinite, it's as null as remainder, i.e. zipWith genRow pascals (tail pascals). Is that [] or (:)? Well, pascals has already been evaluated to (:), but (tail pascals) hasn't been found a WHNF yet. And we're already in the process of trying, so <<loop>>.

(Sorry for spelling it out with words, but I really had to mentally trace it like that to understand it the first time).

Way out?

With the definitions I'm at, it seems like all definitions are proper, data-flow wise. The loop now seems simply because the evaluator can't decide whether the generated structure is finite or not. I can't find a way to make it a promise "it's infinite all right".

I feel like I need some converse of lazy matching: some lazy returning where I can tell the evaluator the WHNF of this comes out as (:), but you'll still need to call this thunk later to find out what's in it.

It also still feels like a fixed point, but I haven't managed to express in a way that worked.

回答1:

Here's a lazier version of zipWith that makes your example productive. It assumes the second list is at least as long as the first, without forcing it.

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)

---

Looking at the matrix we want to define:

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

There is a simple relationship between the matrix and the remainder, that describes the fact that each entry in the remainder is obtained by summing the entry to its left and the one above it: take the sum of the matrix without its first row, and the matrix without its first column.

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

From there, we can apply a patch/padding function to the remainder, to fill in the first row and first column, and edit whatever elements. Those modifications will be fed back through the recursive occurences of matrix. This leads to the following generalized definition of 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))

For example, the simplest padding function is to complete the matrix with an initial row and column.

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

Here we have to be careful to be lazy in the remainder, since we're in the middle of defining it, hence the use of zipWith' defined above. Said another way, we must ensure that if we pass undefined to rowCol row col we can still see the initial values that the rest of the matrix can be generated from.

Now pascals can be defined as follows.

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

---

Helper to truncate infinite matrices:

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

回答2:

For comparison's sake, I've written an alternate version using Data.IntTrie as suggested by @luqui.

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

Using the following Trie2D structure:

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

And support code:

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

Let's not forget the patching function, it is the underlying cause of the entire question:

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

Took a bit of time, but very satisfying results. Thanks for giving me the opportunity to try this out!

I do enjoy the ease of writing once the support code is up and running.

Comments welcome! Forgive me for forcing the Bits instance to Int a lot, but the code is hairy enough as is.

来源：https://stackoverflow.com/questions/54096535/birecursively-defining-a-doubly-infinite-list-of-lists