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

时间:2016-03-06 13:29:17

标签: haskell zipper comonad

{-# 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输出,这给了我一些包含错误网格并使行的焦点不对齐的东西,这样向下移动也会让你感动: / p>

(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 * |
| +-------+ +-------+ ********* |
+-------------------------------+

对于那些知情人士来说,这感觉就像是一个简单的问题,但它让我头晕目眩。我想我可以手动调用一个调用updownleftright的函数,但我觉得这个comonadic机器应该能够做到我。 duplicateGrid的正确实施是什么?

3 个答案:

答案 0 :(得分:9)

这里有一个问题,我们正在尝试用自己编写Grid,因为这种设置为我们提供了太多错误的方法来实现具有正确类型的duplicate。考虑组成的comonads不一定相同的一般情况是有用的。

假设我们有fg个comonads。 duplicate的类型变为:

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

我们可以仅使用Comonad个实例来获取以下内容:

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

由此可见,我们需要在中间交换fg

有一个名为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 an大小的向量,则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,只要我们知道上下文的长度:

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))

最后,我们可以按照之前看到的方式复制Grid,但首先我们必须确定内部Zipper的形状。由于我们假设所有内部Zipper具有相同的形状,我们只关注焦点中的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的情况。

但是,我对上述实现非常有信心,因为这些定义受到类型的严格限制。

答案 1 :(得分:7)

您遇到的根本问题是zippers don't natively support 2-d structures。答案很棒(另一个答案基本上就是你对Grid的定义)我会鼓励你阅读它,但要点是拉链识别带有路径的元素到达二维空间这样的识别是有问题的,因为有很多途径可以达到目的。

因此,您会注意到,虽然up的{​​{1}}和down函数完全是根据Zippers定义的,但您需要使用Grid机制来定义Traversableleft。这也意味着rightleft不具备与rightup相同的性能属性,因为您可以说“反对谷歌”。 / p>

由于您的down实例仅使用您的拉链功能定义,因此它只能在您的拉链定义的方向Comonadduplicatefwd(并通过扩展名bwdup)。

编辑:经过多次考虑之后,我认为您的方法将从根本上成为问题。我保留了下面的原始文字,但是有一个更明显的问题。

如果您试图穿过拉链,好像它们就像任何其他二维结构一样,那么您将继续使用down获取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 right要求(正如您在提到不变量时正确注意到的那样)您的每个子拉链的结构都是同质的,否则left会过早地失败了。这意味着,如果您确实想要使用traverseleft,那么与right一起使用的唯一方法就是使用尽可能最均匀的duplicate

duplicate

另一种方法是仅使用拉链附带的功能。这意味着仅使用duplicate z @ (LZipper left focus right) = LZipper (fmap (const z) left) z (fmap (const z) right) fwd,然后bwd重点并继续使用extractfwd来获得与{{1}相同的内容}和bwd。当然这意味着放弃了“正确然后向下”和“向下然后向右”的能力,但正如我们已经看到的那样,拉链不能很好地发挥多种路径。

现在让我们仔细检查一下你如何最好地解释left发生的事情的直觉。一个漂亮的广场并不是思考正在发生的事情的最佳方式(如果你只限于rightduplicate . 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... 视为对角线。或者只是完全放下2-d结构的拉链。

根据我的经验,拉链在与树状物配对时确实效果最佳。如果Haskell专家想出一种使用拉链和所有更新的方法,我不会感到惊讶为循环图或甚至普通的旧DAG之类的东西访问它们带来的好处,但我想不出任何偏离我微弱的头部的东西:)。

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

对于好奇的人,我的方法也只有在你记住我们所处理的结构的粗糙时才有效;那是+---------------------------------------------------+ | ********* +-------+ +-------+ | | * 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 | | | +-------+ +-------+ +-------+ | +---------------------------------------------------+ 两次,然后提取将获得相当于OP想要在他的网格的右下角,而不是在左下角。

<强>原始

因此,您需要的是在基于纯拉链的fwd和基于fwd的副本之间切换的方法。最简单的方法是使用您已编写的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来解决一些讨厌的代码重复:

duplicate

然后以下内容可以获得您想要的内容

Comonad

或者,如果要切换列和行的顺序,则可以执行相反的操作。

注意:如果Haskell允许您在类型类上本地定义类型约束,那么您可以使用不同的Comonad实例(可能都使用-- requires import Data.Functor.Identity duplicate = fmap runIdentity (duplicate' (Identity z)) 调解),以便更改duplicateGrid = duplicate . duplicateT newtype的方向。问题是你需要像LZipper或等价duplicate这样的东西,你根本无法在Haskell中编写。你可以想象做类似于this的类型系列,但我怀疑这对于这个特定的实例来说可能有些过分。

修改:实际上,如果您为instance Comonad LZipper (LZipper a) where ...提供适当的newtype实例,则甚至不需要duplicateT

Applicative

现在,只需使用之前的原始LZipper并使用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

答案 2 :(得分: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)通过currying与MC (m,n) a同构。

无论如何,你想要的重复网格函数是类似的(忽略newtype包装和currying):

duplicateGrid g x y dx dy = g (x + dx) (y + dy)
1D数组的

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 s ...

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名称为TraversablesequenceA对于函数(函数形成Applicative仿函数,实际上是MonadReader 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)

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