Search code examples
haskelltying-the-knot

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.


Solution

  • 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