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

контекст

Я спросил о исправлении рекурсивно определенного списка на днях. Сейчас я пытаюсь поднять его до уровня, используя вместо этого 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 позже, чтобы узнать, что в нем.

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

Источник

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
Источник

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

Источник
Другие вопросы по тегам