Question

我正在尝试为长度索引列表实现一种拉链，它会返回列表中的每个项目以及删除该元素的列表。例如。普通名单：

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等）或者是否有某种方法可以通过添加更多显式类型签名来实现此功能？

Answer 1

对齐

依赖类型编程就像做两个拼图，一些流氓粘在一起。不那么隐喻，我们在价值级别和类型级别表达同时计算，我们必须确保它们的兼容性。当然，我们每个人都是我们自己的流氓，所以如果我们可以安排将拼图粘在一起，我们就会有更轻松的时间。当您看到类型修复的证明义务时，您可能会想要

我是否需要添加某种证明对象（data Refl a b where Refl :: Refl a a等）或者是否有某种方法可以通过添加更多显式类型签名来实现此功能？

但是你可能首先考虑价值和类型级别的计算以何种方式不对齐，以及是否有希望使它们更接近。

解决方案

这里的问题是如何计算向量中的选择向量（长度索引列表）。所以我们喜欢类型

的东西

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

其中每个输入位置中的元素使用其兄弟姐妹的一个较短的向量进行修饰。所提出的方法是从左向右扫描，将年长的兄弟姐妹聚集在右侧生长的列表中，然后在每个位置与较年轻的兄弟姐妹连接。右侧的增长列表总是令人担心，尤其是当长度的Succ与左侧的Cons对齐时。连接的需要需要类型级添加，但是由右端活动产生的算法与用于添加的计算规则不一致。我稍后会回到这种风格，但让我们再试一次。

在我们进入任何基于累加器的解决方案之前，让我们试试标准的结构递归。我们有一个＆＃34;一个＆＃34;案件和＆＃34;更多＆＃34;情况下。

picks (Cons x xs@Nil)         = Cons (x, xs) Nil
picks (Cons x xs@(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 xs@Nil)         = Cons (x, xs) Nil
picks (Cons x xs@(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的 local 的无效约束。辅助函数执行左端扩展

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，而不是连接。当我们想在每个地方构建完整的兄弟列表时，我们需要使用反向连接（实际上，将子列表插入到列表拉链中）。如果部署 abacus-style ，可以轻松地为向量键入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 xs@Nil)         =  Cons (x, revCat p xs) Nil
  go p (Cons x xs@(Cons _ _))  =  Cons (x, revCat p xs) (go (Cons x p) xs)

并且没有人证明什么。

结论

Leopold Kronecker应该说

上帝使自然数字困扰我们：其余的都是人的工作。

一个Succ看起来非常像另一个，因此很容易写下表达式，这些表达式会以与其结构不一致的方式给出事物的大小。当然，我们可以而且应该（并且即将）为GHC的约束求解器配备改进的类型级数值推理套件。但在此之前，只需密谋将Cons es与Succ对齐即可。

为长度索引列表实现拉链

1 个答案:

对齐

解决方案

变体形式

累积

结论