使用 Comonad Fix 组合器

Question

所以我最近一直在尝试固定点，终于挣扎了 通过常规的固定点足以发现一些用途;现在我要继续 昏迷的固定点，恐怕我卡住了;

以下是我尝试过和有效/无效的一些示例：

{-# language DeriveFunctor #-}
{-# language FlexibleInstances #-}
module WFix where
import Control.Comonad
import Control.Comonad.Cofree
import Control.Monad.Fix

所以我从勒布定理作为一个列表开始;列表的每个元素都是一个函数 它需要最终结果来计算其答案;这让我可以做"电子表格" 其中值可以依赖于其他值的计算。

spreadSheetFix :: [Int]
spreadSheetFix = fix $ result -> [length result, (result !! 0) * 10, (result !! 1) + 1, sum (take 3 result)]

好的，所以我有基本的修复工作，是时候继续使用comonad类型了！ 以下是一些简单的逗号作为示例：

data Stream a = S a (Stream a)
deriving (Eq, Show, Functor)
next :: Stream a -> Stream a
next (S _ s) = s
instance Comonad Stream where
extract (S a _) = a
duplicate s@(S _ r) = S s (duplicate r)
instance ComonadApply Stream where
(S f fs) <@> (S a as) = S (f a) (fs <@> as)
data Tape a = Tape [a] a [a]
deriving (Show, Eq, Functor)
moveLeft, moveRight :: Tape a -> Tape a
moveLeft w@(Tape [] _ _) = w
moveLeft (Tape (l:ls) a rs) = Tape ls l (a:rs)
moveRight w@(Tape _ _ []) = w
moveRight (Tape ls a (r:rs)) = Tape (a:ls) r rs
instance Comonad Tape where
extract (Tape _ a _) = a
duplicate w@(Tape l _ r) = Tape lefts w rights
where
lefts = zipWith const (tail $ iterate moveLeft w) l
rights = zipWith const (tail $ iterate moveRight w) r
instance ComonadApply Tape where
Tape l f r <@> Tape l' a r' = Tape (zipWith ($) l l') (f a) (zipWith ($) r r')

好的，以下组合器来自Control.Comonad;

wfix :: Comonad w => w (w a -> a) -> a
wfix w = extract w (extend wfix w)
cfix :: Comonad w => (w a -> a) -> w a
cfix f = fix (extend f)
kfix :: ComonadApply w => w (w a -> a) -> w a
kfix w = fix $ u -> w <@> duplicate u

我从尝试 wfix 开始：

streamWFix :: Int
streamWFix = wfix st
where
incNext = succ . extract . next
st = (S incNext (S incNext (S (const 0) st)))
> streamWFix
-- 2

这个似乎通过在 w 上调用第一个w a -> a直到达到 在这种情况下const 0的决议;这是有道理的。我们也可以这样做 带胶带：

selfReferentialWFix :: Int
selfReferentialWFix = wfix $ Tape [const 10] ((+5) . extract . moveLeft) []
-- selfReferentialWFix == 15

K，我想我得到了那个，但下一个我有点卡住了， 我似乎对 cfix 应该做什么没有直觉。 即使是我能想到的最简单的事情 永远旋转 当我评估它时;甚至尝试提取流的第一个元素 使用 getOne 失败。

getOne :: Stream a -> a
getOne (S a _) = a
simpleCFix :: Stream Int
simpleCFix = cfix go
where
go _ = 0

kfix 也是如此;即使是简单的尝试似乎也不会终止。 我对 kfix 的理解是每个"插槽"中的函数得到 传递了一份专注于该地点的评估对象的副本;是这样吗？

我尝试对此使用"getOne"：

streamKFix :: Stream Int
streamKFix = kfix st
where
go _ = 0
st = S go st

以下是使用磁带的有限尝试，该尝试也无法运行：

tapeKFix :: Tape Int
tapeKFix = kfix $ Tape [] (const 0) []

所以;对于我的问题，有人可以提供一些可运行(非平凡的(吗？ 使用 cfix 和 kfix 的示例，并解释它们是如何工作的？我计划使用 kfix 最终做一个"康威的 生活游戏"风格的实验，我是否正确认为kfix会有用 与给定细胞周围的社区合作？

随意询问 任何澄清问题并帮助我扩展我的知识和直觉！

谢谢！

Answer 1

Tape的ComonadApply和Comonad实例不够懒惰，无法与kfix一起使用。

duplicateforTape要求您证明磁带存在，然后才能断定结果是Tape

instance Comonad Tape where
extract (Tape _ a _) = a
duplicate w@(Tape l _ r) = Tape lefts w rights
--             ^             ^
-- matches a Tape            |               
-- before determining that the result is a Tape

<@>检查两个参数都是磁带，然后才能得出结论，结果是Tape

instance ComonadApply Tape where
Tape l f r <@> Tape l' a r' = Tape (zipWith ($) l l') (f a) (zipWith ($) r r')
-- ^             ^              ^
-- matches two Tapes            |
-- before detrmining that the result is a Tape

加起来，kfix (Tape _ _ _)不可能产生Tape

kfix w            = fix $ u -> w            <@> duplicate u
kfix (Tape _ _ _) = fix $ u -> (Tape _ _ _) <@> duplicate u
kfix (Tape _ _ _) = fix $ u -> (Tape _ _ _) <@> case u of (Tape _ _ _) -> ...
--                         ^                                |
--                         ----------- <<loop>> -------------

你可以通过使用无可辩驳的模式来提高duplicate、<@>或两者的生产力来解决此问题。即使尚未生成Tape构造函数，模式~(Tape l a r)匹配。以下是如何使用它来提高duplicate工作效率

instance Comonad Tape where
extract (Tape _ a _) = a
duplicate w@(~(Tape l _ r)) = Tape lefts w rights
where
lefts = zipWith const (tail $ iterate moveLeft w) l
rights = zipWith const (tail $ iterate moveRight w) r

无可辩驳的模式匹配等效于使用函数提取值。对于duplicate来说，这相当于写作

left  (Tape l _ _) = l
right (Tape _ _ r) = r
instance Comonad Tape where
extract (Tape _ a _) = a
duplicate w = Tape lefts w rights
where
l = left w
r = right w
...