Внедрение застежки-молнии для индексированных по длине списков

Я пытаюсь реализовать своего рода молнию для индексированных по длине списков, которые возвратят каждый элемент списка в паре со списком, в котором этот элемент будет удален. Например. для обычных списков:

zipper :: [a] -> [(a, [a])]
zipper = go [] where
    go _    []     = []
    go prev (x:xs) = (x, prev ++ xs) : go (prev ++ [x]) xs

Итак,

> zipper [1..5]
[(1,[2,3,4,5]), (2,[1,3,4,5]), (3,[1,2,4,5]), (4,[1,2,3,5]), (5,[1,2,3,4])]

Моя текущая попытка реализовать ту же самую вещь для индексированных по длине списков:

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}

data Nat = Zero | Succ Nat
type One = Succ Zero

type family (+) (a :: Nat) (b :: Nat) :: Nat
type instance (+) Zero n = n
type instance (+) (Succ n) m = Succ (n + m)


data List :: Nat -> * -> * where
    Nil  :: List Zero a
    Cons :: a -> List size a -> List (Succ size) a

single :: a -> List One a
single a = Cons a Nil

cat :: List a i -> List b i -> List (a + b) i
cat Nil ys = ys
cat (Cons x xs) ys = Cons x (xs `cat` ys)

zipper :: List (Succ n) a -> List (Succ n) (a, List n a)
zipper = go Nil where

    go :: (p + Zero) ~ p
        => List p a -> List (Succ q) a -> List (Succ q) (a, List (p + q) a)
    go prev (Cons x Nil) = single (x, prev)
    go prev (Cons x xs) = (x, prev `cat` xs) `Cons` go (prev `cat` single x) xs

Похоже, что это должно быть довольно просто, но, как представляется, нет никакого способа передать GHC, например, + является коммутативным и ассоциативным, или что нуль является тождественным, я сталкиваюсь с множеством проблем, когда средство проверки типов (понятно) жалуется, что не может определить, что a + b ~ b + a или a + Zero ~ a.

Нужно ли добавлять какие-то объекты-доказательства (data Refl a b where Refl :: Refl a a и др.) или есть ли способ сделать эту работу просто добавлением более явных сигнатур типа?

ОТВЕТЫ

Ответ 1

Выравнивание

Зависимое типизированное программирование похоже на выполнение двух лобзиков, которые склеен какой-то изгои. Менее метафорически мы выражаем одновременные вычисления на уровне значений и уровне типа, и мы должны обеспечить их совместимость. Конечно, мы каждый наш собственный мошенник, поэтому, если мы сможем организовать склеивание лобзиков, нам будет легче. Когда вы видите доказательства обязательств по типу ремонта, у вас может возникнуть соблазн спросить

Нужно ли добавлять какие-то объекты-доказательства (data Refl a b where Refl :: Refl a a и др.) или есть ли способ сделать эту работу просто добавлением более явных подписей типа?

Но сначала вы можете подумать о том, как вычисляются вычисления уровня и типа, и есть ли надежда на приближение их.

Решение

Вопрос в том, как вычислить вектор (список с индексом длины) выбора из вектора. Поэтому нам нужно что-то с типом

List (Succ n) a -> List (Succ n) (a, List n a)

где элемент в каждой позиции ввода украшается одним коротким вектором своих братьев и сестер. Предлагаемый метод - сканировать слева направо, накапливая старших братьев и сестер в списке, который растет справа, а затем объединяется с младшими братьями и сестрами в каждой позиции. Растущие списки справа всегда беспокоят, особенно когда Succ для длины выравнивается с Cons слева. Необходимость конкатенации требует добавления уровня на уровне, но арифметика, возникающая в результате правосторонней деятельности, не соответствует правилам вычисления для добавления. Я немного вернусь к этому стилю, но попробую снова подумать об этом.

Прежде чем перейти к любому решению, основанному на аккумуляторах, давайте просто попробуем стандартную структурную рекурсию болота. У нас есть "один" случай и "больший" случай.

picks (Cons x [email protected])         = Cons (x, xs) Nil
picks (Cons x [email protected](Cons _ _))  = Cons (x, xs) (undefined (picks xs))

В обоих случаях мы ставим первое разложение спереди. Во втором случае мы проверили, что хвост не пуст, поэтому мы можем запросить его выбор. Мы имеем

x         :: a
xs        :: List (Succ n) a
picks xs  :: List (Succ n) (a, List n a)

и мы хотим

Cons (x, xs) (undefined (picks xs))  :: List (Succ (Succ n)) (a, List (Succ n) a)
              undefined (picks xs)   :: List (Succ n) (a, List (Succ n) a)

поэтому undefined должна быть функцией, которая увеличивает все списки сестер, повторно привязывая x к левому концу (а левая - хорошая). Итак, я определяю экземпляр Functor для List n

instance Functor (List n) where
  fmap f Nil          = Nil
  fmap f (Cons x xs)  = Cons (f x) (fmap f xs)

и я проклинаю Prelude и

import Control.Arrow((***))

чтобы я мог писать

picks (Cons x [email protected])         = Cons (x, xs) Nil
picks (Cons x [email protected](Cons _ _))  = Cons (x, xs) (fmap (id *** Cons x) (picks xs))

который делает работу не с намеком на добавление, не говоря уже о доказательстве этого.

Варианты

Мне стало неловко делать то же самое в обеих строках, поэтому я попытался вырваться из него:

picks :: m ~ Succ n => List m a -> List m (a, List n a)  -- DOESN'T TYPECHECK
picks Nil          = Nil
picks (Cons x xs)  = Cons (x, xs) (fmap (id *** (Cons x)) (picks xs))

Но GHC агрессивно решает эту проблему и отказывается разрешать Nil как шаблон. И это правильно: мы действительно не должны вычислять в ситуации, когда мы знаем статически, что Zero ~ Succ n, так как мы можем легко построить какую-то вещь. Проблема в том, что я помещал свое ограничение в место со слишком глобальной областью.

Вместо этого я могу объявить оболочку для типа результата.

data Pick :: Nat -> * -> * where
  Pick :: {unpick :: (a, List n a)} -> Pick (Succ n) a

Возвращаемый индекс Succ n означает, что ограничение непустоты является локальным для Pick. Вспомогательная функция делает левое расширение,

pCons :: a -> Pick n a -> Pick (Succ n) a
pCons b (Pick (a, as)) = Pick (a, Cons b as)

оставляя нас с

picks' :: List m a -> List m (Pick m a)
picks' Nil          = Nil
picks' (Cons x xs)  = Cons (Pick (x, xs)) (fmap (pCons x) (picks' xs))

и если мы хотим

picks = fmap unpick . picks'

Возможно, это может быть излишним, но это может стоить того, если мы хотим разделить старших и младших братьев и сестер, разбивая списки в три, например:

data Pick3 :: Nat -> * -> * where
  Pick3 :: List m a -> a -> List n a -> Pick3 (Succ (m + n)) a

pCons3 :: a -> Pick3 n a -> Pick3 (Succ n) a
pCons3 b (Pick3 bs x as) = Pick3 (Cons b bs) x as

picks3 :: List m a -> List m (Pick3 m a)
picks3 Nil          = Nil
picks3 (Cons x xs)  = Cons (Pick3 Nil x xs) (fmap (pCons3 x) (picks3 xs))

Опять же, все действие остается законченным, поэтому мы хорошо разбираемся в вычислительном поведении +.

Накопительные

Если мы хотим сохранить стиль первоначальной попытки, накапливая старших братьев и сестер, как мы идем, мы могли бы сделать хуже, чем держать их в стиле застежки-молнии, сохраняя самый близкий элемент в наиболее доступном месте. То есть мы можем хранить старших братьев и сестер в обратном порядке, так что на каждом шаге нам нужно только Cons, а не конкатенацию. Когда мы хотим создать полный список сестер в каждом месте, нам нужно использовать обратное конкатенацию (действительно, подключив подсписку в список zipper). Вы можете легко вводить revCat для векторов, если вы развертываете добавление в стиле абакуса:

type family (+/) (a :: Nat) (b :: Nat) :: Nat
type instance (+/) Zero     n  =  n
type instance (+/) (Succ m) n  =  m +/ Succ n

Что добавление, которое выравнивается с вычислением на уровне значения в revCat, определяется таким образом:

revCat :: List m a -> List n a -> List (m +/ n) a
revCat Nil         ys  =  ys
revCat (Cons x xs) ys  =  revCat xs (Cons x ys)

Мы приобретаем zipperized go версию

picksr :: List (Succ n) a -> List (Succ n) (a, List n a)
picksr = go Nil where
  go :: List p a -> List (Succ q) a -> List (Succ q) (a, List (p +/ q) a)
  go p (Cons x [email protected])         =  Cons (x, revCat p xs) Nil
  go p (Cons x [email protected](Cons _ _))  =  Cons (x, revCat p xs) (go (Cons x p) xs)

и никто ничего не доказывал.

Заключение

Леопольд Кронекер должен был сказать

Бог создал естественные числа, чтобы запутать нас: все остальное - это работа человека.

Один Succ выглядит очень похожим на другой, поэтому очень легко записать выражения, которые придают размеру вещи таким образом, который не соответствует их структуре. Конечно, мы можем и должны (и собираемся) оснастить решателя ограничений GHC улучшенным набором для численного моделирования на уровне типового уровня. Но прежде чем это ударит, стоит просто сговориться выровнять Cons es с Succ s.