Question

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

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}

data Nat = Z | S Nat

data U (n :: Nat) x where
  Point :: x -> U Z x
  Dimension :: [U n x] -> U n x -> [U n x] -> U (S n) x

dmap :: (U n x -> U m r) -> 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 (f x)
  fmap f d@Dimension{} = dmap (fmap f) d

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

class Functor w => Comonad w where
  (=>>)    :: w a -> (w a -> b) -> w b
  coreturn :: w a -> a
  cojoin   :: w a -> w (w a)

  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 :: U Z x -> U Z (U Z x)
  cojoin (Point x) = Point (Point x)
  -- cojoin ::U (S n) x -> U (S n) (U (S n) x)
  cojoin d@Dimension{} = undefined

  -- =>> :: U Z x -> (U Z x -> r) -> U Z r
  p@Point{} =>> f = Point (f p)
  -- =>> :: U (S n) x -> (U (S n) x -> r) -> U (S n) r
  d@Dimension{} =>> f = undefined

在n维网格上使用cojoin将生成n维网格的n维网格。我想提供一个与this one具有相同想法的实例，即（x，y，z） cojoined 网格的值应该是（x，y，z）上的原始网格聚焦。为了调整该代码，我们似乎需要知道n才能执行n“fmaps”和n“roll”。你不必这样做，但如果这有帮助，那你去吧。

Answer 1

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

列表中的游标

让我使用snoc-和cons-lists重建结构的组件，以保持空间属性的清晰。我定义了

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)

让我们有comonads

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

让我们确保游标是comonads

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 f x = (x, ∂f x)

其中∂采用仿函数的形式导数，给出了单孔上下文的概念。如this answer中所述，InContext f始终为Comonad，我们在此处所拥有的只是Comonad由差异结构引起的，其中counit提取焦点上的元素和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倍组合。我们有

newtype (:.:) f g x = C {unC :: f (g x)} deriving Show

为了说服comonads f和g撰写，counit的作文整齐，但你需要一个＆＃34;分配法＆＃34;

transpose :: f (g x) -> g (f x)

所以你可以像这样制作复合cojoin

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

transpose应满足哪些法律？可能类似

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

或任何确保从一个订单到另一个订单的某些序列的f和＃g的任何两种方式都可以得到相同的结果。

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

instance Applicative Bwd where
  pure x = pure x :< x
  (fz :< f) <*> (sz :< s) = (fz <*> sz) :< f s
  _ <*> _ = B0

instance Applicative Fwd where
  pure x = x :> pure x
  (f :> fs) <*> (s :> ss) = f s :> (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) (f s) (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)

但即使我只是将其中一个内部光标移开（从不介意使尺寸粗糙），事情就会出错。

> 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

当你有一个外部光标位置和多个内部光标位置时，没有转换表现良好。自编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在构图下很容易关闭。这是点点滴滴

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

Hancock的Tensor产品

为了规律，你需要比作曲更强的东西。你需要能够捕捉到＆＃34; g-结构的f-结构 - 所有相同形状＆＃34;的概念。这就是不可估量的彼得汉考克称之为＆＃34;张量产品＆＃34;，我将会写f :><: g：其中一个＆＃34;外部＆＃34; f形和一个＆＃34;内部＆＃34;所有内部g结构共有的g形，因此转换很容易定义并且总是自相反的。 Hancock的张量在Haskell中不是很方便的定义，但是在一个独立类型的环境中，很容易形成一个容器＆＃34;容器的概念。有张量的。

为了给你这个想法，考虑容器的退化概念

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

我们说s是＆＃34;形状的类型＆＃34;和p＆＃34;的位置＆＃34;。值包括形状的选择和每个位置x的存储。在从属情况下，位置的类型可能取决于形状的选择（例如，对于列表，形状是数字（长度），并且您有多个位置）。这些容器有张量产品

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

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

Tensor产品的InContext

现在，正如您在高中时所学到的，∂(s :<| p) = (s, p) :<| (p-1)其中p-1是某种类型，其元素少于p。像∂（s x ^ p）=（s p）* x ^（p-1）。您选择一个位置（将其记录在形状中）并将其删除。问题是p-1在没有依赖类型的情况下开始使用是很棘手的。但是InContext选择一个位置而不删除它。

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

这对于依赖案例也同样适用，我们乐意获取

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

现在我们知道InContext f始终是Comonad，这告诉我们InContext s的张量积是comonadic，因为它们本身就是InContext s。这就是说，你在每个维度上选择一个位置（并且在整个事物中只给出一个位置），之前我们有一个外部位置和许多内部位置。随着张量产品取代组合物，一切都很甜蜜。

Naperian Functors

但是有一个Functor的子类，张量积与组合重合。这些是Functor f f () ~ ()：即，无论如何只有一个形状，因此首先排除了作品中的褴褛值。对于某些位置集Functor，这些(p ->)对于p都是同构的，我们可以将其视为对数（x的指数必须提出来f x）。相应地，汉考克称这些Naperian仿函数是在约翰纳皮尔之后（他的幽灵一直困扰着汉考克居住的爱丁堡的一部分）。

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

Naperian仿函数具有对数，导致project离子函数映射到那里找到的元素的位置。 Naperian仿函数都是zippily Applicative，pure和<*>对应于投影的K和S组合子。还可以构造一个值，其中在每个位置存储非常位置的表示。您可能记得的对数定律令人愉悦。

newtype Id x = Id {unId :: x} deriving Show

instance Naperian Id where
  type Log Id = ()
  project (Id x) () = x
  positions = Id ()

newtype (:*:) f g x = Pr (f x, g x) 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)给出了一个固定大小的数组（ vector ），其中One是常量单位仿函数，其对数为Void。所以数组是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

这意味着多维数组是Naperian。

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

data Focused f x = f x :@ 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维数组确实是一个comonad。向量的组合是n个向量的张量积，因为向量是Naperian。但是Focused n维数组将是确定其维数的n Focused向量的n倍张量积而不是。为了在拉链方面表达这种共聚物，我们需要以能够构造张量产品的形式表达它们。我将此作为未来的练习。

Answer 2

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

如果键（或日志）是一个幺半群，那么一个可表示的（或Naperian）仿函数就是一个comonad本身！然后coreturn获取位置mempty的值。 cojoin mappend是它可用的两个密钥。（就像(p ->)的comonad实例一样。）

{-# 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 -> U Z x
  Dimension :: [U n x] -> U n x -> [U n x] -> U (S n) x

dmap :: (U n x -> U m r) -> 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 (f x)
  fmap f d@Dimension{} = dmap (fmap f) d

class Functor w => Comonad w where
  (=>>)    :: w a -> (w a -> b) -> w b
  coreturn :: w a -> a
  cojoin   :: w a -> w (w a)

  x =>> f = fmap f (cojoin x)
  cojoin xx = xx =>> id

如果列表无限长，则

U可表示。然后只有一个形状。 U n的关键是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 i k) 
    | i < 0 = index (ls `genericIndex` (-i - 1)) k
    | i > 0 = index (rs `genericIndex` ( i - 1)) k
    | otherwise = index mid k

我们需要在两种情况下拆分Representable实例，一个用于Z，另一个用于S，因为我们没有U n类型的值模式匹配。

instance Representable (U Z) 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 P P = 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的密钥确实是一个幺半群，所以我们可以使用可表示的仿函数包中的默认实现将U n变成一个comonad。

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

这次我做了一些测试。

testVal :: U (S (S Z)) 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 n x) 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 n x) where
  show (Point x) = "(Point " ++ show x ++ ")"
  show (Dimension l a r) = "(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

所以事实证明这是错误的。我会把它留在这里以防任何人想要尝试解决它。

这个实现是@pigworker建议我想的方式。它编译，但我还没有测试过。（我从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 -> U Z x
  Dimension :: [U n x] -> U n x -> [U n x] -> U (S n) x

unPoint :: U Z x -> x
unPoint (Point x) = x

dmap :: (U n x -> U m r) -> 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 a b (c:cs)) = Dimension (b:a) c cs
left  (Dimension (a:as) b c) = Dimension as a (b:c)

instance Functor (U n) where
  fmap f (Point x) = Point (f x)
  fmap f d@Dimension{} = dmap (fmap f) d

class Functor w => Comonad w where
  (=>>)    :: w a -> (w a -> b) -> w b
  coreturn :: w a -> a
  cojoin   :: w a -> w (w a)

  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 (S Z) (U n x) -> U n (U (S Z) x)
dist = layerUnder . unlayer

layerUnder :: U (S n) x -> U n (U (S Z) x)
layerUnder d@(Dimension _ Point{} _) = Point d
layerUnder d@(Dimension _ Dimension{} _) = dmap layerUnder d

unlayer :: U (S Z) (U n x) -> U (S n) x
unlayer = dmap unPoint

layer :: U (S n) x -> U (S Z) (U n x)
layer = dmap Point

cojoin1 :: U (S Z) x -> U (S Z) (U (S Z) x)
cojoin1 a = layer $ Dimension (tail $ iterate left a) a (tail $ iterate right a)

为n维网格类型编写cojoin或cobind

3 个答案:

列表中的游标

组合游标，移位游标？

Hancock的Tensor产品

Tensor产品的InContext

Naperian Functors