Haskell 是否有任何类型代数函数将ADT映射到该ADT的元素集？

对于一些简单的ADT，我们可以获得该ADT集合的ADT作为

数据集=完整集合（*重复N次）|空集（*重复N次）

，其中N是该ADT的非终端构造函数的数量。举一个更具体的例子，请看

Nat

：

data Nat = Succ Nat | Zero

我们可以获得NAT集合的类型，如下所示：

data NatSet = Full NatSet | Empty NatSet

那么比如说,

empty :: NatSet
empty = Empty empty

insert :: Nat -> NatSet -> NatSet
insert Zero (Empty natverse)       = Full natverse
insert Zero (Full natverse)        = Full natverse
insert (Succ nat) (Empty natverse) = Empty (insert nat natverse)
insert (Succ nat) (Full natverse)  = Full (insert nat natverse)

member :: Nat -> NatSet -> Bool 
member Zero (Full natverse)        = True
member Zero (Empty natverse)       = False
member (Succ nat) (Empty natverse) = member nat natverse
member (Succ nat) (Full natverse)  = member nat natverse

main = do
    let set = foldr insert empty [Zero, Succ (Succ Zero), Succ (Succ (Succ (Succ (Succ Zero))))]
    print $ member Zero set
    print $ member (Succ Zero) set
    print $ member (Succ (Succ Zero)) set
    print $ member (Succ (Succ (Succ Zero))) set
    print $ member (Succ (Succ (Succ (Succ Zero)))) set
    print $ member (Succ (Succ (Succ (Succ (Succ Zero))))) set

type Nat = Fix (N :+ N)
type Tree = Fix (N :+ (I :* I))

对于其他类型，它同样简单：

data Bin = A Bin | B Bin | C
data BinSet = Empty BinSet BinSet | Full BinSet BinSet

但那个分支的类型呢？这对我来说并不明显：

data Tree = Branch Tree Tree | Tip
data TreeSet = ???

---

是否有任何类型代数参数将ADT映射到该类型集合的ADT？

让我们再看看集合类型

data NatSet = Full NatSet | Empty NatSet

在这个内部总是有另一个

NatSet

；sum类型的两个分支指示当前

Nat

是否存在于集合中。这是集合的结构表示。正如您所观察到的，集合的结构取决于值的结构

它相当于一个布尔流：我们通过索引到流中来测试成员资格

data NatSet = NatSet Bool NatSet

empty = NatSet False empty

insert Z (NatSet _ bs) = NatSet True bs
insert (S n) (NatSet b bs) = NatSet b (insert n bs)

(NatSet b _) `contains` Z = b
(NatSet _ bs) `contains` (S n) = bs `contains` n

基于集合成员资格类似于对布尔集合进行索引这一观点，让我们来研究一个通用的实现，它是由多项式函子（）的不动点构成的类型值集合

---

第一件事。正如您所观察到的，集合的结构取决于其内部事物的类型。这是一类可以是集合元素的东西

class El a where
    data Set a
    empty :: Set a
    full :: Set a

    insert :: a -> Set a -> Set a
    remove :: a -> Set a -> Set a

    contains :: Set a -> a -> Bool

对于第一个示例，我将从上面修改

NatSet

，以适应这种格式

instance El Nat where
    data Set Nat = NatSet Bool (Set Nat)

    empty = NatSet False empty
    full = NatSet True empty

    insert Z (NatSet _ bs) = NatSet True bs
    insert (S n) (NatSet b bs) = NatSet b (insert n bs)

    remove Z (NatSet _ bs) = NatSet False bs
    remove (S n) (NatSet b bs) = NatSet b (remove n bs)

    (NatSet b _) `contains` Z = b
    (NatSet _ bs) `contains` (S n) = bs `contains` n

我们稍后需要的另一个简单的

El

实例是

（）

。一组

（）

s要么是满的，要么是空的，中间没有任何内容

instance El () where
    newtype Set () = UnitSet Bool
    empty = UnitSet False
    full = UnitSet True
    insert () _ = UnitSet True
    remove () _ = UnitSet False
    (UnitSet b) `contains` () = b

---

函子

f

的不动点

newtype Fix f = Fix (f (Fix f))

在

El

的实例中，只要

f

是以下

El1

类的实例

class El1 f where
    data Set1 f a
    empty1 :: El a => Set1 f (Set a)
    full1 :: El a => Set1 f (Set a)
    insert1 :: El a => f a -> Set1 f (Set a) -> Set1 f (Set a)
    remove1 :: El a => f a -> Set1 f (Set a) -> Set1 f (Set a)
    contains1 :: El a => Set1 f (Set a) -> f a -> Bool

instance El1 f => El (Fix f) where
    newtype Set (Fix f) = FixSet (Set1 f (Set (Fix f)))
    empty = FixSet empty1
    full = FixSet full1
    insert (Fix x) (FixSet s) = FixSet (insert1 x s)
    remove (Fix x) (FixSet s) = FixSet (remove1 x s)
    (FixSet s) `contains` (Fix x) = s `contains1` x

和往常一样，我们将把一些函子组合成更大的函子，然后再利用结果函子的不动点生成一个具体类型

newtype I a = I a
newtype K c a = K c
data (f :* g) a = f a :* g a
data (f :+ g) a = L (f a) | R (g a)
type N = K ()

比如说,

empty :: NatSet
empty = Empty empty

insert :: Nat -> NatSet -> NatSet
insert Zero (Empty natverse)       = Full natverse
insert Zero (Full natverse)        = Full natverse
insert (Succ nat) (Empty natverse) = Empty (insert nat natverse)
insert (Succ nat) (Full natverse)  = Full (insert nat natverse)

member :: Nat -> NatSet -> Bool 
member Zero (Full natverse)        = True
member Zero (Empty natverse)       = False
member (Succ nat) (Empty natverse) = member nat natverse
member (Succ nat) (Full natverse)  = member nat natverse

main = do
    let set = foldr insert empty [Zero, Succ (Succ Zero), Succ (Succ (Succ (Succ (Succ Zero))))]
    print $ member Zero set
    print $ member (Succ Zero) set
    print $ member (Succ (Succ Zero)) set
    print $ member (Succ (Succ (Succ Zero))) set
    print $ member (Succ (Succ (Succ (Succ Zero)))) set
    print $ member (Succ (Succ (Succ (Succ (Succ Zero))))) set

type Nat = Fix (N :+ N)
type Tree = Fix (N :+ (I :* I))

让我们把这些东西做一套

I

（用于标识）是多项式中

Fix

将插入递归子结构的位置。我们只需将其

El\ucode>的实现委托给
Fix

instance El1 I where
    newtype Set1 I a = ISet1 a
    empty1 = ISet1 empty
    full1 = ISet1 full
    insert1 (I x) (ISet1 s) = ISet1 (insert x s)
    remove1 (I x) (ISet1 s) = ISet1 (remove x s)
    (ISet1 s) `contains1` (I x) = s `contains` x

常量函子
kc
没有递归子结构，但它确实具有
c
类型的值。如果
c
可以放在一个集合中，那么
kc
也可以放在一个集合中

instance El c => El1 (K c) where
    newtype Set1 (K c) a = KSet1 (Set c)
    empty1 = KSet1 empty
    full1 = KSet_ full
    insert1 (K x) (KSet1 s) = KSet1 (insert x s)
    remove1 (K x) (KSet1 s) = KSet1 (remove x s)
    (KSet1 s) `contains1` (K x) = s `contains` x

请注意，此定义使
set1n
同构于
Bool

总的来说，让我们用我们的直觉，测试成员资格就像索引。索引到元组时，可以在元组的左侧成员和右侧成员之间进行选择

instance (El1 f, El1 g) => El1 (f :+ g) where
    data Set1 (f :+ g) a = SumSet1 (Set1 f a) (Set1 g a)
    empty1 = SumSet1 empty1 empty1
    full1 = SumSet1 full1 full1
    insert1 (L x) (SumSet1 l r) = SumSet1 (insert1 x l) r
    insert1 (R y) (SumSet1 l r) = SumSet1 l (insert1 y r)
    remove1 (L x) (SumSet1 l r) = SumSet1 (remove1 x l) r
    remove1 (R y) (SumSet1 l r) = SumSet1 l (remove1 y r)
    (SumSet1 l r) `contains1` (L x) = l `contains1` x
    (SumSet1 l r) `contains1` (R y) = r `contains1` y

现在，这就足够做一组自然数了。使用
Show
的适当实例，您可以执行以下操作：

ghci> let z = Fix (L (K ()))
ghci> let s n = Fix (R (I n))
ghci> insert (s z) empty `contains` z
False
ghci> insert (s z) empty `contains` (s z)
True
ghci> empty :: Set (Fix (N :+ I))
FixSet (SumSet1 (KSet1 (UnitSet False)) (ISet1 (FixSet (  -- to infinity and beyond


我还没有回答您最初的问题，即这对产品类型应该如何工作？我可以想出一些策略，但没有一个真正起作用

我们可以把
Set1（f:*g）设为一个
a和类型。这有一个令人愉悦的对称性：和的集合是乘积，乘积的集合是和。在索引思想的上下文中，这就像说“为了从集合中获得一个
Bool
，你必须给出一个索引来处理这两种可能的情况”，就像
a b
的消除规则
（a->c）->（b->c）->a b->c
。但是，当您试图为
empty1
和
full1
提供有意义的值时，您会遇到困难：

instance (El1 f, El1 g) => El1 (f :* g) where
    data Set1 (f :* g) a = LSet1 (Set1 f a) | RSet1 (Set1 g a)
    insert1 (l :* r) (LSet1 x) = LSet1 (insert1 l x)
    insert1 (l :* r) (RSet1 y) = RSet1 (insert1 r y)
    remove1 (l :* r) (LSet1 x) = LSet1 (remove1 l x)
    remove1 (l :* r) (RSet1 y) = RSet1 (remove1 r y)
    (LSet1 x) `contains1` (l :* r) = x `contains1` l
    (RSet1 y) `contains1` (l :* r) = y `contains1` r
    empty1 = _
    full1 = _

您可以尝试将hacky
Empty
和
Full
构造函数添加到
Set1（f:*g）
中，但随后您将难以实现
insert1
和
remove1

您可以将产品类型的集合解释为产品两部分的一对集合。如果一个项目的两部分都在各自的集合中，则该项目在集合中。就像一种广义的交集

instance (El1 f, El1 g) => El1 (f :* g) where
    data Set1 (f :* g) a = ProdSet1 (Set1 f a) (Set1 g a)
    insert1 (l :* r) (ProdSet1 s t) = ProdSet1 (insert1 l s) (insert1 r t)
    remove1 (l :* r) (ProdSet1 s t) = ProdSet1 (remove1 l s) (remove1 r t)
    (ProdSet1 s t) `contains1` (l :* r) = (s `contains1` l) && (t `contains1` r)
    empty1 = ProdSet1 empty1 empty1
    full1 = ProdSet1 full1 full1

但是这个实现不能正常工作。注意：

ghci> let tip = Fix (L (K ()))
ghci> let fork l r = Fix (R (I l :* I r))
ghci> let s1 = insert (fork tip tip) empty
ghci> let s2 = remove (fork tip (fork tip tip)) s1
ghci> s2 `contains` (fork tip tip)
False

卸下
叉尖（叉尖）
也卸下
叉尖
tip
已从集合的左半部分删除，这意味着其左分支为
tip
的任何树都已与其一起删除。我们移走的物品比预期的多。（但是，如果您不需要对集合执行
删除
操作，此实现可以工作-尽管这只是另一个令人失望的不对称现象。）您可以使用
|
而不是
&
来实现
包含
，但这样您将插入比预期更多的项

最后，我还考虑将一组产品视为一组产品

data Set1 (f :* g) a = ProdSet1 (Set1 f (Set1 g a))

这不起作用-尝试实现任何
El1
的方法，您会立即陷入困境

所以最终你的直觉是对的。产品类型是问题所在。对于产品类型，集合没有有意义的结构表示

当然，这些都是学术性的。多项式函子的不动点有一个定义良好的等式和顺序概念，所以你可以像其他人一样表示集合，甚至是乘积类型。但它不会有这么好的渐近性：对这些值的相等性和排序测试是O（n）（其中n是值的大小），对这些集进行成员资格操作O（n log m）（其中m是集的大小），因为集本身被表示为一个平衡树。与我们的通用结构集不同，其中成员操作是O（n）。
（我刚刚注意到这个
BinSet
类型是无用的，因为对于严格的求值器，它不会停止，对于懒惰的求值器，它将生成巨大的thunk，本质上是
O（n）
。这可以通过添加终端构造函数来修复。）有趣！我现在没有答案，但我会的