16

我正在玩一些类似免费的想法，发现了这个：

{-# LANGUAGE RankNTypes #-}

data Monoid m = Monoid { mempty :: m, mappend :: m -> m -> m }
data Generator a m = Generator { monoid :: Monoid m, singleton :: a -> m }

newtype Free f = Free { getFree :: forall s. f s -> s }

mkMonoid :: (forall s. f s -> Monoid s) -> Monoid (Free f)
mkMonoid f = Monoid {
    mempty = Free (mempty . f),
    mappend = \a b -> Free $ \s -> mappend (f s) (getFree a s) (getFree b s)
}

freeMonoid :: Monoid (Free Monoid)
freeMonoid = mkMonoid id

mkGenerator :: (forall s. f s -> Generator a s) -> Generator a (Free f)
mkGenerator f = Generator {
    monoid = mkMonoid (monoid . f),
    singleton = \x -> Free $ \s -> singleton (f s) x
}

freeGenerator :: Generator a (Free (Generator a))
freeGenerator = mkGenerator id

我想找到可以编写函数的条件：

mkFree :: (??? f) => f (Free f)

但我一直无法找到一个有意义的结构f（除了一个简单的结构，其中mkFree是 的一种方法???），它允许编写这个函数。特别是，如果这个结构没有提到Free类型，我的审美会更喜欢。

有没有人见过这样的东西？这种概括可能吗？在我还没有想到的方向上是否有一个已知的概括？

4

1 回答 1

8

与通用代数的链接是一个很好的起点，在阅读了一点之后，一切都到位了。我们正在寻找的是一个 F 代数：

type Alg f x = f x -> x

对于任何 (endo)functor f。例如，对于 Monoid 代数，函子是：

data MonoidF m = MEmpty | MAppend m m deriving Functor

对于任何Monoid情况，都有明显的幺半群​​代数：

monoidAlg :: Monoid m => Alg MonoidF m
monoidAlg MEmpty = mempty
monoidAlg (MAppend a b) = mappend a b

现在我们可以从 free-functors 包中获取自由函子定义，并用 f-algebra 替换类约束：

newtype Free f a = Free { runFree :: forall b. Alg f b -> (a -> b) -> b }

从某种意义上说，自由函子是将任何集合a转化为代数的最佳方式。这是如何：

unit :: a -> Free f a
unit a = Free $ \_ k -> k a

这是最好的方法，因为对于a转换为代数的任何其他方法b，我们可以将自由代数中的函数赋予b：

rightAdjunct :: Functor f => Alg f b -> (a -> b) -> Free f a -> b
rightAdjunct alg k (Free f) = f alg k

剩下的就是实际证明自由函子创建了一个 f 代数（这就是你所要求的）：

freeAlg :: Functor f => Alg f (Free f a)
freeAlg ff = Free $ \alg k -> alg (fmap (rightAdjunct alg k) ff)

稍微解释一下：ff是类型f (Free f a)，我们需要构建一个Free f a. 如果我们可以构建一个b, givenalg :: f b -> b和，我们就可以做到这一点k :: a -> b。因此alg，ff如果我们可以将Free f a它包含的每个映射到 a ，我们就可以申请b，但这正是and的rightAdjunct作用。algk

你可能已经猜到了，这Free f是函子上的自由单子f（准确地说是教堂编码的版本。）

instance Functor f => Monad (Free f) where
  return = unit
  m >>= f = rightAdjunct freeAlg f m
于 2013-02-26T10:22:28.780 回答