共同寻找所有专注于网格的方法

Question

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

首先是一些上下文（哈哈）。我有一个 zipper 非空列表。

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 的 duplicate 网格的等价物：一个函数，它接受一个网格并生成一个包含您可以查看网格的所有方式的网格，其中专注于当前你看待它的方式。

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、left 和 right 的函数，但我觉得 comonadic 机器应该能够做到这一点我。 duplicateGrid 的正确实现是什么？

Answer 1

所以有一个密切相关的 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 相同的结果（它应该是共同法则）。然而，这更有希望。如果我们做了两次 fmaps ...

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 仿函数，实际上是一个 Monad，Reader monad）是什么样的？类型说明一切。

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)

我还没有真正尝试过类似的代码，所以我不知道它是否有效，但数学表明它应该有效。

Answer 2

这里有点问题，我们试图将 Grid 与自身组合，因为此设置为我们提供了太多不正确的方法来实现具有正确类型的 duplicate。考虑组成的单子不一定相同的一般情况很有用。

假设我们有 f 和 g comonads。 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 具有我们想要的方法。

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

特别是，我们需要实现Distributive g，然后duplicate对于composed comonad可以实现为：

duplicate = fmap distribute . duplicate . fmap duplicate

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

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

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

下面我将根据基础列表的不当分布为 Grid 实施 duplicate。

或者，卷起袖子直接在Zipper (Zipper a)上实现一个转置函数。我确实这样做了，但这让我很头疼，而且我远不能确定它是正确的。最好使类型尽可能通用，以缩小 space 可能实现的范围，从而减少出错的空间。

我将省略 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 列表可以是无限的，我们应该用可能无限的惰性自然数来测量长度。测量长度的另一种解决方案是使用 "guide" 列表，我们可以沿着它压缩其他列表。但是，我不想在分布函数中假设这样一个虚拟列表总是可用的。

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，前提是我们知道上下文的长度：

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的形状相同，所以我们只看焦点中的Zipper：

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

对此进行测试（您一定已经体验过）非常糟糕，而且我还没有抽出时间亲自检查一个两两的案例。

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

Answer 3

您运行遇到的根本问题是 zippers don't natively support 2-d structures。那里的答案很好（另一个答案基本上就是你对 Grid 的定义），我鼓励你阅读它，但要点是拉链识别具有到达那里的路径和二维 space这样的识别是有问题的，因为有很多路径可以到达一个点。

因此您会注意到，虽然 Grid 的 up 和 down 函数是完全根据 Zippers 定义的，但您需要使用 Traversable 机器定义 left 和 right。这也意味着 left 和 right 不享有与 up 和 down 相同的性能属性，因为可以这么说 "going against the grain"。

由于您的 Comonad 实例仅使用您的拉链函数定义，它只能 duplicate 在您的拉链定义的方向上，即 fwd 和 bwd（以及扩展 up 和 down）。

编辑：经过深思熟虑，我认为您的方法从根本上来说是有问题的。我保留了下面的原文，但还有一个更明显的问题。

如果您尝试像遍历任何其他二维结构一样遍历拉链，您的 duplicate 将继续得到 Nothing。让我们注意如果您实际尝试在表面上没有问题的 duplicate (mkZipper 'a' "bc").

上使用 up, down, left, right 函数会发生什么

*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

移动 right 和 left 需要（正如您在提到不变量时适当注意的那样）您的每个子拉链在结构上都是同质的，否则 traverse 会过早失败。这意味着，如果您真的想使用 left 和 right，那么与 duplicate 配合使用的唯一方法是尽可能使用最统一的 duplicate。

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

另一种方法是只使用拉链自带的功能。这意味着仅使用 fwd 和 bwd，然后 extract 聚焦并继续使用 fwd 和 bwd 来获得与 [=24] 相同的结果=] 和 right。当然，这意味着放弃同时说 "right then down" 和 "down then right," 的能力，但正如我们已经看到的，拉链不能很好地处理多个路径。

现在让我们再次检查您的直觉，了解如何最好地解释 duplicate . duplicate $ myGrid 发生的事情。一个漂亮的正方形并不是思考正在发生的事情的最佳方式（如果你将自己限制在 extract 和 fwd 和 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 在他的网格右下角而不是左下角想要的东西。

原:

因此，您需要某种方法来在纯基于拉链的 duplicate 和基于 Traversable 的副本之间切换。最简单的方法是使用您已经编写的 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，我们可以通过将 Comonad 实例中的 duplicate 重新定义为：

来摆脱一些讨厌的代码重复

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

那么下面的内容就能满足你的需求

duplicateGrid = duplicate . duplicateT

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

注意：如果 Haskell 让你在类型类上本地定义类型约束，这样你就可以为你的 LZipper 改变你的方向 duplicate。问题是你会想要类似 instance Comonad LZipper (LZipper a) where ... 或等价的 newtype 的东西，而你根本无法在 Haskell 中写入。您可以想象对类型族执行 this 之类的操作，但我怀疑对于这个特定实例，这可能有点过头了。

编辑：事实上，如果您为LZipper提供适当的Applicative实例，您甚至不需要duplicateT。

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)

共同寻找所有专注于网格的方法

Comonadically finding all the ways to focus on a grid

haskell

zipper

comonad