Бирекурсивное определение дважды бесконечного списка списков

Question

Контекст

Я спросил о исправлении рекурсивно определенного списка на днях. Сейчас я пытаюсь поднять его до уровня, используя вместо этого 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, а от 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, будучи бесконечным, равно нулю, как remainder, , т.е. zipWith genRow pascals (tail pascals). Это [] или (:)? Ну, pascals уже был оценен как (:), но (tail pascals) еще не был найден WHNF. И мы уже пытаемся, поэтому <<loop>>.

(Извините, что изложил это словами, но мне действительно пришлось мысленно проследить это, чтобы понять это в первый раз).

Выход?

С определениями, которые у меня есть, кажется, что все определения правильные, с точки зрения потока данных. Теперь цикл выглядит просто потому, что оценщик не может решить, является ли сгенерированная структура конечной или нет. Я не могу найти способ сделать это обещанием "все бесконечно хорошо".

Я чувствую, что мне нужно обратное ленивое сопоставление: какое-то ленивое возвращение, где я могу сказать оценщику, что WHNF этого выглядит как (:), но вам все равно нужно будет вызвать этот thunk позже, чтобы выяснить, что в это.

Это все еще ощущается как фиксированная точка, но мне не удалось выразить таким образом, чтобы это работало.

Answer 1

Для сравнения я написал альтернативную версию, используя 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, но код достаточно волосатый, как есть.

Answer 2

Вот более ленивая версия 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)

Оттуда мы можем применить функцию patch / padding к оставшейся части, чтобы заполнить первый ряд и первый столбец и редактировать любые элементы. Эти модификации будут возвращены через рекурсивные вхождения 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