如何为一个通用递归方案构建的数据类型提供一个Functor实例？

Question

我有一个递归数据类型，它具有Functor实例：

我有一个递归数据类型，它具有Functor实例：

data Expr1 a
  = Val1 a
  | Add1 (Expr1 a) (Expr1 a)
  deriving (Eq, Show, Functor)

现在，我有兴趣修改这种数据类型以支持一般的递归方案，正如这个教程和这个Hackage包中所描述的那样。我设法使卡特曼分解起作用：

newtype Fix f = Fix {unFix :: f (Fix f)}

data ExprF a r
  = Val a
  | Add r r
  deriving (Eq, Show, Functor)

type Expr2 a = Fix (ExprF a)

cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = f . fmap (cata f) . unFix

eval :: Expr2 Int -> Int
eval = cata $ \case
  Val n -> n
  Add x y -> x + y

main :: IO ()
main =
  print $ eval
    (Fix (Add (Fix (Val 1)) (Fix (Val 2))))

但是现在我无法弄清如何给Expr2相同的函子实例，就像原来的Expr一样。当尝试定义函子实例时，似乎存在类型不匹配的问题。

instance Functor (Fix (ExprF a)) where
    fmap = undefined

Kind mis-match
    The first argument of `Functor' should have kind `* -> *',
    but `Fix (ExprF a)' has kind `*'
    In the instance declaration for `Functor (Fix (ExprF a))'

如何为Expr2编写一个Functor实例？

我考虑过使用newtype Expr2 a = Expr2 (Fix (ExprF a))将Expr2包装起来，但是这个新类型需要被解包才能被传递给cata，这让我不太喜欢。我也不知道是否可以像我对Expr1所做的那样自动派生出Expr2的functor实例。

- hugomg

---

我认为这样做不行，尤其是你试图使用类型别名的时候。 - Louis Wasserman

@LouisWasserman：假设我最终使用Expr2的新类型，是否有一种方法可以像我对Expr1所做的那样自动派生函子实例？ - hugomg

你不能自动派生函数子类型实例，例如 newtype Expr a = Expr (Fix (ExprF a))，因为 Fix 不是一个函数子类型。如果你将其改为 data Fix f a = Fix (f (Fix f a))，那么你就可以编写一个类似于 instance Functor f => Functor (Fix f) 的函数子类型实例，并且你不需要使用新类型。 - user2407038

Answer 1

这对我来说是一个老问题。关键点在于你的 ExprF 在其两个参数中都是函子的。因此，如果我们有

class Bifunctor b where
  bimap :: (x1 -> y1) -> (x2 -> y2) -> b x1 x2 -> b y1 y2

然后你可以定义（或想象一台机器为你定义）

instance Bifunctor ExprF where
  bimap k1 k2 (Val a)    = Val (k1 a)
  bimap k1 k2 (Add x y)  = Add (k2 x) (k2 y)

现在您可以拥有：

newtype Fix2 b a = MkFix2 (b a (Fix2 b a))

伴随着

map1cata2 :: Bifunctor b => (a -> a') -> (b a' t -> t) -> Fix2 b a -> t
map1cata2 e f (MkFix2 bar) = f (bimap e (map1cata2 e f) bar)

这反过来意味着，当您在其中一个参数中取一个不动点时，剩下的部分仍然是另一个参数的函子。

instance Bifunctor b => Functor (Fix2 b) where
  fmap k = map1cata2 k MkFix2

你可能已经得到了你想要的结果。但是你的 Bifunctor 实例不会神奇地构建出来。而且需要一个不同的 fixpoint 操作符和一个全新的 functor，这有点烦人。问题在于现在你有了两种子结构："值"和"子表达式"。

接下来就是关键。 有一种 functor 的概念是在 fixpoints 下是封闭的。打开厨房水槽（尤其是 DataKinds），然后……

type s :-> t = forall x. s x -> t x

class FunctorIx (f :: (i -> *) -> (o -> *)) where
  mapIx :: (s :-> t) -> f s :-> f t

请注意，"元素"属于一种以 i 为索引的类型，而"结构"属于一种以其他某个 o 为索引的类型。我们可以将对元素进行 i-保留函数转换成对结构进行 o-保留函数的转换。重要的是，i 和 o 可能是不同的。

魔法词语是 "1, 2, 4, 8, 指数运算时间！"。一种 * 类型可以轻松地转换成一种嵌套 GADT 类型，其索引为 () -> *。而两种类型可以合并成一种 GADT 类型，其索引为 Either () () -> *。这意味着我们可以将所有子结构组合在一起。总体上，我们拥有了一种类型级别的 either。

data Case :: (a -> *) -> (b -> *) -> Either a b -> * where
  CL :: f a -> Case f g (Left a)
  CR :: g b -> Case f g (Right b)

配备了它的“地图”概念

mapCase :: (f :-> f') -> (g :-> g') -> Case f g :-> Case f' g'
mapCase ff gg (CL fx) = CL (ff fx)
mapCase ff gg (CR gx) = CR (gg gx)

因此，我们可以将我们的双向因子重构为以Either为索引的FunctorIx实例。

现在，我们可以对任何具有元素p或子节点位置的节点结构f进行不动点操作。这与上面讨论的情况完全相同。

newtype FixIx (f :: (Either i o -> *) -> (o -> *))
              (p :: i -> *)
              (b :: o)
  = MkFixIx (f (Case p (FixIx f p)) b)

mapCata :: forall f p q t. FunctorIx f =>
  (p :-> q) -> (f (Case q t) :-> t) -> FixIx f p :-> t
mapCata e f (MkFixIx node) = f (mapIx (mapCase e (mapCata e f)) node)

但现在我们已经知道，FunctorIx 在 FixIx 下保持封闭。

instance FunctorIx f => FunctorIx (FixIx f) where
  mapIx f = mapCata f MkFixIx

对于可变指数的索引集合上的函子，可以非常精确和强大。它们比Functor具有更多方便的闭包属性。我不认为它们会流行起来。

- pigworker

Answer 2

我想你最好使用“Free”类型：

data Free f a
  = Pure a
  | Wrap (f (Free f a))
deriving Functor

data ExprF r
  = Add r r
deriving Functor

这样做的另一个好处是已经有相当多的自由单元库可以使用，因此也许它们可以为您节省一些工作。

- John L

---

非常好的建议，在我看来。就像容器类型一样，树也是另一个单子模拟，其中return表示“从任意值构造一个单节点树”，而>>=表示“用通过将函数应用于其内容生成的子树替换叶节点”。 - Luis Casillas

接受这个问题，因为在这种特殊情况下，它提供了最多的“免费”东西，其中a参数仅出现在叶子上，并且不需要使用newtype包装器。虽然我猜Bifunctor版本更通用。 - hugomg

Answer 3

虽然pigworker的回答没问题，但也许你可以使用一个更简单的作为过渡：

{-# LANGUAGE DeriveFunctor, ScopedTypeVariables #-}

import Prelude hiding (map)

newtype Fix f = Fix { unFix :: f (Fix f) }

-- This is the catamorphism function you hopefully know and love
-- already.  Generalizes 'foldr'.
cata :: Functor f => (f r -> r) -> Fix f -> r
cata phi = phi . fmap (cata phi) . unFix

-- The 'Bifunctor' class.  You can find this in Hackage, so if you
-- want to use this just use it from there.
--
-- Minimal definition: either 'bimap' or both 'first' and 'second'.
class Bifunctor f where
    bimap :: (a -> c) -> (b -> d) -> f a b -> f c d
    bimap f g = first f . second g

    first :: (a -> c) -> f a b -> f c b
    first f = bimap f id

    second :: (b -> d) -> f a b -> f a d
    second g = bimap id g

-- The generic map function.  I wrote this out with
-- ScopedTypeVariables to make it easier to read...
map :: forall f a b. (Functor (f a), Bifunctor f) => 
       (a -> b) -> Fix (f a) -> Fix (f b)
map f = cata phi 
    where phi :: f a (Fix (f b)) -> Fix (f b)
          phi = Fix . first f

现在你的表达式语言是这样工作的：

-- This is the base (bi)functor for your expression type.
data ExprF a r = Val a 
               | Add r r
               deriving (Eq, Show, Functor)

instance Bifunctor ExprF where
    bimap f g (Val a) = Val (f a)
    bimap f g (Add l r) = Add (g l) (g r)

newtype Expr a = Expr (Fix (ExprF a))

instance Functor Expr where
    fmap f (Expr exprF) = Expr (map f exprF)

编辑：这里是bifunctors包在Hackage中的链接。

- Luis Casillas

---

有趣。这与我之前偶然发现的解决方案非常相似，只是我的 map 实现更丑陋，因为我不知道 BiFunctors :) - hugomg

Answer 4

关键字“type”仅作为现有类型的同义词使用，也许这正是您要寻找的。

newtype Expr2 a r = In { out :: (ExprF a r)} deriving Functor

- felipez