{-# 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 * |
| +-------+ +-------+ ********* |
+-------------------------------+
对于那些知情人士来说,这感觉就像是一个简单的问题,但它让我头晕目眩。我想我可以手动调用一个调用up
,down
,left
和right
的函数,但我觉得这个comonadic机器应该能够做到我。 duplicateGrid
的正确实施是什么?
答案 0 :(得分:9)
这里有一个问题,我们正在尝试用自己编写Grid
,因为这种设置为我们提供了太多错误的方法来实现具有正确类型的duplicate
。考虑组成的comonads不一定相同的一般情况是有用的。
假设我们有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 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
大小的向量,则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
机制来定义Traversable
和left
。这也意味着right
和left
不具备与right
和up
相同的性能属性,因为您可以说“反对谷歌”。 / p>
由于您的down
实例仅使用您的拉链功能定义,因此它只能在您的拉链定义的方向Comonad
,duplicate
和fwd
(并通过扩展名bwd
和up
)。
编辑:经过多次考虑之后,我认为您的方法将从根本上成为问题。我保留了下面的原始文字,但是有一个更明显的问题。
如果您试图穿过拉链,好像它们就像任何其他二维结构一样,那么您将继续使用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
会过早地失败了。这意味着,如果您确实想要使用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
来获得与{{1}相同的内容}和bwd
。当然这意味着放弃了“正确然后向下”和“向下然后向右”的能力,但正如我们已经看到的那样,拉链不能很好地发挥多种路径。
现在让我们仔细检查一下你如何最好地解释left
发生的事情的直觉。一个漂亮的广场并不是思考正在发生的事情的最佳方式(如果你只限于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...
视为对角线。或者只是完全放下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名称为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)
我实际上没有尝试过类似的代码,所以我不知道它是否有效,但是数学说它应该。