17
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
import Control.Comonad
import Data.Functor.Reverse
import Data.List (unfoldr)

首先是一些背景(哈哈)。我在非空列表上有一个拉链。

data LZipper a = LZipper (Reverse [] a) a [a]
    deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)

mkZipper :: a -> [a] -> LZipper a
mkZipper = LZipper (Reverse [])

您可以沿着拉链向任一方向迈进,但您可能会从末端跌落。

fwd, bwd :: LZipper a -> Maybe (LZipper a)
fwd (LZipper _ _ []) = Nothing
fwd (LZipper (Reverse xs) e (y:ys)) = Just $ LZipper (Reverse (e:xs)) y ys
bwd (LZipper (Reverse []) _ _) = Nothing
bwd (LZipper (Reverse (x:xs)) e ys) = Just $ LZipper (Reverse xs) x (e:ys)

复制拉链向您展示了您可以查看它的所有方式,重点是您当前查看它的方式。

instance Comonad LZipper where
    extract (LZipper _ x _) = x
    duplicate z = LZipper (Reverse $ unfoldr (step bwd) z) z (unfoldr (step fwd) z)
        where step move = fmap (\y -> (y, y)) . move

例如:

ghci> duplicate (mkZipper 'a' "bc")
LZipper (Reverse [])
        (LZipper (Reverse "") 'a' "bc")
        [LZipper (Reverse "a") 'b' "c",LZipper (Reverse "ba") 'c' ""]
-- Abc -> *Abc* aBc abC

ghci> fmap duplicate (fwd $ mkZipper 'a' "bc")
Just (LZipper (Reverse [LZipper (Reverse "") 'a' "bc"])
              (LZipper (Reverse "a") 'b' "c")
              [LZipper (Reverse "ba") 'c' ""])
-- aBc -> Abc *aBc* abC

(我使用大写和星号来表示拉链的焦点。)


我正在尝试使用具有焦点的二维网格,表示为拉链的拉链。每个内拉链都是一排格子。我的最终目标是通过从邻居跳到邻居来找到穿过网格的路径。

在网格中移动保持所有行都集中在同一个索引上的不变性。这使您可以轻松地专注于您的任何邻居。

type Grid a = LZipper (LZipper a)

up, down, left, right :: Grid a -> Maybe (Grid a)
up = bwd
down = fwd
left = traverse bwd
right = traverse fwd

extractGrid :: Grid a -> a
extractGrid = extract . extract
mkGrid :: (a, [a]) -> [(a, [a])] -> Grid a
mkGrid (x, xs) xss = mkZipper (mkZipper x xs) $ map (uncurry mkZipper) xss

例子:

ghci> let myGrid = mkGrid ('a', "bc") [('d', "ef"), ('g', "hi")]
ghci> myGrid
LZipper (Reverse [])
        (LZipper (Reverse "") 'a' "bc")
        [LZipper (Reverse "") 'd' "ef",LZipper (Reverse "") 'g' "hi"]
-- +-------+ 
-- | A b c |
-- | d e f |
-- | g h i |
-- +-------+

ghci> return myGrid >>= right >>= down
Just (LZipper (Reverse [LZipper (Reverse "a") 'b' "c"])
              (LZipper (Reverse "d") 'e' "f")
              [LZipper (Reverse "g") 'h' "i"])
-- +-------+ 
-- | a b c |
-- | d E f |
-- | g h i |
-- +-------+

我想要的是LZipper's duplicatefor grids 的等价物:一个函数,它接受一个网格并生成一个网格,其中包含您可以查看网格的所有方式,重点是您当前查看它的方式。

duplicateGrid :: Grid a -> Grid (Grid a)

我所期待的:

duplicateGrid myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | a B c | | a b C | |
| * d e f * | d e f | | d e f | |
| * g h i * | g h i | | g h i | |
| ********* +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | a b c | | a b c | | a b c | |
| | D e f | | d E f | | d e F | |
| | g h i | | g h i | | g h i | |
| +-------+ +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | a b c | | a b c | | a b c | |
| | d e f | | d e f | | d e f | |
| | G h i | | g H i | | g h I | |
| +-------+ +-------+ +-------+ |
+-------------------------------+

我试过了duplicateGrid = duplicate . duplicate。这具有正确的类型,但是(假设我show正确地解释了输出,我可能没有)它只给了我集中在第一列某处的网格:

(duplicate . duplicate) myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | a b c | | a b c | |
| * d e f * | D e f | | d e f | |
| * g h i * | g h i | | G h i | |
| ********* +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | A b c | | a b c | | a b c | |
| | d e f | | D e f | | d e f | |
| | g h i | | g h i | | G h i | |
| +-------+ +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | A b c | | a b c | | a b c | |
| | d e f | | D e f | | d e f | |
| | g h i | | g h i | | G h i | |
| +-------+ +-------+ +-------+ |
+-------------------------------+

我也试过了duplicateGrid = duplicate . fmap duplicate。再次假设我能够解释show输出,这给了我一些包含错误网格并且行的焦点未对齐的东西,这样向下移动也会让你继续前进:

(duplicate . fmap duplicate) myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | D e f | | G h i | |
| * a B c * | d E f | | g H i | |
| * a b C * | d e F | | g h I | |
| ********* +-------+ +-------+ |
| +-------+ ********* +-------+ |
| | A b c | * D e f * | G h i | |
| | a B c | * d E f * | g H i | |
| | a b C | * d e F * | g h I | |
| +-------+ ********* +-------+ |
| +-------+ +-------+ ********* |
| | A b c | | D e f | * G h i * |
| | a B c | | d E f | * g H i * |
| | a b C | | d e F | * g h I * |
| +-------+ +-------+ ********* |
+-------------------------------+

对于那些知道的人来说,这感觉像是一个简单的问题,但它让我头晕目眩。我想我可以手动启动一个调用up,和的函数down,但我觉得 comonadic 机器应该能够为我做这件事。什么是正确的实现?leftrightduplicateGrid

4

3 回答 3

9

我们试图Grid用它自己来组合这里有点问题,因为这个设置给了我们太多不正确的方法来实现一个duplicate正确的类型。考虑组合的comonads不一定相同的一般情况是有用的。

假设我们有fgcomonads。的类型duplicate变为:

duplicate :: f (g a) -> f (g (f (g a)))

我们可以仅使用Comonad实例获得以下内容:

duplicate . fmap duplicate :: f (g a) -> f (f (g (g a)))

由此可见,我们需要在中间进行f交换g

有一个名为的类型类Distributive具有我们想要的方法。

class Functor g => Distributive g where
    distribute :: Functor f => f (g a) -> g (f a)

特别是,我们需要实现Distributive g,然后duplicate对于组合的comonad可以实现为:

duplicate = fmap distribute . duplicate . fmap duplicate

但是,文档中Distributive说 的值g必须具有完全相同的形状,因此我们可以将任意数量的副本压缩在一起而不会丢失信息。

为了说明这一点,如果Vec n a是一个n-size 的向量,那么distribute :: [Vec n a] -> Vec n [a]就是矩阵转置。有必要事先确定内部向量的大小,因为“参差不齐”的矩阵上的转置必须删除一些元素,这是不合法的行为。无限流和拉链也分布良好,因为它们也只有一种可能的尺寸。

Zipper是不合法的Distributive,因为Zipper包含具有不同大小上下文的值。尽管如此,我们仍然可以实现假设统一上下文大小的不正确分布。

下面我将根据底层列表的不当分布来duplicate实现Grid

或者,可以直接卷起袖子,Zipper (Zipper a)直接实现转置功能。我实际上是这样做的,但这让我很头疼,而且我远不能确信它是正确的。最好使类型尽可能通用,以缩小可能实现的空间,从而减少出错的空间。

Reverse为了减少语法噪音,我将省略;我希望你原谅我。

{-# language DeriveFunctor #-}

import Control.Comonad
import Data.List
import Control.Monad

data Zipper a = Zipper [a] a [a] deriving (Eq, Show, Functor)

lefts, rights :: Zipper a -> [a]
lefts  (Zipper ls _ _) = ls
rights (Zipper _ _ rs) = rs

bwd :: Zipper a -> Maybe (Zipper a)
bwd (Zipper [] _ _) = Nothing
bwd (Zipper (l:ls) a rs) = Just $ Zipper ls l (a:rs)

fwd :: Zipper a -> Maybe (Zipper a)
fwd (Zipper _ _ []) = Nothing
fwd (Zipper ls a (r:rs)) = Just $ Zipper (a:ls) r rs

instance Comonad Zipper where
  extract (Zipper _ a _) = a
  duplicate z =
    Zipper (unfoldr (fmap (join (,)) . bwd) z) z (unfoldr (fmap (join (,)) . fwd) z)

如果我们事先知道它们的长度,我们可以分发列表。由于 Haskell 列表可以是无限的,我们应该用可能无限的惰性自然数来测量长度。测量长度的另一种解决方案是使用“指南”列表,我们可以沿着该列表压缩其他列表。但是,我不想在分布函数中假设这样一个虚拟列表总是可用的。

data Nat = Z | S Nat

length' :: [a] -> Nat
length' = foldr (const S) Z

distList :: Functor f => Nat -> f [a] -> [f a]
distList Z     fas = []
distList (S n) fas = (head <$> fas) : distList n (tail <$> fas)

当然,如果我们的长度假设不正确,则会出现运行时异常。

如果我们知道上下文的长度,我们可以Zipper通过分布它们的焦点和上下文来分布 s:

distZipper :: Functor f => Nat -> Nat -> f (Zipper a) -> Zipper (f a)
distZipper l r fz = Zipper
  (distList l (lefts <$> fz)) (extract <$> fz) (distList r (rights <$> fz))

最后,我们可以像之前看到的那样复制Grids,但首先我们要确定内部Zippers 的形状。由于我们假设所有Zipper的 inner 都具有相同的形状,所以我们只看Zipper焦点中的 :

duplicateGrid :: Grid a -> Grid (Grid a)
duplicateGrid grid@(Zipper _ (Zipper ls _ rs) _) = 
    fmap (distZipper (length' ls) (length' rs)) $ duplicate $ fmap duplicate grid

测试这个(你一定已经经历过)非常糟糕,而且我还没有动手检查一个 2×2 的案例。

不过,我对上述实现相当有信心,因为定义受到类型的高度限制。

于 2016-03-06T19:01:14.170 回答
7

您遇到的基本问题是拉链本身不支持二维结构。那里的答案很好(另一个答案基本上正是您对 的定义Grid),我鼓励您阅读它,但要点是拉链识别具有到达那里的路径的元素,并且在二维空间中这样的识别是有问题的因为有很多路径可以到达一个点。

因此,您会注意到,虽然您的 supdown函数Grid完全是根据 Zippers 定义的,但您需要使用Traversable机器来定义leftright。这也意味着leftandright不享受与 and 相同的性能属性updown因为可以这么说,您是在“违背常规”。

由于您的Comonad实例仅使用您的 zipper 函数定义,因此它只能duplicate在您的 zipper 定义的方向上,即fwdbwd(以及扩展名updown)。

编辑:经过更多思考,我认为您的方法将从根本上存在问题。我在下面保留了我的原始文本,但还有一个更明显的问题。

如果您尝试像任何 2-d 其他结构一样遍历您的拉链,您将继续Nothing使用duplicate. 让我们注意如果您实际上尝试up, down, left, right在表面上没有问题的duplicate (mkZipper 'a' "bc").

*Main> let allRows = duplicate $ mkZipper 'a' "bc"
*Main> down allRows -- This is fine since we're following the zipper normally
Just (LZipper (Backwards [LZipper (Backwards "") 'a' "bc"]) (LZipper (Backwards "a") 'b' "c") [LZipper (Backwards "ba") 'c' ""])
*Main> right allRows
Nothing -- That's bad...
*Main> down allRows >>= right
Nothing -- Still nothing

移动rightleft要求(正如您在提到不变量时适当指出的那样)您的每个子拉链在结构上都是同质的,否则traverse会过早失效。这意味着,如果你真的想使用leftand right,唯一能很好地使用它的方法duplicate就是尽可能使用最统一duplicate的。

duplicate z @ (LZipper left focus right) = 
    LZipper (fmap (const z) left) z (fmap (const z) right)

另一种方法是只使用拉链自带的功能。这意味着只使用fwdand bwd,然后extracting 焦点并继续使用fwdand获得与andbwd相同的东西。当然,这意味着放弃说“先右后下”和“先下后右”的能力,但正如我们已经看到的那样,拉链不能很好地处理多条路径。leftright

现在让我们再次检查您的直觉,了解如何最好地解释duplicate . duplicate $ myGrid. 一个漂亮的正方形并不是思考正在发生的事情的最佳方式(如果你将自己限制在extractandfwd和,你会明白为什么bwd)。

*Main> let allRows = duplicate . duplicate $ myGrid
*Main> fwd $ extract allRows -- Makes sense
Just ...
-- This *should* be the bottom-left of the grid
*Main> let bottomLeft = extract <$> fwd allRows >>= fwd
*Main> bottomLeft >>= fwd
Nothing -- Nope!
*Main> bottomLeft >>= bwd
Just ... -- Wait a minute...

我们实际上有一个参差不齐的结构。

+---------------------------------------------------+
|                     ********* +-------+ +-------+ |
|                     * A b c * | a b c | | a b c | |
|                     * d e f * | D e f | | d e f | |
|                     * g h i * | g h i | | G h i | |
|                     ********* +-------+ +-------+ |
|           +-------+ +-------+ +-------+           |
|           | A b c | | a b c | | a b c |           |
|           | d e f | | D e f | | d e f |           |
|           | g h i | | g h i | | G h i |           |
|           +-------+ +-------+ +-------+           |
| +-------+ +-------+ +-------+                     |
| | A b c | | a b c | | a b c |                     |
| | d e f | | D e f | | d e f |                     |
| | g h i | | g h i | | G h i |                     |
| +-------+ +-------+ +-------+                     |
+---------------------------------------------------+

这个参差不齐的结构内部的正方形实际上也不是正方形,它们也会参差不齐。等效地,您可以将其fwd视为对角线。或者干脆完全放下二维结构的拉链。

根据我的经验,拉链与树状物品搭配时效果最好。如果 Haskell 专家能够想出一种使用拉链的方法以及它们附带的所有更新/访问优点,例如循环图甚至是普通的旧 DAG,我不会感到惊讶,但我想不出任何从我微薄的头顶上掉下来:)。

故事的寓意如此,拉链对于二维结构来说相当令人头疼。(空闲的想法:也许镜头可能很有趣?)

出于好奇,我下面的方法也只有在您牢记我们正在处理的结构的粗糙性时才有效;这是fwding 两次,然后提取将在他的网格的右下角为您提供相当于 OP 想要的东西,而不是在左下角。

原文

因此,您需要某种方式在纯 zipper-basedduplicate和您Traversable的 -based 副本之间切换。最简单的方法是使用您duplicate已经编写的函数,然后traverse在中间添加一个。

duplicateT :: Traversable t => t (LZipper a) -> LZipper (t (LZipper a))
duplicateT z = LZipper (Backwards $ unfoldr (step bwd) z) z (unfoldr (step fwd) z)
    -- Everything's the exact same except for that extra traverse
    where step move = fmap (\y -> (y, y)) . (traverse move)

现在我们有了更通用的duplicateT方法,我们可以通过duplicate在您的Comonad实例中重新定义为:

-- requires import Data.Functor.Identity
duplicate = fmap runIdentity (duplicate' (Identity z))

然后以下内容将为您提供您想要的

duplicateGrid = duplicate . duplicateT

或者如果你想切换列和行的顺序,你可以做相反的事情。

注意:如果 Haskell 允许您在类型类上本地定义类型约束,这样您就可以拥有不同的 Comonad 实例(可能都以newtypes 为中介)来LZipper改变duplicate. 问题是你会想要一些你根本无法用 Haskell 编写的instance Comonad LZipper (LZipper a) where ...东西。newtype你可以想象对类型族做这样事情,但我怀疑这对于这个特定的实例来说可能是矫枉过正的。

编辑:事实上,duplicateT如果您ApplicativeLZipper.

instance Applicative LZipper where
    pure x = LZipper (Backwards (repeat x)) x (repeat x)
    (LZipper leftF f rightF) <*> (LZipper left x right) = LZipper newLeft (f x) newRight
      where
        newLeft = (Backwards (zipWith ($) (forwards leftF) (forwards left)))
        newRight = (zipWith ($) rightF right)

现在只需将duplicate您之前拥有的原件拿走并使用traverse.

duplicateGrid = duplicate . (traverse duplicate)
于 2016-03-06T20:34:47.177 回答
5

所以有一个密切相关的comonad可以帮助指导你。我们有:

newtype MC m a = MC { unMC :: m -> a }

instance Monoid m => Comonad (MC m) where
    extract (MC f) = f mempty
    duplicate (MC f) = MC (\x -> MC (\y -> f (x <> y)))

instance Functor (MC m) where
    fmap f (MC g) = MC (f . g) 

所以一个双向无限数组是MC (Sum Integer) a,一个双向无限网格是MC (Sum Integer, Sum Integer) a。当然,与通过柯里化MC m (MC n a)同构。MC (m,n) a

无论如何,您想要的重复网格函数将类似于(忽略新类型包装器和柯里化):

duplicateGrid g x y dx dy = g (x + dx) (y + dy)

duplicate一维数组看起来像:

duplicate f x y = f (x+y)

也是这样duplicate . duplicate

(duplicate . duplicate) f x y z 
    = duplicate (duplicate f) x y z
    = duplicate f (x+y) z
    = f (x + y + z)

不是想要的。fmap duplicate看起来像什么:

fmap duplicate f x y z = f x (y + z)

很明显,duplicate再次这样做会给我们带来同样的事情duplicate . duplicate(因为这是一个comonad法则,所以应该这样做)。然而,这更有希望。如果我们做 fmap...

fmap (fmap duplicate) f x y z w
    = fmap duplicate (f x) y z w
    = f x y (z + w)

现在,如果我们这样做,duplicate我们会得到

(duplicate . fmap (fmap duplicate)) f x y z w = f (x+y) (z+w)

但这仍然是错误的。更改变量名称,其f (x+y) (dx + dy). 所以我们需要一些东西来交换两个内部变量......我们想要的范畴论名称是一个分配律。Haskell 的名称是Traversable. sequenceA函数(函数形成Applicative函子,实际上是 a Monad,单子)是什么Reader样子的?类型说明了一切。

sequenceA :: (a -> b -> c) -> (b -> a -> c)
sequenceA f x y = f y x 

所以最后:

fmap sequenceA g x y z = g x z y

(duplicate . fmap (fmap duplicate) . fmap sequenceA) g x y dx dy
    = (duplicate . fmap (fmap duplicate)) g x dx y dy
    = g (x + dx) (y + dy)

我实际上没有尝试过类似的代码,所以我不知道它是否有效,但数学表明它应该。

于 2016-03-06T17:39:07.470 回答