web-dev-qa-db-fra.com

Zipper Comonads, générique

Étant donné tout type de conteneur, nous pouvons former la fermeture éclair (axée sur les éléments) et savoir que cette structure est une Comonad. Cela a été récemment exploré en détail dans ne autre question Stack Overflow pour le type suivant:

data Bin a = Branch (Bin a) a (Bin a) | Leaf a deriving Functor

avec la fermeture éclair suivante

data Dir = L | R
data Step a = Step a Dir (Bin a)   deriving Functor
data Zip  a = Zip [Step a] (Bin a) deriving Functor
instance Comonad Zip where ...

C'est le cas que Zip est un Comonad bien que la construction de son instance soit un peu velue. Cela dit, Zip peut être complètement dérivé mécaniquement de Tree et (je crois) tout type dérivé de cette façon est automatiquement un Comonad, donc je pense que cela devrait être le cas que nous pouvons construire ces types et leurs comonades de manière générique et automatique.

Une méthode pour atteindre la généralité pour la construction de fermeture éclair est l'utilisation de la famille de classe et de type suivante

data Zipper t a = Zipper { diff :: D t a, here :: a }

deriving instance Diff t => Functor (Zipper t)

class (Functor t, Functor (D t)) => Diff t where
  data D t :: * -> *
  inTo  :: t a -> t (Zipper t a)
  outOf :: Zipper t a -> t a

qui est (plus ou moins) apparu dans les fils de discussion de Haskell Cafe et sur le blog de Conal Elliott. Cette classe peut être instanciée pour les différents types algébriques de base et fournit ainsi un cadre général pour parler des dérivés des ADT.

Donc, finalement, ma question est de savoir si nous pouvons ou non écrire

instance Diff t => Comonad (Zipper t) where ...

qui pourrait être utilisé pour subsumer l'instance Comonad spécifique décrite ci-dessus:

instance Diff Bin where
  data D Bin a = DBin { context :: [Step a], descend :: Maybe (Bin a, Bin a) }
  ...

Malheureusement, je n'ai pas eu de chance pour écrire un tel exemple. La signature inTo/outOf est-elle suffisante? Faut-il autre chose pour contraindre les types? Cette instance est-elle même possible?

haskellzipperderivingcomonad
80
J. Abrahamson

Comme l'attaquant de Chitty-Chitty-Bang-Bang attirant les enfants en captivité avec des bonbons et des jouets, les recruteurs du premier cycle en physique aiment s'amuser avec des bulles de savon et des boomerangs, mais lorsque la porte se ferme, c'est "Bon, les enfants, il est temps d'apprendre sur la différenciation partielle! ". Moi aussi. Ne dites pas que je ne vous ai pas prévenu.

Voici un autre avertissement: le code suivant a besoin de {-# LANGUAGE KitchenSink #-}, Ou plutôt

{-# LANGUAGE TypeFamilies, FlexibleContexts, TupleSections, GADTs, DataKinds,
    TypeOperators, FlexibleInstances, RankNTypes, ScopedTypeVariables,
    StandaloneDeriving, UndecidableInstances #-}

dans aucun ordre particulier.

Des foncteurs différenciables donnent des fermetures éclair comonadiques

Qu'est-ce qu'un foncteur différenciable, de toute façon?

class (Functor f, Functor (DF f)) => Diff1 f where
  type DF f :: * -> *
  upF      ::  ZF f x  ->  f x
  downF    ::  f x     ->  f (ZF f x)
  aroundF  ::  ZF f x  ->  ZF f (ZF f x)

data ZF f x = (:<-:) {cxF :: DF f x, elF :: x}

C'est un foncteur qui a un dérivé, qui est aussi un foncteur. La dérivée représente un contexte à un trou pour un élément. Le type de fermeture éclair ZF f x Représente la paire d'un contexte à un trou et l'élément dans le trou.

Les opérations pour Diff1 Décrivent les types de navigation que nous pouvons faire sur les fermetures à glissière (sans aucune notion de "vers la gauche" et "vers la droite", pour lesquelles voir mon Clowns et Jokers papier). On peut aller "vers le haut", remonter la structure en branchant l'élément dans son trou. Nous pouvons aller "vers le bas", trouver toutes les façons de visiter un élément dans une structure donnée: nous décorons chaque élément avec son contexte. Nous pouvons "faire le tour", en prenant une fermeture éclair existante et en décorant chaque élément avec son contexte, nous trouvons donc toutes les façons de se recentrer (et comment garder notre concentration actuelle).

Maintenant, le type de aroundF pourrait rappeler à certains d'entre vous

class Functor c => Comonad c where
  extract    :: c x -> x
  duplicate  :: c x -> c (c x)

et vous avez raison d'être rappelé! Nous avons, avec un saut et un saut,

instance Diff1 f => Functor (ZF f) where
  fmap f (df :<-: x) = fmap f df :<-: f x

instance Diff1 f => Comonad (ZF f) where
  extract    = elF
  duplicate  = aroundF

et nous insistons pour que

extract . duplicate == id
fmap extract . duplicate == id
duplicate . duplicate == fmap duplicate . duplicate

Nous en avons également besoin

fmap extract (downF xs) == xs              -- downF decorates the element in position
fmap upF (downF xs) = fmap (const xs) xs   -- downF gives the correct context

Les foncteurs polynomiaux sont différenciables

Les foncteurs constants sont différenciables.

data KF a x = KF a
instance Functor (KF a) where
  fmap f (KF a) = KF a

instance Diff1 (KF a) where
  type DF (KF a) = KF Void
  upF (KF w :<-: _) = absurd w
  downF (KF a) = KF a
  aroundF (KF w :<-: _) = absurd w

Il n'y a nulle part où mettre un élément, il est donc impossible de former un contexte. Il n'y a nulle part où aller upF ou downF, et nous ne trouvons facilement aucun des moyens d'aller downF.

Le foncteur d'identité est différentiable.

data IF x = IF x
instance Functor IF where
  fmap f (IF x) = IF (f x)

instance Diff1 IF where
  type DF IF = KF ()
  upF (KF () :<-: x) = IF x
  downF (IF x) = IF (KF () :<-: x)
  aroundF z@(KF () :<-: x) = KF () :<-: z

Il y a un élément dans un contexte trivial, downF le trouve, upF le reconditionne et aroundF ne peut que rester sur place.

Sum préserve la différentiabilité.

data (f :+: g) x = LF (f x) | RF (g x)
instance (Functor f, Functor g) => Functor (f :+: g) where
  fmap h (LF f) = LF (fmap h f)
  fmap h (RF g) = RF (fmap h g)

instance (Diff1 f, Diff1 g) => Diff1 (f :+: g) where
  type DF (f :+: g) = DF f :+: DF g
  upF (LF f' :<-: x) = LF (upF (f' :<-: x))
  upF (RF g' :<-: x) = RF (upF (g' :<-: x))

Les autres morceaux sont un peu plus d'une poignée. Pour aller downF, nous devons aller downF à l'intérieur du composant balisé, puis corriger les fermetures à glissière résultantes pour afficher la balise dans le contexte.

  downF (LF f) = LF (fmap (\ (f' :<-: x) -> LF f' :<-: x) (downF f))
  downF (RF g) = RF (fmap (\ (g' :<-: x) -> RF g' :<-: x) (downF g))

Pour aller aroundF, nous supprimons la balise, découvrons comment contourner la chose non balisée, puis restaurons la balise dans toutes les fermetures à glissière résultantes. L'élément sélectionné, x, est remplacé par sa fermeture à glissière complète, z.

  aroundF z@(LF f' :<-: (x :: x)) =
    LF (fmap (\ (f' :<-: x) -> LF f' :<-: x) . cxF $ aroundF (f' :<-: x :: ZF f x))
    :<-: z
  aroundF z@(RF g' :<-: (x :: x)) =
    RF (fmap (\ (g' :<-: x) -> RF g' :<-: x) . cxF $ aroundF (g' :<-: x :: ZF g x))
    :<-: z

Notez que j'ai dû utiliser ScopedTypeVariables pour lever l'ambiguïté des appels récursifs à aroundF. En tant que fonction de type, DF n'est pas injective, donc le fait que f' :: D f x N'est pas suffisant pour forcer f' :<-: x :: Z f x.

Le produit préserve la différentiabilité.

data (f :*: g) x = f x :*: g x
instance (Functor f, Functor g) => Functor (f :*: g) where
  fmap h (f :*: g) = fmap h f :*: fmap h g

Pour vous concentrer sur un élément d'une paire, vous devez soit vous concentrer sur la gauche et laisser la droite tranquille, ou vice versa. La fameuse règle produit de Leibniz correspond à une simple intuition spatiale!

instance (Diff1 f, Diff1 g) => Diff1 (f :*: g) where
  type DF (f :*: g) = (DF f :*: g) :+: (f :*: DF g)
  upF (LF (f' :*: g) :<-: x) = upF (f' :<-: x) :*: g
  upF (RF (f :*: g') :<-: x) = f :*: upF (g' :<-: x)

Maintenant, downF fonctionne de la même manière que pour les sommes, sauf que nous devons corriger le contexte de la fermeture éclair non seulement avec une balise (pour montrer où nous sommes allés) mais aussi avec l'autre composant intact.

  downF (f :*: g)
    =    fmap (\ (f' :<-: x) -> LF (f' :*: g) :<-: x) (downF f)
    :*:  fmap (\ (g' :<-: x) -> RF (f :*: g') :<-: x) (downF g)

Mais aroundF est un énorme sac de rires. Quel que soit le côté que nous visitons actuellement, nous avons deux choix:

  1. Déplacez aroundF de ce côté.
  2. Déplacez upF de ce côté et downF de l'autre côté.

Chaque cas nous oblige à utiliser les opérations de la sous-structure, puis à corriger les contextes.

  aroundF z@(LF (f' :*: g) :<-: (x :: x)) =
    LF (fmap (\ (f' :<-: x) -> LF (f' :*: g) :<-: x)
          (cxF $ aroundF (f' :<-: x :: ZF f x))
        :*: fmap (\ (g' :<-: x) -> RF (f :*: g') :<-: x) (downF g))
    :<-: z
    where f = upF (f' :<-: x)
  aroundF z@(RF (f :*: g') :<-: (x :: x)) =
    RF (fmap (\ (f' :<-: x) -> LF (f' :*: g) :<-: x) (downF f) :*:
        fmap (\ (g' :<-: x) -> RF (f :*: g') :<-: x)
          (cxF $ aroundF (g' :<-: x :: ZF g x)))
    :<-: z
    where g = upF (g' :<-: x)

Phew! Les polynômes sont tous différenciables et nous donnent donc des comonades.

Hmm. C'est un peu abstrait. J'ai donc ajouté deriving Show Partout où je pouvais et j'ai ajouté

deriving instance (Show (DF f x), Show x) => Show (ZF f x)

qui a permis l'interaction suivante (rangé à la main)

> downF (IF 1 :*: IF 2)
IF (LF (KF () :*: IF 2) :<-: 1) :*: IF (RF (IF 1 :*: KF ()) :<-: 2)

> fmap aroundF it
IF  (LF (KF () :*: IF (RF (IF 1 :*: KF ()) :<-: 2)) :<-: (LF (KF () :*: IF 2) :<-: 1))
:*:
IF  (RF (IF (LF (KF () :*: IF 2) :<-: 1) :*: KF ()) :<-: (RF (IF 1 :*: KF ()) :<-: 2))

Exercice Montrez que la composition des foncteurs différenciables est différenciable, en utilisant la règle de chaîne.

Sucré! Pouvons-nous rentrer à la maison maintenant? Bien sûr que non. Nous n'avons encore différencié aucune structure récursive.

Fabriquer des foncteurs récursifs à partir de bifoncteurs

Un Bifunctor, comme l'explique la littérature existante sur la programmation générique de types de données (voir les travaux de Patrik Jansson et Johan Jeuring, ou d'excellentes notes de cours de Jeremy Gibbons) est un constructeur de type à deux paramètres, correspondant à deux sortes de structure. Nous devrions pouvoir "cartographier" les deux.

class Bifunctor b where
  bimap :: (x -> x') -> (y -> y') -> b x y -> b x' y'

Nous pouvons utiliser Bifunctors pour donner la structure des nœuds des conteneurs récursifs. Chaque nœud a sous-nœuds et éléments. Ce ne peuvent être que les deux sortes de sous-structure.

data Mu b y = In (b (Mu b y) y)

Voir? Nous "lions le nœud récursif" dans le premier argument de b et conservons le paramètre y dans son second. En conséquence, nous obtenons une fois pour toutes

instance Bifunctor b => Functor (Mu b) where
  fmap f (In b) = In (bimap (fmap f) f b)

Pour l'utiliser, nous aurons besoin d'un kit d'instances Bifunctor.

Le kit Bifunctor

Les constantes sont bifunctorielles.

newtype K a x y = K a

instance Bifunctor (K a) where
  bimap f g (K a) = K a

Vous pouvez dire que j'ai écrit ce bit en premier, car les identifiants sont plus courts, mais c'est bien parce que le code est plus long.

Les variables sont bifunctorielles.

Nous avons besoin des bifoncteurs correspondant à l'un ou l'autre paramètre, j'ai donc fait un type de données pour les distinguer, puis défini un GADT adapté.

data Var = X | Y

data V :: Var -> * -> * -> * where
  XX :: x -> V X x y
  YY :: y -> V Y x y

Cela fait V X x y Une copie de x et V Y x y Une copie de y. En conséquence

instance Bifunctor (V v) where
  bimap f g (XX x) = XX (f x)
  bimap f g (YY y) = YY (g y)

Les sommes et Les produits des bifunctors sont des bifunctors

data (:++:) f g x y = L (f x y) | R (g x y) deriving Show

instance (Bifunctor b, Bifunctor c) => Bifunctor (b :++: c) where
  bimap f g (L b) = L (bimap f g b)
  bimap f g (R b) = R (bimap f g b)

data (:**:) f g x y = f x y :**: g x y deriving Show

instance (Bifunctor b, Bifunctor c) => Bifunctor (b :**: c) where
  bimap f g (b :**: c) = bimap f g b :**: bimap f g c

Jusqu'à présent, donc passe-partout, mais maintenant nous pouvons définir des choses comme

List = Mu (K () :++: (V Y :**: V X))

Bin = Mu (V Y :**: (K () :++: (V X :**: V X)))

Si vous souhaitez utiliser ces types pour des données réelles et ne pas devenir aveugle dans la tradition pointilliste de Georges Seurat, utilisez synonyme de modèle.

Mais qu'en est-il des fermetures éclair? Comment montrer que Mu b Est différentiable? Nous devrons montrer que b est différenciable en both variables. Bruit! Il est temps d'en apprendre davantage sur la différenciation partielle.

Dérivés partiels des bifoncteurs

Parce que nous avons deux variables, nous devrons être capables d'en parler collectivement parfois et individuellement à d'autres moments. Nous aurons besoin de la famille singleton:

data Vary :: Var -> * where
  VX :: Vary X
  VY :: Vary Y

Maintenant, nous pouvons dire ce que signifie pour un bifoncteur d'avoir des dérivées partielles à chaque variable, et donner la notion correspondante de fermeture éclair.

class (Bifunctor b, Bifunctor (D b X), Bifunctor (D b Y)) => Diff2 b where
  type D b (v :: Var) :: * -> * -> *
  up      :: Vary v -> Z b v x y -> b x y
  down    :: b x y -> b (Z b X x y) (Z b Y x y)
  around  :: Vary v -> Z b v x y -> Z b v (Z b X x y) (Z b Y x y)

data Z b v x y = (:<-) {cxZ :: D b v x y, elZ :: V v x y}

Cette opération D doit savoir quelle variable cibler. La fermeture éclair correspondante Z b v Nous indique quelle variable v doit être mise au point. Lorsque nous "décorons avec le contexte", nous devons décorer les éléments x- avec les contextes X- et les éléments y- avec les contextes Y-. Mais sinon, c'est la même histoire.

Il nous reste deux tâches: premièrement, montrer que notre kit bifoncteur est différenciable; deuxièmement, pour montrer que Diff2 b nous permet d'établir Diff1 (Mu b).

Différencier le kit Bifunctor

J'ai bien peur que ce morceau soit compliqué plutôt qu'édifiant. N'hésitez pas à sauter.

Les constantes sont comme avant.

instance Diff2 (K a) where
  type D (K a) v = K Void
  up _ (K q :<- _) = absurd q
  down (K a) = K a
  around _ (K q :<- _) = absurd q

A cette occasion, la vie est trop courte pour développer la théorie du type niveau Kronecker-delta, donc je viens de traiter les variables séparément.

instance Diff2 (V X) where
  type D (V X) X = K ()
  type D (V X) Y = K Void
  up VX (K () :<- XX x)  = XX x
  up VY (K q :<- _)      = absurd q
  down (XX x) = XX (K () :<- XX x)
  around VX z@(K () :<- XX x)  = K () :<- XX z
  around VY (K q :<- _)        = absurd q

instance Diff2 (V Y) where
  type D (V Y) X = K Void
  type D (V Y) Y = K ()
  up VX (K q :<- _)      = absurd q
  up VY (K () :<- YY y)  = YY y
  down (YY y) = YY (K () :<- YY y)
  around VX (K q :<- _)        = absurd q
  around VY z@(K () :<- YY y)  = K () :<- YY z

Pour les cas structurels, j'ai trouvé utile d'introduire un assistant me permettant de traiter les variables de manière uniforme.

vV :: Vary v -> Z b v x y -> V v (Z b X x y) (Z b Y x y)
vV VX z = XX z
vV VY z = YY z

J'ai ensuite construit des gadgets pour faciliter le type de "repérage" dont nous avons besoin pour down et around. (Bien sûr, j'ai vu de quels gadgets j'avais besoin pendant que je travaillais.)

zimap :: (Bifunctor c) => (forall v. Vary v -> D b v x y -> D b' v x y) ->
         c (Z b X x y) (Z b Y x y) -> c (Z b' X x y) (Z b' Y x y)
zimap f = bimap
  (\ (d :<- XX x) -> f VX d :<- XX x)
  (\ (d :<- YY y) -> f VY d :<- YY y)

dzimap :: (Bifunctor (D c X), Bifunctor (D c Y)) =>
         (forall v. Vary v -> D b v x y -> D b' v x y) ->
         Vary v -> Z c v (Z b X x y) (Z b Y x y) -> D c v (Z b' X x y) (Z b' Y x y)
dzimap f VX (d :<- _) = bimap
  (\ (d :<- XX x) -> f VX d :<- XX x)
  (\ (d :<- YY y) -> f VY d :<- YY y)
  d
dzimap f VY (d :<- _) = bimap
  (\ (d :<- XX x) -> f VX d :<- XX x)
  (\ (d :<- YY y) -> f VY d :<- YY y)
  d

Et avec ce lot prêt à partir, nous pouvons broyer les détails. Les sommes sont faciles.

instance (Diff2 b, Diff2 c) => Diff2 (b :++: c) where
  type D (b :++: c) v = D b v :++: D c v
  up v (L b' :<- vv) = L (up v (b' :<- vv))
  down (L b) = L (zimap (const L) (down b))
  down (R c) = R (zimap (const R) (down c))
  around v z@(L b' :<- vv :: Z (b :++: c) v x y)
    = L (dzimap (const L) v ba) :<- vV v z
    where ba = around v (b' :<- vv :: Z b v x y)
  around v z@(R c' :<- vv :: Z (b :++: c) v x y)
    = R (dzimap (const R) v ca) :<- vV v z
    where ca = around v (c' :<- vv :: Z c v x y)

Les produits sont un travail difficile, c'est pourquoi je suis un mathématicien plutôt qu'un ingénieur.

instance (Diff2 b, Diff2 c) => Diff2 (b :**: c) where
  type D (b :**: c) v = (D b v :**: c) :++: (b :**: D c v)
  up v (L (b' :**: c) :<- vv) = up v (b' :<- vv) :**: c
  up v (R (b :**: c') :<- vv) = b :**: up v (c' :<- vv)
  down (b :**: c) =
    zimap (const (L . (:**: c))) (down b) :**: zimap (const (R . (b :**:))) (down c)
  around v z@(L (b' :**: c) :<- vv :: Z (b :**: c) v x y)
    = L (dzimap (const (L . (:**: c))) v ba :**:
        zimap (const (R . (b :**:))) (down c))
      :<- vV v z where
      b = up v (b' :<- vv :: Z b v x y)
      ba = around v (b' :<- vv :: Z b v x y)
  around v z@(R (b :**: c') :<- vv :: Z (b :**: c) v x y)
    = R (zimap (const (L . (:**: c))) (down b):**:
        dzimap (const (R . (b :**:))) v ca)
      :<- vV v z where
      c = up v (c' :<- vv :: Z c v x y)
      ca = around v (c' :<- vv :: Z c v x y)

Conceptuellement, c'est comme avant, mais avec plus de bureaucratie. Je les ai construits en utilisant la technologie de pré-type de trou, en utilisant undefined comme talon dans des endroits où je n'étais pas prêt à travailler, et en introduisant une erreur de type délibérée au seul endroit (à un moment donné) où je voulais un indice utile du vérificateur de typographie. Vous pouvez également avoir la vérification de type comme expérience de jeu vidéo, même dans Haskell.

Fermetures à glissière sous-noeud pour conteneurs récursifs

La dérivée partielle de b par rapport à X nous indique comment trouver un sous-noeud une étape à l'intérieur d'un noeud, nous obtenons donc la notion conventionnelle de fermeture éclair.

data MuZpr b y = MuZpr
  {  aboveMu  :: [D b X (Mu b y) y]
  ,  hereMu   :: Mu b y
  }

Nous pouvons zoomer jusqu'à la racine en branchant de façon répétée les positions X.

muUp :: Diff2 b => MuZpr b y -> Mu b y
muUp (MuZpr {aboveMu = [], hereMu = t}) = t
muUp (MuZpr {aboveMu = (dX : dXs), hereMu = t}) =
  muUp (MuZpr {aboveMu = dXs, hereMu = In (up VX (dX :<- XX t))})

Mais nous avons besoin de element ​​- fermetures à glissière.

Fermetures à glissière pour les points fixes des bifoncteurs

Chaque élément est quelque part à l'intérieur d'un nœud. Ce nœud se trouve sous une pile de dérivés X-. Mais la position de l'élément dans ce nœud est donnée par un dérivé Y-. On a

data MuCx b y = MuCx
  {  aboveY  :: [D b X (Mu b y) y]
  ,  belowY  :: D b Y (Mu b y) y
  }

instance Diff2 b => Functor (MuCx b) where
  fmap f (MuCx { aboveY = dXs, belowY = dY }) = MuCx
    {  aboveY  = map (bimap (fmap f) f) dXs
    ,  belowY  = bimap (fmap f) f dY
    }

Audacieusement, je prétends

instance Diff2 b => Diff1 (Mu b) where
  type DF (Mu b) = MuCx b

mais avant de développer les opérations, j'aurai besoin de quelques morceaux.

Je peux échanger des données entre les fermetures à glissière fonctor et les fermetures à glissière bifunctor comme suit:

zAboveY :: ZF (Mu b) y -> [D b X (Mu b y) y]  -- the stack of `X`-derivatives above me
zAboveY (d :<-: y) = aboveY d

zZipY :: ZF (Mu b) y -> Z b Y (Mu b y) y      -- the `Y`-zipper where I am
zZipY (d :<-: y) = belowY d :<- YY y

Cela suffit pour me permettre de définir:

  upF z  = muUp (MuZpr {aboveMu = zAboveY z, hereMu = In (up VY (zZipY z))})

Autrement dit, nous montons en remontant d'abord le nœud où se trouve l'élément, en transformant une fermeture à glissière en sous-nœud, puis en zoomant complètement, comme ci-dessus.

Ensuite, je dis

  downF  = yOnDown []

pour descendre en commençant par la pile vide, et définir la fonction d'assistance qui va down à plusieurs reprises sous n'importe quelle pile:

yOnDown :: Diff2 b => [D b X (Mu b y) y] -> Mu b y -> Mu b (ZF (Mu b) y)
yOnDown dXs (In b) = In (contextualize dXs (down b))

Maintenant, down b Nous emmène uniquement à l'intérieur du nœud. Les fermetures éclair dont nous avons besoin doivent également porter le contexte du nœud. C'est ce que contextualise fait:

contextualize :: (Bifunctor c, Diff2 b) =>
  [D b X (Mu b y) y] ->
  c (Z b X (Mu b y) y) (Z b Y (Mu b y) y) ->
  c (Mu b (ZF (Mu b) y)) (ZF (Mu b) y)
contextualize dXs = bimap
  (\ (dX :<- XX t) -> yOnDown (dX : dXs) t)
  (\ (dY :<- YY y) -> MuCx {aboveY = dXs, belowY = dY} :<-: y)

Pour chaque Y- position, nous devons donner un élément-zip, il est donc bon que nous connaissions tout le contexte dXs à la racine, ainsi que le dY qui décrit comment l'élément se trouve dans son nœud. Pour chaque X- position, il y a un autre sous-arbre à explorer, donc nous agrandissons la pile et continuons!

Cela ne laisse que la tâche de changer d'orientation. Nous pourrions rester sur place, ou descendre d'où nous sommes, ou monter, ou monter et ensuite emprunter une autre voie. Voici.

  aroundF z@(MuCx {aboveY = dXs, belowY = dY} :<-: _) = MuCx
    {  aboveY = yOnUp dXs (In (up VY (zZipY z)))
    ,  belowY = contextualize dXs (cxZ $ around VY (zZipY z))
    }  :<-: z

Comme toujours, l'élément existant est remplacé par toute sa fermeture éclair. Pour la partie belowY, nous regardons où nous pouvons aller dans le nœud existant: nous trouverons soit un élément alternatif Y- positions soit d'autres X- sous-nœuds à explorer, donc nous contextualise eux. Pour la partie aboveY, nous devons remonter la pile des dérivés X- après avoir remonté le nœud que nous visitions.

yOnUp :: Diff2 b => [D b X (Mu b y) y] -> Mu b y ->
         [D b X (Mu b (ZF (Mu b) y)) (ZF (Mu b) y)]
yOnUp [] t = []
yOnUp (dX : dXs) (t :: Mu b y)
  =  contextualize dXs (cxZ $ around VX (dX :<- XX t))
  :  yOnUp dXs (In (up VX (dX :<- XX t)))

À chaque étape, nous pouvons soit nous tourner vers un autre endroit qui est around, soit continuer à monter.

Et c'est tout! Je n'ai pas donné de preuve formelle des lois, mais il me semble que les opérations conservent correctement le contexte lors de l'exploration de la structure.

Qu'avons-nous appris?

La différenciation induit des notions de chose dans son contexte, induisant une structure comonadique où extract vous donne la chose et duplicate explore le contexte à la recherche d'autres choses à contextualiser. Si nous avons la structure différentielle appropriée pour les nœuds, nous pouvons développer une structure différentielle pour les arbres entiers.

Oh, et traiter chaque arité individuelle de constructeur de type séparément est horriblement flagrant. La meilleure façon est de travailler avec des foncteurs entre des ensembles indexés

f :: (i -> *) -> (o -> *)

où nous faisons o différentes sortes de structure stockant i différentes sortes d'éléments. Ce sont fermé sous la construction jacobienne

J f :: (i -> *) -> ((o, i) -> *)

où chacune des structures (o, i) - résultantes est une dérivée partielle, vous expliquant comment faire un trou d'élément i- dans une structure o-. Mais c'est amusant typiquement dépendant, pour une autre fois.

110
pigworker

L'instance Comonad pour les fermetures à glissière n'est pas pas 

instance (Diff t, Diff (D t)) => Comonad (Zipper t) where
    extract = here
    duplicate = fmap outOf . inTo

où outOf et inTo proviennent de l'instance Diff pour Zipper t lui-même. L'instance ci-dessus viole la loi Comonadfmap extract . duplicate == id. Au lieu de cela, il se comporte comme:

fmap extract . duplicate == \z -> fmap (const (here z)) z

Diff (fermeture éclair t)

L'instance Diff pour Zipper est fournie en les identifiant comme des produits et en réutilisant le code des produits (ci-dessous).

-- Zippers are themselves products
toZipper :: (D t :*: Identity) a -> Zipper t a
toZipper (d :*: (Identity h)) = Zipper d h

fromZipper :: Zipper t a -> (D t :*: Identity) a
fromZipper (Zipper d h) = (d :*: (Identity h))

Étant donné un isomorphisme entre les types de données et un isomorphisme entre leurs dérivés, nous pouvons réutiliser les types inTo et outOf d'un type pour l'autre.

inToFor' :: (Diff r) =>
            (forall a.   r a ->   t a) ->
            (forall a.   t a ->   r a) ->
            (forall a. D r a -> D t a) ->
            (forall a. D t a -> D r a) ->
            t a -> t (Zipper t a)
inToFor' to from toD fromD = to . fmap (onDiff toD) . inTo . from

outOfFor' :: (Diff r) =>
            (forall a.   r a ->   t a) ->
            (forall a.   t a ->   r a) ->
            (forall a. D r a -> D t a) ->
            (forall a. D t a -> D r a) ->
            Zipper t a -> t a
outOfFor' to from toD fromD = to . outOf . onDiff fromD

Pour les types qui ne sont que des newTypes pour une instance Diff existante, leurs dérivés sont du même type. Si nous informons le vérificateur de type de cette égalité de type D r ~ D t, Nous pouvons en profiter au lieu de fournir un isomorphisme pour les dérivés.

inToFor :: (Diff r, D r ~ D t) =>
           (forall a. r a -> t a) ->
           (forall a. t a -> r a) ->
           t a -> t (Zipper t a)
inToFor to from = inToFor' to from id id

outOfFor :: (Diff r, D r ~ D t) =>
            (forall a. r a -> t a) ->
            (forall a. t a -> r a) ->
            Zipper t a -> t a
outOfFor to from = outOfFor' to from id id

Équipés de ces outils, nous pouvons réutiliser l'instance Diff pour que les produits implémentent Diff (Zipper t)

-- This requires undecidable instances, due to the need to take D (D t)
instance (Diff t, Diff (D t)) => Diff (Zipper t) where
    type D (Zipper t) = D ((D t) :*: Identity)
    -- inTo :: t        a -> t        (Zipper  t         a)
    -- inTo :: Zipper t a -> Zipper t (Zipper (Zipper t) a)
    inTo = inToFor toZipper fromZipper
    -- outOf :: Zipper  t         a -> t        a
    -- outOf :: Zipper (Zipper t) a -> Zipper t a
    outOf = outOfFor toZipper fromZipper

Chaudière

Afin d'utiliser réellement le code présenté ici, nous avons besoin de quelques extensions de langage, d'importations et d'une reformulation du problème proposé.

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}

import Control.Monad.Identity
import Data.Proxy
import Control.Comonad

data Zipper t a = Zipper { diff :: D t a, here :: a }

onDiff :: (D t a -> D u a) -> Zipper t a -> Zipper u a
onDiff f (Zipper d a) = Zipper (f d) a

deriving instance Diff t => Functor (Zipper t)
deriving instance (Eq (D t a), Eq a) => Eq (Zipper t a)
deriving instance (Show (D t a), Show a) => Show (Zipper t a)

class (Functor t, Functor (D t)) => Diff t where
  type D t :: * -> *
  inTo  :: t a -> t (Zipper t a)
  outOf :: Zipper t a -> t a

Produits, sommes et constantes

L'instance Diff (Zipper t) repose sur les implémentations de Diff pour les produits :*:, Les sommes :+:, Les constantes Identity et zéro Proxy.

data (:+:) a b x = InL (a x) | InR (b x)
    deriving (Eq, Show)
data (:*:) a b x = a x :*: b x
    deriving (Eq, Show)

infixl 7 :*:
infixl 6 :+:

deriving instance (Functor a, Functor b) => Functor (a :*: b)

instance (Functor a, Functor b) => Functor (a :+: b) where
    fmap f (InL a) = InL . fmap f $ a
    fmap f (InR b) = InR . fmap f $ b


instance (Diff a, Diff b) => Diff (a :*: b) where
    type D (a :*: b) = D a :*: b :+: a :*: D b
    inTo (a :*: b) = 
        (fmap (onDiff (InL . (:*: b))) . inTo) a :*:
        (fmap (onDiff (InR . (a :*:))) . inTo) b
    outOf (Zipper (InL (a :*: b)) x) = (:*: b) . outOf . Zipper a $ x
    outOf (Zipper (InR (a :*: b)) x) = (a :*:) . outOf . Zipper b $ x

instance (Diff a, Diff b) => Diff (a :+: b) where
    type D (a :+: b) = D a :+: D b
    inTo (InL a) = InL . fmap (onDiff InL) . inTo $ a
    inTo (InR b) = InR . fmap (onDiff InR) . inTo $ b
    outOf (Zipper (InL a) x) = InL . outOf . Zipper a $ x
    outOf (Zipper (InR a) x) = InR . outOf . Zipper a $ x

instance Diff (Identity) where
    type D (Identity) = Proxy
    inTo = Identity . (Zipper Proxy) . runIdentity
    outOf = Identity . here

instance Diff (Proxy) where
    type D (Proxy) = Proxy
    inTo = const Proxy
    outOf = const Proxy

Exemple de bac

J'ai posé l'exemple Bin comme un isomorphisme à une somme de produits. Nous avons besoin non seulement de sa dérivée mais aussi de sa dérivée seconde

newtype Bin   a = Bin   {unBin   ::      (Bin :*: Identity :*: Bin :+: Identity)  a}
    deriving (Functor, Eq, Show)
newtype DBin  a = DBin  {unDBin  ::    D (Bin :*: Identity :*: Bin :+: Identity)  a}
    deriving (Functor, Eq, Show)
newtype DDBin a = DDBin {unDDBin :: D (D (Bin :*: Identity :*: Bin :+: Identity)) a}
    deriving (Functor, Eq, Show)

instance Diff Bin where
    type D Bin = DBin
    inTo  = inToFor'  Bin unBin DBin unDBin
    outOf = outOfFor' Bin unBin DBin unDBin

instance Diff DBin where
    type D DBin = DDBin
    inTo  = inToFor'  DBin unDBin DDBin unDDBin
    outOf = outOfFor' DBin unDBin DDBin unDDBin

L'exemple de données de réponse précédente est

aTree :: Bin Int    
aTree =
    (Bin . InL) (
        (Bin . InL) (
            (Bin . InR) (Identity 2)
            :*: (Identity 1) :*:
            (Bin . InR) (Identity 3)
        )
        :*: (Identity 0) :*:
        (Bin . InR) (Identity 4)
    )

Pas l'instance Comonad

L'exemple Bin ci-dessus fournit un contre-exemple à fmap outOf . inTo Étant l'implémentation correcte de duplicate pour Zipper t. En particulier, il fournit un contre-exemple à la loi fmap extract . duplicate = id:

fmap ( \z -> (fmap extract . duplicate) z == z) . inTo $ aTree

Qui évalue à (remarquez qu'il est plein de False partout, n'importe quel False suffirait à réfuter la loi)

Bin {unBin = InL ((Bin {unBin = InL ((Bin {unBin = InR (Identity False)} :*: Identity False) :*: Bin {unBin = InR (Identity False)})} :*: Identity False) :*: Bin {unBin = InR (Identity False)})}

inTo aTree Est un arbre avec la même structure que aTree, mais partout où il y avait une valeur, il y a plutôt une fermeture éclair avec la valeur, et le reste de l'arbre avec toutes les valeurs d'origine intactes. fmap (fmap extract . duplicate) . inTo $ aTree est aussi un arbre avec la même structure que aTree, mais chaque fois qu'il y avait une valeur, il y a plutôt une fermeture éclair avec la valeur, et le reste de l'arbre avec tous des valeurs remplacées par cette même valeur. En d'autres termes:

fmap extract . duplicate == \z -> fmap (const (here z)) z

La suite de tests complète pour les trois lois Comonad, extract . duplicate == id, fmap extract . duplicate == id Et duplicate . duplicate == fmap duplicate . duplicate Est

main = do
    putStrLn "fmap (\\z -> (extract . duplicate) z == z) . inTo $ aTree"
    print   . fmap ( \z -> (extract . duplicate) z == z) . inTo $ aTree    
    putStrLn ""
    putStrLn  "fmap (\\z -> (fmap extract . duplicate) z == z) . inTo $ aTree"
    print    . fmap ( \z -> (fmap extract . duplicate) z == z) . inTo $ aTree    
    putStrLn ""
    putStrLn "fmap (\\z -> (duplicate . duplicate) z) == (fmap duplicate . duplicate) z) . inTo $ aTree"
    print   . fmap ( \z -> (duplicate . duplicate) z == (fmap duplicate . duplicate) z) . inTo $ aTree
12
Cirdec

Étant donné une classe Diff infiniment différentiable:

class (Functor t, Functor (D t)) => Diff t where
    type D t :: * -> *
    up :: Zipper t a -> t a
    down :: t a -> t (Zipper t a)  
    -- Require that types be infinitely differentiable
    ddiff :: p t -> Dict (Diff (D t))

around peut être écrit en termes de up et down sur le dérivé de Zipperdiff, essentiellement comme

around z@(Zipper d h) = Zipper ctx z
    where
        ctx = fmap (\z' -> Zipper (up z') (here z')) (down d)

Le Zipper t a Se compose d'un D t a Et d'un a. Nous allons down le D t a, Obtenant une D t (Zipper (D t) a) avec une fermeture éclair dans chaque trou. Ces fermetures à glissière se composent d'une D (D t) a et du a qui se trouvait dans le trou. Nous allons up chacun d'eux, obtenant un D t a Et le comparant avec le a qui était dans le trou. Un D t a Et un a font un Zipper t a, Nous donnant une D t (Zipper t a), qui est le contexte nécessaire pour une Zipper t (Zipper t a).

L'instance Comonad est alors simplement

instance Diff t => Comonad (Zipper t) where
    extract   = here
    duplicate = around

La capture du dictionnaire Diff du dérivé nécessite une plomberie supplémentaire, ce qui peut être fait avec Data.Constraint ou en termes de la méthode présentée dans une réponse connexe

around :: Diff t => Zipper t a -> Zipper t (Zipper t a)
around z = Zipper (withDict d' (fmap (\z' -> Zipper (up z') (here z')) (down (diff z)))) z
    where
        d' = ddiff . p' $ z
        p' :: Zipper t x -> Proxy t
        p' = const Proxy
8
Cirdec