列表基于正确的Kan扩展

Question

在Ralf Hinze的" Kan Extensions for Program Optimization "中,有一个List类型的定义,基于monoid类别中遗忘函子的右Kan延伸(第7.4节).本文给出了Haskell实现如下:

newtype List a = Abstr {
  apply :: forall z . (Monoid z) => (a -> z) -> z
  } 

我能够定义通常的nil和cons构造函数:

nil :: List a
nil = Abstr (\f -> mempty)

cons :: a -> List a -> List a
cons x (Abstr app) = Abstr (\f -> mappend (f x) (app f))

使用以下为Maybe functor的Monoid类实例,我设法定义了head函数:

instance Monoid (Maybe a) where
  mempty = Nothing
  mappend Nothing m = m
  mappend (Just a) m = Just a

head :: List a -> Maybe a
head (Abstr app) = app Just

问题:如何定义尾部函数？

Answer 1

这是一个相当原则的解决方案,一次性实现头部和尾部(全部要点):

首先,我们知道如何追加列表(稍后会有用):

append :: List a -> List a -> List a
append (Abstr xs) (Abstr ys) = Abstr (\ f -> xs f <> ys f)

然后我们引入一个新类型Split,我们将用它来检测a是否List为空(并且在非空的情况下得到头部和尾部):

newtype Split a = Split { outSplit :: Maybe (a, List a) }

这种新类型形成一个幺半群:确实我们知道如何附加两个列表.

instance Monoid (Split a) where
  mempty = Split Nothing
  mappend (Split Nothing)        (Split nns)            = Split nns
  mappend (Split mms)            (Split Nothing)        = Split mms
  mappend (Split (Just (m, ms))) (Split (Just (n, ns))) =
    Split $ Just (m, append ms (cons n ns))

这意味着,我们可以从得到一个函数List a来Split a使用List a的apply:

split :: List a -> Split a
split xs = apply xs $ \ a -> Split $ Just (a, nil)

head并且tail最终可以从split以下方面得到:

head :: List a -> Maybe a
head = fmap fst . outSplit . split

tail :: List a -> Maybe (List a)
tail = fmap snd . outSplit . split

Answer 2

这个列表作为免费monoid的实现在包中提供fmlist,它注意到它的一些有趣的属性(不同于大多数列表的实现,它们是正确的,这个是真正无偏见的;你可以创建任意树,当然,当然幺半群法则强迫你把它看成扁平的,你仍然可以观察到无限情况下的一些差异.这几乎是一个Haskell的怪癖 - 通常是自由的幺半群.它也有一个实现tail,所以这是你的问题的答案(但见下文).

通过这些类型的表示(不仅仅是这个特定的一个,还有例如forall r. (a -> r -> r) -> r -> r列表),通常有一些操作(例如追加)变得更容易,而一些(例如拉链和尾部)变得更加困难.这在不同的地方进行了一些讨论,例如如何获取tail功能流.

fmlist但是,仔细观察一下,它的解决方案非常不令人满意:它只是将你给它的漂亮的平衡树转换为一个右偏置列表foldr,它允许它进行常规列表操作,但是失去了幺半群结构."中等无限"列表的尾部不再是"中间无限",它就像一个常规列表一样正确无限.

应该有可能想出一个聪明的Monoid实例来计算尾部,同时尽可能少地干扰结构的其余部分,但是一个明显的实例并不会让人想到.我可以想到一个非巧妙的"蛮力"解决方案:使用无效Monoid实例欺骗并将"列表" 重新整理到树中,检查树,然后将其折叠起来以使最终结果有效.这是我的nonfree包装的样子和fmlist:

nail :: FM.FMList a -> FM.FMList a
nail (FM.FM k) = FM.FM $ \f -> foldMap f (nail' (k N))

nail' :: N a -> N a
nail' NEmpty = error "nail' NEmpty"
nail' (N x) = NEmpty
nail' (NAppend l r) =
  case normalize l of
    NEmpty -> nail' r
    N x -> r
    l' -> NAppend (nail' l') r

-- Normalize a tree so that the left side of a root NAppend isn't an empty
-- subtree of any shape. If the tree is infinite in a particular way, this
-- won't terminate, so in that sense taking the tail of a list can make it
-- slightly worse (but you were already in pretty bad shape as far as
-- operations on the left side are concerned, and this is a pathological case
-- anyway).
normalize :: N a -> N a
normalize (NAppend l r) =
  case normalize l of
    NEmpty -> normalize r
    l' -> NAppend l' r
normalize n = n