Écrire cojoin ou cobind pour un type de grille à n dimensions

Question

À l'aide de la définition type de type de niveau de produits naturels, j'ai défini un n-dimensions de la grille.

{-# 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

Maintenant, je veux en faire une instance de Comonad, mais je n'arrive pas à envelopper mon cerveau autour d'elle.

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

À l'aide de cojoin sur un n-dimensions de la grille va produire un n-dimensions de la grille de n-dimensions des grilles. Je voudrais donner un exemple avec la même idée que cette une, qui est que la valeur de la cojoined de la grille à la position (x,y,z) doit être à l' origine de la grille axée sur (x,y,z). Pour adapter ce code, il semble que nous avons besoin de réification n afin d'effectuer n "fmaps" et n "rouleaux". Vous n'avez pas à le faire de cette façon, mais si ça peut aider, alors là vous allez.

Answer 1

Jagger/Richards: vous ne pouvez pas toujours obtenir ce que vous voulez, mais si vous essayez parfois, vous pourriez trouver que vous obtenez ce dont vous avez besoin.

Les curseurs dans les Listes

Permettez-moi de reconstruire les composants de votre structure à l'aide de snoc - et le contre-listes de garder les propriétés spatiales clair. Je définir

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)

Nous allons avoir comonads

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

et faisons en sorte que les curseurs sont 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

Si vous avez activé pour ce genre de choses, vous remarquerez qu' Cursor est un espace agréable variante de l' InContext []

InContext f x = (x, ∂f x)

où ∂ prend le formel dérivé d'un foncteur, donnant à sa notion d'un trou de contexte. InContext f est toujours un Comonad, comme indiqué dans cette réponse, et de ce que nous avons ici est juste qu' Comonad induite par la différentielle de la structure, où counit extraits de l'élément de la mise au point et l' cojoin décore chaque élément avec son propre contexte, effectivement vous donner un contexte plein de recentrage des curseurs et avec un curseur immobile à son foyer. Prenons un exemple.

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

Voir? Le 2 focus a été décoré de devenir le curseur à 2; à la gauche, nous avons la liste de déplacement du curseur à l'-1; à droite, la liste de déplacement du curseur-3 et le curseur à 4.

La Composition De Curseurs, De La Transposition De Curseurs?

Maintenant, la structure que vous demandez à être un Comonad est le n fois la composition de l' Cursor. Nous allons avoir

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

Pour convaincre comonads f et g de composer, de l' counits composer avec soin, mais vous avez besoin d'une "loi de distributivité"

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

ainsi vous pouvez faire le composite cojoin comme ceci

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

Quelles sont les lois qui doivent transpose satisfaire? Probablement quelque chose comme

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

ou ce qu'il faut pour s'assurer que toutes les deux façons de shoogle une séquence de f et de g à partir d'un ordre à l'autre donnent le même résultat.

Peut-on définir une transpose pour Cursor avec lui-même? Une manière d'obtenir une sorte de transposition à bas prix est à noter que l' Bwd et Fwd sont zippily applicative, d'où donc est - 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)

Et ici, vous devriez commencer à sentir le rat. La forme résulte de la troncature, et qui va se casser la évidemment souhaitable bien que l'auto-transposition est auto-inverse. Tout type de raggedness ne survivra pas. Nous ne obtenir une transposition de l'opérateur: sequenceA, et pour des données régulières, tout est brillant et beau.

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

Mais même si je viens de passer l'un de l'intérieur de curseurs de l'alignement (jamais de mal à faire les tailles en lambeaux), les choses aller à vau-l'eau.

> 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

Lorsque vous avez une extérieure de la position du curseur et de multiples intérieure de la position du curseur, il n'y a pas de transposition qui va bien se comporter. Auto-composition Cursor permet à l'intérieur des structures afin d'être déséquilibrée par rapport à l'autre, donc pas de transpose, n cojoin. Vous pouvez, et je l'ai fait, définir

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

mais c'est un fardeau sur nous pour nous assurer de garder l'intérieur des structures régulières. Si vous êtes prêt à accepter cette charge, alors vous pouvez parcourir, car Applicative et Traversable sont facilement fermé en vertu de composition. Voici les pièces et de morceaux de

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

Edit: pour être complet, voici ce qu'il fait quand tout est régulier,

> 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 Tenseur Produit

Pour la régularité, vous avez besoin de quelque chose de plus fort que la composition. Vous devez être en mesure de capturer la notion de "f-structure de g-structures-de-tous-les-mêmes-forme". C'est ce que l'inestimable Peter Hancock appelle le "tenseur produit", je vais écrire f :><: g: il y a un "extérieur" f-forme et un "intérieur" g-forme commune à tous les intérieurs g-structures, afin que la transposition est facilement définissable et toujours auto-inverse. Hancock tenseur n'est pas facilement définissable en Haskell, mais dans un dépendante tapé, il est facile de formuler une notion de "conteneur" qui a ce tenseur.

Pour vous donner l'idée, imaginez un dégénéré notion de conteneur

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

lorsque nous disons s est le type de "formes" et p le type de "positions". Une valeur consiste en le choix d'une forme et le stockage de l' x dans chaque position. Dans le dépendantes cas, le type de postes peut dépendre du choix de la forme (par exemple, pour les listes, la forme est un nombre (la longueur), et vous avez plusieurs postes). Ces conteneurs ont un tenseur produit

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

qui est comme une généralisé de la matrice: une paire de formes donner les dimensions, et puis vous avez un élément à chaque paire de positions. Vous pouvez le faire parfaitement bien quand les types de p et p' reposent sur des valeurs en s et s', et c'est exactement Hancock définition du tenseur des produits de conteneurs.

InContext pour les Produits Tensoriels

Maintenant, comme vous l'avez appris à l'école secondaire, ∂(s :<| p) = (s, p) :<| (p-1) où p-1 est un type avec un moins de l'élément qu' p. Comme ∂(s*x^p) = (s*p)*x^(p-1). Vous sélectionnez une position d'enregistrement (dans la forme) et de le supprimer. Le hic, c'est qu' p-1 est difficile à obtenir vos mains sur sans des types dépendants. Mais InContext sélectionne une position sans la supprimer.

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

Cela fonctionne aussi bien pour les dépendants cas, et nous avons joyeusement acquérir

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

Maintenant, nous savons que InContext f est toujours un Comonad, et cela nous indique que les produits tensoriels de InContexts sont comonadic parce qu'ils sont eux-mêmes InContexts. C'est-à-dire, vous prenez une position par dimension (et qui vous donne exactement la même position dans l'ensemble de la chose), là où avant on avait une position externe et beaucoup d'intérieure positions. Avec le tenseur de produits de remplacement de la composition, tout fonctionne doucement.

Naperian Foncteurs

Mais il y a une sous-classe de Functor pour qui le tenseur du produit et de la composition de coïncider. Ce sont les Functors f dont f () ~ (): c'est à dire, il n'y a qu'une forme de toute façon, si fruste valeurs dans des compositions sont exclues dans la première place. Ces Functors sont tous isomorphe a' (p ->) pour certains de la position d' p qui nous pouvons penser que le logarithme (en l'exposant à qui x doit être soulevée pour donner des f x). En conséquence, Hancock appelle ces Naperian foncteurs d'après John Napier (dont le fantôme hante le cadre d'Edimbourg, où Hancock vie).

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

Un Naperian foncteur a un logarithme, induisant un projection fonction de la cartographie des positions des éléments que l'on y trouve. Naperian foncteurs sont tous zippily Applicative, pure et <*> correspondant à K et S combinators pour les projections. Il est également possible de construire une valeur à chaque position est stockée la même position de la représentation. Les lois des logarithmes dont vous pouvez vous souvenir de pop up agréablement.

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)

Notez qu'un tableau de taille fixe (un vecteur) est donnée par (Id :*: Id :*: ... :*: Id :*: One)où One est la constante de l'unité de foncteur, dont le logarithme est - Void. Si un tableau est Naperian. Maintenant, nous avons aussi

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

ce qui signifie que le multi-dimensions des tableaux sont en Naperian.

Pour construire une version de InContext f pour Naperian f, il suffit de pointer vers une position!

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

Donc, en particulier, un Focused n-dimensions tableau sera en effet une comonad. Une composition de vecteurs est un tenseur produit de n vecteurs, car les vecteurs sont Naperian. Mais l' Focused n-dimensions tableau sera la n-fold tenseur produit, pas la composition, de la n Focused vecteurs de déterminer ses dimensions. Pour exprimer cette comonad en termes de fermetures à glissière, nous allons avoir besoin de les exprimer sous une forme qui permet de construire le tenseur du produit. Je vais laisser ça comme un exercice pour l'avenir.

Answer 2

Encore un essai, inspiré par pigworkers poste et http://hackage.haskell.org/packages/archive/representable-functors/3.0.0.1/doc/html/Data-Functor-Representable.html.

Une représentable (ou Naperian) foncteur est un comonad lui-même, si la clé (ou log) est un monoïde! Ensuite, coreturn obtient la valeur à la position mempty. Et cojoin mappends les deux clés dont il dispose. (Tout comme la comonad exemple pour (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 -> 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 est représentable si les listes sont infiniment longue. Ensuite, il y a une seule forme. La clé de l' U n est un vecteur de n entiers.

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

Nous avons besoin de diviser l' Representable de l'instance dans les deux cas, l'un pour l' Z et l'autre pour S, parce que nous n'avons pas une valeur de type U n le modèle de correspondance.

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)

Et la clé de U n est en effet un monoïde, de sorte que nous pouvons nous tourner U n dans un comonad, en utilisant les implémentations par défaut de la représentable-foncteur paquet.

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

Cette fois, j'ai fait quelques tests.

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

Donc, cela s'avère être faux. Je vais le laisser ici au cas où quelqu'un voudrait essayer de le réparer.

Cette implémentation est ce que @pigworker a suggéré, je pense. Il compile, mais je ne l'ai pas testé. (J'ai pris l'implémentation cojoin1 de http://blog.sigfpe.com/2006/12/evaluating-cellular-automata-is.html )

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