Haskell 自由与余自由的不动点函子

为了说明这一点，我并不是在谈论，也就是说，

freeff

基本上是一个

f

的固定点。（并不是说这不有趣！）

我所说的是

Free，Cofree的不动点：（*->*）->（*->*）

，即函子

f

，使得

Free f

与

f

本身同构

背景：今天，为了巩固我对自由单子的理解，我决定只写几个不同的简单函子，两个都写，看看它们同构于哪个更知名的[co]单子。让我特别感兴趣的是这个发现（意思是，

constvoid

，一个将任何类型映射到无人居住的函子）。好吧，也许这太愚蠢了——我发现如果你把空垃圾放进去，你就会把空垃圾拿出来，是的但是，嘿，这是范畴理论，整个宇宙从看似琐碎的事物中崛起。。。对吧?

眼前的问题是，如果

Cofree

有这样一个固定点，那么

Free

呢？当然，它不可能是空的，因为它不是单子。快速嫌疑犯可能是附近的某个东西，如

Const（）

或

Identity

，但不是：

Free (Const ()) ~~ Either () ~~ Maybe
Free Identity   ~~ (Nat,)    ~~ Writer Nat

事实上，

Free

总是添加一个额外的构造函数这一事实表明，任何函子的结构如果是一个不动点，就必须是无限的。但奇怪的是，如果

Cofree

有这么一个简单的固定点，

Free

应该只有一个更复杂的固定点（就像Reid Barton在评论中提出的按结构修复

FixFree a=C（Free-FixFree a）

）

---

无聊的事实是，

Free

没有“偶然的固定点”，而

Cofree

有一个“偶然的固定点”只是巧合，还是我遗漏了什么？

你的观察结果是，

Empty

是一个

Cofree

的固定点（这在Haskell中并不是真的，但我猜您希望在忽略

⊥，如设置）归结为以下事实：

有一个集合E（空集），使得对于每个集合X，投影p₂ : X×E->E是一个同构

在这种情况下，我们可以说E是产品的吸引对象。对于任何C类产品，我们可以用“C的对象”替换“集合”，我们得到一个关于C的陈述，这个陈述可能是真的，也可能不是真的。对于集合，它恰好是真的

如果我们选择C=Setop，它也有乘积（因为Set有副乘积），然后将语言二元化，再次讨论集合，我们得到了语句

有一个集合F，使得对于每个集合Y，包含i₂ : F->Y+F是一个同构

显然，这句话对于任何集合F都是不正确的（我们可以选择任何非空集合Y作为任何F的反例）

所以，我们不会得到一个免费的“平凡不动点”，就像我们得到一个免费的“平凡不动点”一样，因为Setop和Set在性质上是不同的。Set的初始对象是乘积的吸收元素，但Set的终端对象不是副积的吸收对象


请允许我在我的肥皂盒上呆一会儿：

Haskell程序员对哪些结构是其他结构的“对偶”进行了大量讨论。大多数讨论在形式意义上是没有意义的，因为在范畴理论中，对偶结构的工作原理如下：

假设我有一个可以在任何C类（或具有某些额外结构和/或属性的任何类别）上执行的构造，那么C类上的对偶构造就是相反类别Cop上的原始构造（最好具有我们需要的额外结构和属性，如果有的话）

例如：通过定义产品的通用属性，产品的概念在任何类别C中都是有意义的（尽管产品可能并不总是存在）。要得到C中的副产品的双重概念，我们应该问Cop中的产品是什么，我们刚刚定义了任何类别中的产品，所以这个概念是有意义的

将二元性应用于Haskell设置的问题在于，Haskell语言压倒性地倾向于只讨论一个类别Hask，我们在其中进行构造。这就导致了讨论二元性的两个问题：


为了获得如上所述的一个结构的对偶，我应该能够在任何类别中进行构造，或者至少在某一特定形式的任何类别中进行构造。因此，我们必须首先将我们仅在类别中进行的构造推广到更大的类别中。（这样做之后，除了Haskop之外，我们还有很多其他有趣的类别，比如单体的Kleisli类别。）

Hask类别具有许多特殊属性，可以这样概括（忽略
⊥）Hask是笛卡尔封闭范畴。例如，这意味着初始对象是产品的吸收对象。Haskop没有这些属性，这意味着广义概念在Haskop中可能没有意义；也可能意味着在Haskop中碰巧相等的两个概念在总体上是不同的，并且具有相同的性质不同的二元论


对于后者，以透镜为例。在Hask中，它们可以用多种方式构造；有两种方式是用getter/setter对和costate comonad的余代数。前者是用乘积来概括类别，第二种是用Hask的特定方式来丰富类别。如果我们将前者的构造应用于Haskop然后我们得到棱柱，但是如果我们将后一种构造应用到Haskop，那么我们得到的是状态单子的代数，而这些不是
return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b

extract :: w a -> a
extend :: w a -> (w b -> a) -> w b

newtype FixFree a = C (Free FixFree a)

newtype Fix f a = Fix (f (Fix f) a)
instance Functor (f (Fix f)) => Functor (Fix f) where
  fmap f (Fix x) = Fix (fmap f x)

-- This is basically `MFunctor` from `Control.Monad.Morph`
class FFunctor (g :: (* -> *) -> * -> *) where
  hoistF :: Functor f => (forall a . f a -> f' a) -> g f b -> g f' b

instance FFunctor Free where
  hoistF _f (Pure a) = Pure a
  hoistF f (Free fffa) = Free . f . fmap (hoistF f) $ fffa

fToFixG :: (Functor f, FFunctor g) => (forall a . f a -> g f a) -> f a -> Fix g a
fToFixG fToG fa = Fix $ hoistF (fToFixG fToG) $ fToG fa

fixGToF :: forall f b (g :: (* -> *) -> * -> *) .
           (FFunctor g, Functor (g (Fix g)))
        => (forall a . g f a -> f a) -> Fix g b -> f b
fixGToF gToF (Fix ga) = gToF $ hoistF (fixGToF gToF) ga