为n维网格types编写联合或cobind

使用types级自然的典型定义，我定义了一个n维网格。

{-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} data Nat = Z | S Nat data U (n :: Nat) x where Point :: x -> UZ x Dimension :: [U nx] -> U nx -> [U nx] -> U (S n) x dmap :: (U nx -> U mr) -> U (S n) x -> U (S m) r dmap f (Dimension ls mid rs) = Dimension (map f ls) (f mid) (map f rs) instance Functor (U n) where fmap f (Point x) = Point (fx) fmap fd@Dimension{} = dmap (fmap f) d 

现在我想让它成为Comonad的一个实例，但是我不能完全围绕它。

 class Functor w => Comonad w where (=>>) :: wa -> (wa -> b) -> wb coreturn :: wa -> a cojoin :: wa -> w (wa) x =>> f = fmap f (cojoin x) cojoin xx = xx =>> id instance Comonad (U n) where coreturn (Point x) = x coreturn (Dimension _ mid _) = coreturn mid -- cojoin :: UZ x -> UZ (UZ x) cojoin (Point x) = Point (Point x) -- cojoin ::U (S n) x -> U (S n) (U (S n) x) cojoin d@Dimension{} = undefined -- =>> :: UZ x -> (UZ x -> r) -> UZ r p@Point{} =>> f = Point (fp) -- =>> :: U (S n) x -> (U (S n) x -> r) -> U (S n) r d@Dimension{} =>> f = undefined 

在n维网格上使用cojoin将产生n维网格的n维网格。 我想提供一个与这个实例相同的实例，它是在（x，y，z）上的联合网格的值应该是关注 （x，y，z）的原始网格。 为了适应这个代码，看来我们需要为了执行n “fmaps”和n “滚动”而进行n 。 你不必这样做，但如果有帮助，那么你去。

Answer 1

Jagger / Richards：你不能总是得到你想要的东西，但是如果你尝试某个时候，你可能会发现你得到了你所需要的东西。

游标在列表中

让我使用snoc和cons列表重build您的结构的组件，以保持空间属性清晰。 我定义

 data Bwd x = B0 | Bwd x :< x deriving (Functor, Foldable, Traversable, Show) data Fwd x = F0 | x :> Fwd x deriving (Functor, Foldable, Traversable, Show) infixl 5 :< infixr 5 :> data Cursor x = Cur (Bwd x) x (Fwd x) deriving (Functor, Foldable, Traversable, Show) 

让我们有连接器

 class Functor f => Comonad f where counit :: fx -> x cojoin :: fx -> f (fx) 

让我们确保游标是连接器

 instance Comonad Cursor where counit (Cur _ x _) = x cojoin c = Cur (lefts c) c (rights c) where lefts (Cur B0 _ _) = B0 lefts (Cur (xz :< x) y ys) = lefts c :< c where c = Cur xz x (y :> ys) rights (Cur _ _ F0) = F0 rights (Cur xz x (y :> ys)) = c :> rights c where c = Cur (xz :< x) y ys 

如果你打开这样的东西，你会注意到Cursor是一个InContext []空间愉悦的变体

 InContext fx = (x, ∂fx) 

其中∂取函数的forms导数，给出它的单孔上下文的概念。 InContext f总是一个Comonad ，正如在这个答案中提到的那样，我们这里所说的就是Comonad由差分结构引发，在这个结构中，提取元素在焦点上，并且cojoin使用它自己的上下文cojoin装饰每个元素，有效地给你一个上下文充满了重新聚焦的游标，并在其焦点上有一个无动于衷的游标。 举个例子吧。

 > cojoin (Cur (B0 :< 1) 2 (3 :> 4 :> F0)) Cur (B0 :< Cur B0 1 (2 :> 3 :> 4 :> F0)) (Cur (B0 :< 1) 2 (3 :> 4 :> F0)) ( Cur (B0 :< 1 :< 2) 3 (4 :> F0) :> Cur (B0 :< 1 :< 2 :< 3) 4 F0 :> F0) 

看到？ 2焦点已被装饰成为2的游标; 在左边，我们有光标在列表1; 在右边，光标在3和光标在4的列表。

编写游标，移调游标？

现在，你要求成为Comonad的结构是Cursor的n-fold构成。 让我们

 newtype (:.:) fgx = C {unC :: f (gx)} deriving Show 

为了说服弗朗西斯和弗朗西斯科夫构成，这个counit整齐，但是你需要一个“分配法”

 transpose :: f (gx) -> g (fx) 

所以你可以像这样做复合材料

 f (gx) -(fmap cojoin)-> f (g (gx)) -cojoin-> f (f (g (gx))) -(fmap transpose)-> f (g (f (gx))) 

什么法律应该transpose满足？ 可能是类似的东西

 counit . transpose = fmap counit cojoin . transpose = fmap transpose . transpose . fmap cojoin 

或者无论如何确保任何两种方法从一个命令到另一个命令都能得到相同的结果。

我们可以为自己定义Cursor的transpose吗？ 一种便宜的换位方法是注意Bwd和Fwd是非常适用的，因此Cursor也是如此。

 instance Applicative Bwd where pure x = pure x :< x (fz :< f) <*> (sz :< s) = (fz <*> sz) :< fs _ <*> _ = B0 instance Applicative Fwd where pure x = x :> pure x (f :> fs) <*> (s :> ss) = fs :> (fs <*> ss) _ <*> _ = F0 instance Applicative Cursor where pure x = Cur (pure x) x (pure x) Cur fz f fs <*> Cur sz s ss = Cur (fz <*> sz) (fs) (fs <*> ss) 

在这里，你应该开始闻到老鼠。 形状不匹配导致截断 ，这将打破显然理想的性质，自我转置是自反性的。 任何一种破烂都无法生存。 我们确实得到了一个换位运算符： sequenceA ，而对于完全规则的数据，都是明亮美丽的。

 > regularMatrixCursor Cur (B0 :< Cur (B0 :< 1) 2 (3 :> F0)) (Cur (B0 :< 4) 5 (6 :> F0)) (Cur (B0 :< 7) 8 (9 :> F0) :> F0) > sequenceA regularMatrixCursor Cur (B0 :< Cur (B0 :< 1) 4 (7 :> F0)) (Cur (B0 :< 2) 5 (8 :> F0)) (Cur (B0 :< 3) 6 (9 :> F0) :> F0) 

但是，即使我只是移动内部光标的一个不alignment（不要介意尺寸不齐），事情就会出错。

 > raggedyMatrixCursor Cur (B0 :< Cur ((B0 :< 1) :< 2) 3 F0) (Cur (B0 :< 4) 5 (6 :> F0)) (Cur (B0 :< 7) 8 (9 :> F0) :> F0) > sequenceA raggedyMatrixCursor Cur (B0 :< Cur (B0 :< 2) 4 (7 :> F0)) (Cur (B0 :< 3) 5 (8 :> F0)) F0 

当你有一个外部光标位置和多个内部光标位置时，就不会有performance良好的转换。 自我组成的Cursor允许内部结构相互之间破碎，所以没有transpose ，没有cojoin 。 你可以，而且我确定了

 instance (Comonad f, Traversable f, Comonad g, Applicative g) => Comonad (f :.: g) where counit = counit . counit . unC cojoin = C . fmap (fmap C . sequenceA) . cojoin . fmap cojoin . unC 

但是确保我们保持内部结构的规则是我们的责任。 如果你愿意接受这个负担，那么你可以迭代，因为Applicative和Traversable在组合下很容易closures。 这是零碎的东西

 instance (Functor f, Functor g) => Functor (f :.: g) where fmap h (C fgx) = C (fmap (fmap h) fgx) instance (Applicative f, Applicative g) => Applicative (f :.: g) where pure = C . pure . pure C f <*> C s = C (pure (<*>) <*> f <*> s) instance (Functor f, Foldable f, Foldable g) => Foldable (f :.: g) where fold = fold . fmap fold . unC instance (Traversable f, Traversable g) => Traversable (f :.: g) where traverse h (C fgx) = C <$> traverse (traverse h) fgx 

编辑：为了完整性，这是当所有的规则，

 > cojoin (C regularMatrixCursor) C {unC = Cur (B0 :< Cur (B0 :< C {unC = Cur B0 (Cur B0 1 (2 :> (3 :> F0))) (Cur B0 4 (5 :> (6 :> F0)) :> (Cur B0 7 (8 :> (9 :> F0)) :> F0))}) (C {unC = Cur B0 (Cur (B0 :< 1) 2 (3 :> F0)) (Cur (B0 :< 4) 5 (6 :> F0) :> (Cur (B0 :< 7) 8 (9 :> F0) :> F0))}) (C {unC = Cur B0 (Cur ((B0 :< 1) :< 2) 3 F0) (Cur ((B0 :< 4) :< 5) 6 F0 :> (Cur ((B0 :< 7) :< 8) 9 F0 :> F0))} :> F0)) (Cur (B0 :< C {unC = Cur (B0 :< Cur B0 1 (2 :> (3 :> F0))) (Cur B0 4 (5 :> (6 :> F0))) (Cur B0 7 (8 :> (9 :> F0)) :> F0)}) (C {unC = Cur (B0 :< Cur (B0 :< 1) 2 (3 :> F0)) (Cur (B0 :< 4) 5 (6 :> F0)) (Cur (B0 :< 7) 8 (9 :> F0) :> F0)}) (C {unC = Cur (B0 :< Cur ((B0 :< 1) :< 2) 3 F0) (Cur ((B0 :< 4) :< 5) 6 F0) (Cur ((B0 :< 7) :< 8) 9 F0 :> F0)} :> F0)) (Cur (B0 :< C {unC = Cur ((B0 :< Cur B0 1 (2 :> (3 :> F0))) :< Cur B0 4 (5 :> (6 :> F0))) (Cur B0 7 (8 :> (9 :> F0))) F0}) (C {unC = Cur ((B0 :< Cur (B0 :< 1) 2 (3 :> F0)) :< Cur (B0 :< 4) 5 (6 :> F0)) (Cur (B0 :< 7) 8 (9 :> F0)) F0}) (C {unC = Cur ((B0 :< Cur ((B0 :< 1) :< 2) 3 F0) :< Cur ((B0 :< 4) :< 5) 6 F0) (Cur ((B0 :< 7) :< 8) 9 F0) F0} :> F0) :> F0)} 

汉考克的张量产品

为了规律，你需要比构图更强的东西。 你需要能够捕捉到“g-结构的f-结构 – 所有相同的形状”的概念。 这就是不可估量的彼得·汉考克（Peter Hancock）所称的“张量积”，我将写成f :><: g ：所有内部g结构都有一个“外”f形和一个“内”g形，所以换位是容易定义的，总是自反的。 汉考克的张量在Haskell中是不方便定义的，但是在一个依赖types的情况下，很容易形成具有这个张量的“容器”的概念。

给你的想法，考虑一个容器的退化概念

 data (:<|) spx = s :<| (p -> x) 

我们说s是“形状”的types， p是“职位”的types。 一个值由一个形状的select和每个位置的x的存储组成。 在从属情况下，位置的types可能取决于形状的select（例如，对于列表，形状是一个数字（长度），并且有多个位置）。 这些容器有张量产品

 (s :<| p) :><: (s' :<| p') = (s, s') :<| (p, p') 

这就像一个广义matrix：一对形状给出尺寸，然后你在每对位置都有一个元素。 当p和p'取决于s和s'值时，你可以很好地完成这个工作，这正是汉考克对容器张量积的定义。

用于张量产品的InContext

现在，正如你在高中所学到的那样， ∂(s :<| p) = (s, p) :<| (p-1) ∂(s :<| p) = (s, p) :<| (p-1)其中p-1是比pless一个元素的types。 像∂（s x ^ p）=（s p）* x ^（p-1）。 您select一个位置（logging在形状中）并删除它。 这个障碍是， p-1很难在没有依赖types的情况下得到你的手。 但InContextselect一个位置而不删除它 。

 InContext (s :<| p) ~= (s, p) :<| p 

这对于依赖的情况也是一样，我们欢乐地获得

 InContext (f :><: g) ~= InContext f :><: InContext g 

现在我们知道InContext f总是一个Comonad ，这告诉我们InContext的张量产品是共性的，因为它们本身就是InContext 。 也就是说，你在每个维度上select一个位置（并且在整个事物中恰好给你一个位置），在这之前我们有一个外部位置和许多内部位置。 用张量产品替代成分，一切都很好。

Naperan Functors

但是有一个Functor的子类，其张量积和成分一致。 这些是f () ~ ()的Functor ：即无论如何只有一个形状，所以首先排除组合中的粗糙值。 这些Functor都同构于(p ->)某个位置集合p ，我们可以把它看作对数 （ x必须被提升给fx的指数）。 相应地，汉考克（Hancock）在约翰·纳皮尔（约翰·纳皮尔的鬼魂出没于汉考克所住的爱丁堡的一部分）之后称这些“

 class Applicative f => Naperian f where type Log f project :: fx -> Log f -> x positions :: f (Log f) --- project positions = id 

一个Naperian函数有一个对数，导致一个project离子函数映射位置到那里find的元素。 Naperian函数都是可Applicative ， pure和<*>对应于投影的K和S组合子。 也可以构build一个值，在每个位置存储该位置的表示。 您可能记得的对数律令人满意地popup。

 newtype Id x = Id {unId :: x} deriving Show instance Naperian Id where type Log Id = () project (Id x) () = x positions = Id () newtype (:*:) fgx = Pr (fx, gx) deriving Show instance (Naperian f, Naperian g) => Naperian (f :*: g) where type Log (f :*: g) = Either (Log f) (Log g) project (Pr (fx, gx)) (Left p) = project fx p project (Pr (fx, gx)) (Right p) = project gx p positions = Pr (fmap Left positions, fmap Right positions) 

请注意，固定大小的数组（ 向量 ）由(Id :*: Id :*: ... :*: Id :*: One) ，其中One是恒定单位函子，其对数为Void 。 所以一个arrays是Naperian 。 现在，我们也有

 instance (Naperian f, Naperian g) => Naperian (f :.: g) where type Log (f :.: g) = (Log f, Log g) project (C fgx) (p, q) = project (project fgx p) q positions = C $ fmap (\ p -> fmap (p ,) positions) positions 

这意味着multidimensional array是Naperian 。

要为Naperian f构造一个InContext f的版本，只需指向一个位置！

 data Focused fx = fx :@ Log f instance Functor f => Functor (Focused f) where fmap h (fx :@ p) = fmap h fx :@ p instance Naperian f => Comonad (Focused f) where counit (fx :@ p) = project fx p cojoin (fx :@ p) = fmap (fx :@) positions :@ p 

所以，特别是一个Focused n维数组确实是一个共同的。 vector的组成是n个vector的张量积，因为vector是Naperian 。 但是Focused n维arrays将是确定其尺寸的n个Focusedvector的n倍张量积， 而不是组成 。 为了用拉链来expression这个组合，我们需要用一种能够构造张量产品的forms来expression它们。 我将把它作为未来的练习。

Answer 2

还有一个尝试，灵感来自猪工岗位和http://hackage.haskell.org/packages/archive/representable-functors/3.0.0.1/doc/html/Data-Functor-Representable.html 。

如果key（或log）是monoid，那么可表示的（或者Naperian）函数本身就是一个comonad！ 然后coreturn获取位置mempty的值。 和cojoin mappend它是可用的两个键。 （就像(p ->)的comonad实例一样(p ->) 。

 {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} import Data.List (genericIndex) import Data.Monoid import Data.Key import Data.Functor.Representable data Nat = Z | S Nat data U (n :: Nat) x where Point :: x -> UZ x Dimension :: [U nx] -> U nx -> [U nx] -> U (S n) x dmap :: (U nx -> U mr) -> U (S n) x -> U (S m) r dmap f (Dimension ls mid rs) = Dimension (map f ls) (f mid) (map f rs) instance Functor (U n) where fmap f (Point x) = Point (fx) fmap fd@Dimension{} = dmap (fmap f) d class Functor w => Comonad w where (=>>) :: wa -> (wa -> b) -> wb coreturn :: wa -> a cojoin :: wa -> w (wa) x =>> f = fmap f (cojoin x) cojoin xx = xx =>> id 

如果列表无限长， U是可表示的。 那么只有一个形状。 U n的关键是U n个整数的向量。

 type instance Key (U n) = UKey n data UKey (n :: Nat) where P :: UKey Z D :: Integer -> UKey n -> UKey (S n) instance Lookup (U n) where lookup = lookupDefault instance Indexable (U n) where index (Point x) P = x index (Dimension ls mid rs) (D ik) | i < 0 = index (ls `genericIndex` (-i - 1)) k | i > 0 = index (rs `genericIndex` ( i - 1)) k | otherwise = index mid k 

我们需要在两种情况下分割可Representable实例，一个用于Z ，一个用于S ，因为我们没有typesU n的值来模式匹配。

 instance Representable (UZ) where tabulate f = Point (f P) instance Representable (U n) => Representable (U (S n)) where tabulate f = Dimension (map (\i -> tabulate (f . D (-i))) [1..]) (tabulate (f . D 0)) (map (\i -> tabulate (f . D i)) [1..]) instance Monoid (UKey Z) where mempty = P mappend PP = P instance Monoid (UKey n) => Monoid (UKey (S n)) where mempty = D 0 mempty mappend (D il kl) (D ir kr) = D (il + ir) (mappend kl kr) 

而U n的关键确实是一个monoid，所以我们可以使用来自可表示仿函数包的默认实现来将U n变成一个共有的。

 instance (Monoid (UKey n), Representable (U n)) => Comonad (U n) where coreturn = extractRep cojoin = duplicateRep (=>>) = flip extendRep 

这次我做了一些testing。

 testVal :: U (S (SZ)) Int testVal = Dimension (repeat (Dimension (repeat (Point 1)) (Point 2) (repeat (Point 3)))) (Dimension (repeat (Point 4)) (Point 5) (repeat (Point 6))) (repeat (Dimension (repeat (Point 7)) (Point 8) (repeat (Point 9)))) -- Hacky Eq instance, just for testing instance Eq x => Eq (U nx) where Point a == Point b = a == b Dimension la a ra == Dimension lb b rb = take 3 la == take 3 lb && a == b && take 3 ra == take 3 rb instance Show x => Show (U nx) where show (Point x) = "(Point " ++ show x ++ ")" show (Dimension lar) = "(Dimension " ++ show (take 2 l) ++ " " ++ show a ++ " " ++ show (take 2 r) ++ ")" test = coreturn (cojoin testVal) == testVal && fmap coreturn (cojoin testVal) == testVal && cojoin (cojoin testVal) == fmap cojoin (cojoin testVal) 

Answer 3

所以这个结果是错误的。 我会把它留在这里，以防有人想要修复它。

这个实现是@pigworkerbuild议我的想法。 它编译，但我没有testing它。 （我从http://blog.sigfpe.com/2006/12/evaluating-cellular-automata-is.html获得了;cojoin1实施）

 {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} data Nat = Z | S Nat data U (n :: Nat) x where Point :: x -> UZ x Dimension :: [U nx] -> U nx -> [U nx] -> U (S n) x unPoint :: UZ x -> x unPoint (Point x) = x dmap :: (U nx -> U mr) -> U (S n) x -> U (S m) r dmap f (Dimension ls mid rs) = Dimension (map f ls) (f mid) (map f rs) right, left :: U (S n) x -> U (S n) x right (Dimension ab (c:cs)) = Dimension (b:a) c cs left (Dimension (a:as) bc) = Dimension as a (b:c) instance Functor (U n) where fmap f (Point x) = Point (fx) fmap fd@Dimension{} = dmap (fmap f) d class Functor w => Comonad w where (=>>) :: wa -> (wa -> b) -> wb coreturn :: wa -> a cojoin :: wa -> w (wa) x =>> f = fmap f (cojoin x) cojoin xx = xx =>> id instance Comonad (U n) where coreturn (Point x) = x coreturn (Dimension _ mid _) = coreturn mid cojoin (Point x) = Point (Point x) cojoin d@Dimension{} = fmap unlayer . unlayer . fmap dist . cojoin1 . fmap cojoin . layer $ d dist :: U (SZ) (U nx) -> U n (U (SZ) x) dist = layerUnder . unlayer layerUnder :: U (S n) x -> U n (U (SZ) x) layerUnder d@(Dimension _ Point{} _) = Point d layerUnder d@(Dimension _ Dimension{} _) = dmap layerUnder d unlayer :: U (SZ) (U nx) -> U (S n) x unlayer = dmap unPoint layer :: U (S n) x -> U (SZ) (U nx) layer = dmap Point cojoin1 :: U (SZ) x -> U (SZ) (U (SZ) x) cojoin1 a = layer $ Dimension (tail $ iterate left a) a (tail $ iterate right a)