用于红黑树的 Haskell 函子

Question

所以我正在学习 Haskell，我有一个红黑树，在红黑节点中具有不同类型，如下实现：

data Rbtree a1 b1 = EmptyTree | Node a1 (Rbtree b1 a1) (Rbtree b1 a1) deriving (Show, Read, Eq)

现在我需要为它定义一个仿函数实例。因为Rbtree 是一个接受两个参数的类型构造函数，所以我必须为Rbtree c 创建一个实例。在此之后我被困住了。我的代码现在是这样的：

instance Functor (Rbtree c) where
fmap f EmptyTree = EmptyTree
fmap f (Node x left right) = Node x (fmap f left) (fmap f right)

正如你可能猜到的那样，它不会编译。 (compilation errors)。我知道fmap 因为它必须是(a -> b) -> (Rbtree c) a -> (Rbtree c) b 并且更深入地寻找Node 部分它必须是(a -> b) -> (Node c (Rbtree a c) (Rbree a c)) -> (Node c (Rbtree b c) (Rbree b c))。我不明白的是如何展开left 和right，所以我只能将f 应用于其中的一部分。我想我在这里遗漏了一些东西。

Answer 1

您可以像这样将Rbtree 设为Bifunctor（参见bifunctors package）：

import Data.Bifunctor

data Rbtree a1 b1 = EmptyTree | Node a1 (Rbtree b1 a1) (Rbtree b1 a1)

instance Bifunctor Rbtree where
  bimap _ _ EmptyTree = EmptyTree
  bimap f g (Node x l r) = Node (f x) (bimap g f l) (bimap g f r)

有了这个实例，您现在可以同时使用 first 和 second 函数来映射红色或黑色节点 (second ~ fmap)。实际上你可以像这样定义Functor 实例：

instance Functor (Rbtree c) where
  fmap = second

---

示例

>>> let t = Node 1 (Node "hello" EmptyTree EmptyTree) EmptyTree
>>> bimap show length t
Node "1" (Node 5 EmptyTree EmptyTree) EmptyTree
>>> fmap length t
Node 1 (Node 5 EmptyTree EmptyTree) EmptyTree
>>> first show t
Node "1" (Node "hello" EmptyTree EmptyTree) EmptyTree

Answer 2

您可以使用GADTs 和某些类型的hackery（existential quantification、type arithmetic、data kinds）强制执行所有Red-Black tree invariants。属性是：

1. 节点不是红色就是黑色。
2. 根是黑色的。
3. 所有叶子 (NIL) 都是黑色的。
4. 每个红色节点必须有两个黑色子节点。
5. 从给定节点到其任何后代的每条路径 叶包含相同数量的黑色节点。

这里是示例代码：

{-# LANGUAGE GADTs, StandaloneDeriving, ExistentialQuantification,
             KindSignatures, DataKinds #-}

data Nat = Zero | Succ Nat
data Color = Red | Black

data Node :: Color -> Nat -> * -> * where
    Nil :: Node Black Zero a
    RedNode :: a -> Node Black n a -> Node Black n a -> Node Red n a
    BlackNode :: a -> Node c1 n a -> Node c2 n a -> Node Black (Succ n) a

data RBTree a = forall n. RBTree (Node Black n a)

deriving instance (Show a) => Show (Node c n a)
deriving instance (Show a) => Show (RBTree a)

instance Functor (Node c n) where
    fmap f Nil = Nil
    fmap f (RedNode   x l r) = RedNode   (f x) (fmap f l) (fmap f r)
    fmap f (BlackNode x l r) = BlackNode (f x) (fmap f l) (fmap f r)

instance Functor RBTree where
    fmap f (RBTree t) = RBTree (fmap f t)

你可以这样使用它：

tree = RBTree $ BlackNode 3 (RedNode 4 Nil Nil) (RedNode 5 Nil Nil)
main = print $ fmap (*5) tree

结果：

RBTree (BlackNode 15 (RedNode 20 Nil Nil) (RedNode 25 Nil Nil))

但这不会编译：

tree = RBTree $ BlackNode 3 (RedNode 4 Nil Nil) (BlackNode 5 Nil Nil)

你会得到一个nice错误信息：

Couldn't match type `Succ Zero' with `Zero'
Expected type: Node Black Zero a0
  Actual type: Node Black (Succ Zero) a0
In the return type of a call of `BlackNode'
In the third argument of `BlackNode', namely
  `(BlackNode 5 Nil Nil)'
In the second argument of `($)', namely
  `BlackNode 3 (RedNode 4 Nil Nil) (BlackNode 5 Nil Nil)'

Answer 3

instance Functor (Rbtree c) where
  fmap = fmap_even where
     fmap_even _ EmptyTree = EmptyTree
     fmap_even f (Node x left right) = Node x (fmap_odd f left) (fmap_odd f right)
     fmap_odd  _ EmptyTree = EmptyTree
     fmap_odd  f (Node x left right) = Node (f x) (fmap_even f left) (fmap_even f right)

您对 RB 树的定义对我来说没有多大意义，但如果我遗漏了什么，这里有一个与之兼容的 Functor 实例。