Reißverschluss-Comonaden im Allgemeinen

Bei jedem Containertyp können wir den (elementfokussierten) Reißverschluss bilden und wissen, dass diese Struktur eine Comonad ist. Dies wurde kürzlich in einer anderen Frage zum Stapelüberlauf für den folgenden Typ ausführlich untersucht :

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

mit folgendem Reißverschluss

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

Es ist der Fall , dass Zipeine ist , Comonadobwohl die Konstruktion der Instanz ein wenig behaart ist. Das heißt, Zipkann vollständig mechanisch abgeleitet werden Treeund (ich glaube) jeder Typ, der auf diese Weise abgeleitet wird, ist automatisch ein Comonad. Ich denke, es sollte der Fall sein, dass wir diese Typen und ihre Comonaden generisch und automatisch konstruieren können.

Eine Methode zur Erreichung der Allgemeinheit für die Reißverschlusskonstruktion ist die Verwendung der folgenden Klassen- und Typenfamilie

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

Das ist (mehr oder weniger) in den Threads von Haskell Cafe und auf Conal Elliotts Blog aufgetaucht. Diese Klasse kann für die verschiedenen algebraischen Kerntypen instanziiert werden und bietet somit einen allgemeinen Rahmen für die Diskussion über die Ableitungen von ADTs.

Letztendlich ist meine Frage also, ob wir schreiben können oder nicht

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

Dies könnte verwendet werden, um die oben beschriebene spezifische Comonad-Instanz zusammenzufassen:

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

Leider hatte ich kein Glück, eine solche Instanz zu schreiben. Ist die inTo/ outOfSignatur ausreichend? Gibt es noch etwas, das benötigt wird, um die Typen einzuschränken? Ist diese Instanz überhaupt möglich?

Wie der Kinderfänger in Chitty-Chitty-Bang-Bang, der Kinder mit Süßigkeiten und Spielzeug in die Gefangenschaft lockt, täuschen Rekrutierer für ein Physikstudium gerne mit Seifenblasen und Bumerangs herum, aber wenn die Tür zuklappt, ist es "Richtig, Kinder, Zeit zu lernen über partielle Differenzierung! ". Ich auch. Sag nicht, ich hätte dich nicht gewarnt.

Hier ist eine weitere Warnung: Der folgende Code benötigt {-# LANGUAGE KitchenSink #-}oder besser gesagt

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

In keiner bestimmten Reihenfolge.

Differenzierbare Funktoren geben komonadische Reißverschlüsse

Was ist überhaupt ein differenzierbarer Funktor?

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}

Es ist ein Funktor, der eine Ableitung hat, die auch ein Funktor ist. Die Ableitung repräsentiert einen Ein-Loch-Kontext für ein Element . Der Reißverschlusstyp ZF f xrepräsentiert das Paar aus einem Ein-Loch-Kontext und dem Element im Loch.

Die Operationen zur Diff1Beschreibung der Navigationsarten, die wir mit Reißverschlüssen ausführen können (ohne die Vorstellung von "nach links" und "nach rechts", siehe mein Papier " Clowns und Joker" ). Wir können "nach oben" gehen und die Struktur wieder zusammensetzen, indem wir das Element in sein Loch stecken. Wir können "nach unten" gehen und jeden Weg finden, um ein Element in einer bestimmten Struktur zu besuchen: Wir dekorieren jedes Element mit seinem Kontext. Wir können "herumgehen", einen vorhandenen Reißverschluss nehmen und jedes Element mit seinem Kontext dekorieren, sodass wir alle Möglichkeiten finden, uns neu zu konzentrieren (und unseren aktuellen Fokus beizubehalten).

Nun, die Art von aroundFkönnte einige von Ihnen daran erinnern

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

und du hast Recht, daran erinnert zu werden! Wir haben mit einem Sprung und einem Sprung,

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

und wir bestehen darauf

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

Das brauchen wir auch

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

Polynomfunktoren sind differenzierbar

Konstante Funktoren sind differenzierbar.

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

Es gibt keinen Ort, an dem ein Element platziert werden kann, daher ist es unmöglich, einen Kontext zu bilden. Es gibt nirgendwo zu gehen upFoder downFaus, und wir einfach alle keine der Wege finden , um zu gehen downF.

Der Identitätsfunktor ist differenzierbar.

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

Es gibt ein Element in einem trivialen Kontext, downFfindet es, upFpackt es neu und aroundFkann nur stehen bleiben.

Die Summe bewahrt die Differenzierbarkeit.

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

Die anderen Teile sind eher eine Handvoll. Um zu gehen downF, müssen wir downFin die markierte Komponente gehen und dann die resultierenden Reißverschlüsse reparieren, um das Tag im Kontext anzuzeigen.

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

Zum aroundFEntfernen entfernen wir das Etikett, finden heraus, wie Sie das nicht markierte Objekt umgehen können, und stellen dann das Etikett in allen resultierenden Reißverschlüssen wieder her. Das fokussierte Element xwird durch seinen gesamten Reißverschluss ersetzt 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

Beachten Sie, dass ich verwenden musste, um ScopedTypeVariablesdie rekursiven Aufrufe von zu eindeutig zu machen aroundF. Als Typ Funktion DFist nicht injektiv, so dass die Tatsache, dass f' :: D f xnicht ausreicht, um zu erzwingen f' :<-: x :: Z f x.

Das Produkt bewahrt die Differenzierbarkeit.

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

Um sich auf ein Element in einem Paar zu konzentrieren, konzentrieren Sie sich entweder auf die linke Seite und lassen die rechte Seite in Ruhe oder umgekehrt. Leibniz 'berühmte Produktregel entspricht einer einfachen räumlichen Intuition!

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)

Funktioniert jetzt downFähnlich wie bei Summen, außer dass wir den Reißverschlusskontext nicht nur mit einem Tag (um zu zeigen, welchen Weg wir gegangen sind), sondern auch mit der unberührten anderen Komponente korrigieren müssen.

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

Aber aroundFist eine riesige Tasche voller Lacher. Welche Seite wir gerade besuchen, wir haben zwei Möglichkeiten:

1. Bewegen Sie sich aroundFauf dieser Seite.
2. Bewegen Sie upFsich von dieser Seite downFauf die andere Seite.

In jedem Fall müssen wir die Operationen für die Unterstruktur verwenden und dann die Kontexte reparieren.

  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)

Puh! Die Polynome sind alle differenzierbar und geben uns daher Comonaden.

Hmm. Es ist alles ein bisschen abstrakt. Also fügte ich hinzu, deriving Showwo immer ich konnte, und warf mich hinein

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

was die folgende Interaktion ermöglichte (von Hand aufgeräumt)

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

Übung Zeigen Sie anhand der Kettenregel, dass die Zusammensetzung differenzierbarer Funktoren differenzierbar ist .

Süss! Können wir jetzt nach Hause gehen? Natürlich nicht. Wir haben noch keine rekursiven Strukturen unterschieden.

Rekursive Funktoren aus Bifunktoren herstellen

A ist Bifunctor, wie die vorhandene Literatur zur generischen Programmierung von Datentypen (siehe Arbeiten von Patrik Jansson und Johan Jeuring oder ausgezeichnete Vorlesungsunterlagen von Jeremy Gibbons) ausführlich erklärt, ein Typkonstruktor mit zwei Parametern, die zwei Arten von Unterstrukturen entsprechen. Wir sollten in der Lage sein, beide "abzubilden".

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

Wir können Bifunctors verwenden, um die Knotenstruktur rekursiver Container anzugeben. Jeder Knoten hat Unterknoten und Elemente . Dies können nur die zwei Arten von Unterstrukturen sein.

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

Sehen? Wir "binden den rekursiven Knoten" im bersten Argument und behalten den Parameter yim zweiten. Dementsprechend erhalten wir ein für allemal

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

Um dies zu nutzen, benötigen wir eine Reihe von BifunctorInstanzen.

Das Bifunctor Kit

Konstanten sind bifunktoriell.

newtype K a x y = K a

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

Sie können sagen, dass ich dieses Bit zuerst geschrieben habe, weil die Bezeichner kürzer sind, aber das ist gut, weil der Code länger ist.

Variablen sind bifunktoriell.

Wir brauchen die Bifunktoren, die dem einen oder anderen Parameter entsprechen, also habe ich einen Datentyp erstellt, um sie zu unterscheiden, und dann ein geeignetes GADT definiert.

data Var = X | Y

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

Das macht V X x yeine Kopie von xund V Y x yeine Kopie von y. Entsprechend

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

Summen und Produkte von Bifunktoren sind Bifunktoren

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

So weit, so Boilerplate, aber jetzt können wir Dinge wie definieren

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

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

Wenn Sie diese Typen für tatsächliche Daten verwenden und nicht in der pointillistischen Tradition von Georges Seurat erblinden möchten, verwenden Sie Mustersynonyme .

Aber was ist mit Reißverschlüssen? Wie sollen wir zeigen, dass Mu bdas differenzierbar ist? Wir müssen zeigen, dass bdies in beiden Variablen differenzierbar ist. Klirren! Es ist Zeit, etwas über partielle Differenzierung zu lernen.

Partielle Derivate von Bifunktoren

Da wir zwei Variablen haben, müssen wir in der Lage sein, manchmal und einzeln zu anderen Zeiten gemeinsam darüber zu sprechen. Wir werden die Singleton-Familie brauchen:

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

Jetzt können wir sagen, was es für einen Bifunctor bedeutet, an jeder Variablen partielle Ableitungen zu haben, und den entsprechenden Begriff des Reißverschlusses angeben.

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}

Diese DOperation muss wissen, auf welche Variable abgezielt werden soll. Der entsprechende Reißverschluss gibt an Z b v, welche Variable vim Fokus stehen muss. Wenn wir "mit Kontext dekorieren", müssen wir x-elements mit X-contexts und y-elements mit Y-contexts dekorieren. Aber sonst ist es die gleiche Geschichte.

Wir haben noch zwei Aufgaben: Erstens, um zu zeigen, dass unser Bifunctor-Kit differenzierbar ist; zweitens, um zu zeigen, Diff2 bdass wir uns etablieren können Diff1 (Mu b).

Differenzierung des Bifunctor-Kits

Ich fürchte, dieses Stück ist eher fummelig als erbaulich. Fühlen Sie sich frei, um zu überspringen.

Die Konstanten sind wie zuvor.

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

Bei dieser Gelegenheit ist das Leben zu kurz, um die Theorie des Kronecker-Deltas auf Typebene zu entwickeln, deshalb habe ich die Variablen nur separat behandelt.

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

Für die strukturellen Fälle fand ich es nützlich, einen Helfer einzuführen, mit dem ich Variablen einheitlich behandeln kann.

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

Ich habe dann Gadgets gebaut, um die Art von "Retagging" zu ermöglichen, die wir für downund benötigen around. (Natürlich habe ich gesehen, welche Geräte ich während meiner Arbeit brauchte.)

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

Und wenn das Los fertig ist, können wir die Details herausarbeiten. Summen sind einfach.

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)

Produkte sind harte Arbeit, deshalb bin ich eher Mathematiker als Ingenieur.

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)

Konzeptionell ist es wie zuvor, aber mit mehr Bürokratie. Ich habe diese mithilfe der Pre-Type-Hole-Technologie erstellt, undefinedan Stellen, an denen ich nicht bereit war zu arbeiten, als Stub verwendet und an der Stelle (zu einem bestimmten Zeitpunkt), an der ich einen nützlichen Hinweis vom Typechecker erhalten wollte, einen absichtlichen Tippfehler eingeführt . Auch in Haskell können Sie die Typprüfung als Videospiel-Erfahrung durchführen.

Subknoten-Reißverschlüsse für rekursive Container

Die partielle Ableitung von bin Bezug auf Xsagt uns, wie man einen Unterknoten einen Schritt innerhalb eines Knotens findet, so dass wir den herkömmlichen Begriff des Reißverschlusses erhalten.

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

Wir können durch wiederholtes Einstecken von XPositionen bis zur Wurzel zoomen .

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

Aber wir brauchen Element -zippers.

Element-Reißverschlüsse für Fixpunkte von Bifunktoren

Jedes Element befindet sich irgendwo innerhalb eines Knotens. Dieser Knoten sitzt unter einem Stapel von XDerivaten. Die Position des Elements in diesem Knoten wird jedoch durch ein YDerivat angegeben. Wir bekommen

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
    }

Mutig, behaupte ich

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

Aber bevor ich die Operationen entwickle, brauche ich ein paar Kleinigkeiten.

Ich kann Daten zwischen Funktorreißverschlüssen und Bifunktorreißverschlüssen wie folgt tauschen:

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

Das reicht aus, um mich definieren zu lassen:

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

Das heißt, wir gehen nach oben, indem wir zuerst den Knoten wieder zusammensetzen, an dem sich das Element befindet, einen Elementreißverschluss in einen Unterknotenreißverschluss verwandeln und dann wie oben ganz herauszoomen.

Als nächstes sage ich

  downF  = yOnDown []

So beginnen Sie mit dem leeren Stapel und definieren die Hilfsfunktion, die downwiederholt von unterhalb eines Stapels ausgeführt wird:

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

Jetzt down bbringt uns nur noch in den Knoten. Die Reißverschlüsse, die wir benötigen, müssen auch den Kontext des Knotens tragen. Das contextualisemacht:

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)

Für jede YPosition müssen wir einen Element-Reißverschluss angeben, daher ist es gut, dass wir den gesamten Kontext dXsbis zur Wurzel kennen und wissen , dYwie sich das Element in seinem Knoten befindet. Für jede XPosition gibt es einen weiteren Teilbaum zu erkunden, also vergrößern wir den Stapel und machen weiter!

Damit bleibt nur die Verlagerung des Fokus. Wir könnten sitzen bleiben oder von dort, wo wir sind, hinuntergehen oder hinaufgehen oder hinauf und dann einen anderen Weg hinuntergehen. Hier geht.

  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

Wie immer wird das vorhandene Element durch den gesamten Reißverschluss ersetzt. Für den belowYTeil schauen wir uns an, wohin wir sonst im vorhandenen Knoten gehen können: Wir werden entweder alternative Elementpositionen Yoder weitere XUnterknoten finden, die wir untersuchen contextualisekönnen , also wir sie. Zum aboveYeinen müssen wir Xuns nach dem Zusammenbau des Knotens, den wir besucht haben , wieder auf den Stapel der Derivate vorarbeiten.

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

Bei jedem Schritt des Weges können wir entweder an einen anderen Ort abbiegen aroundoder weiter nach oben gehen.

Und das ist es! Ich habe keinen formellen Beweis für die Gesetze erbracht, aber es sieht für mich so aus, als ob die Operationen den Kontext beim Crawlen der Struktur sorgfältig korrekt beibehalten.

Was haben wir gelernt?

Differenzierbarkeit führt zu Vorstellungen von Dingen in ihrem Kontext, wodurch eine komonadische Struktur entsteht, in extractder Sie das Ding erhalten und duplicateden Kontext erkunden, um nach anderen Dingen zu suchen, die kontextualisiert werden können. Wenn wir die geeignete Differentialstruktur für Knoten haben, können wir eine Differentialstruktur für ganze Bäume entwickeln.

Oh, und es ist schrecklich, jede einzelne Arität eines Typkonstruktors einzeln zu behandeln. Der bessere Weg ist, mit Funktoren zwischen indizierten Sätzen zu arbeiten

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

wo wir overschiedene Arten von Strukturen herstellen, in denen iverschiedene Arten von Elementen gespeichert sind . Diese sind geschlossen unter dem Jacobi - Bau

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

Dabei ist jede der resultierenden (o, i)Strukturen eine partielle Ableitung, die Ihnen erklärt, wie Sie ein iElementloch in einer oStruktur erstellen. Aber das ist für ein anderes Mal abhängig getippter Spaß.

Die ComonadInstanz für Reißverschlüsse ist nicht

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

wo outOfund inTokommen von der DiffInstanz für Zipper tsich. Die obige Instanz verstößt gegen das ComonadGesetz fmap extract . duplicate == id. Stattdessen verhält es sich wie folgt:

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

Diff (Reißverschluss t)

Die DiffInstanz für Zipperwird bereitgestellt, indem sie als Produkte identifiziert und der Code für Produkte (unten) wiederverwendet werden.

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

Bei einem Isomorphismus zwischen Datentypen und einem Isomorphismus zwischen ihren Ableitungen können wir einen Typ inTound outOfden anderen wiederverwenden .

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

Für Typen, die nur newTypes für eine vorhandene DiffInstanz sind, sind ihre Ableitungen vom gleichen Typ. Wenn wir dem Typprüfer diese Typgleichheit mitteilen D r ~ D t, können wir dies nutzen, anstatt einen Isomorphismus für die Ableitungen bereitzustellen.

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

Ausgestattet mit diesen Tools können wir die DiffInstanz für die Implementierung von Produkten wiederverwendenDiff (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

Boilerplate

Um den hier vorgestellten Code tatsächlich verwenden zu können, benötigen wir einige Spracherweiterungen, Importe und eine Anpassung des vorgeschlagenen Problems.

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

Produkte, Summen und Konstanten

Die Diff (Zipper t)Instanz basiert auf Implementierungen von Difffor-Produkten :*:, Summen :+:, Konstanten Identityund Null 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

Bin Beispiel

Ich habe das BinBeispiel als Isomorphismus zu einer Summe von Produkten gestellt. Wir brauchen nicht nur seine Ableitung, sondern auch seine zweite Ableitung

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

Die Beispieldaten aus der vorherigen Antwort sind

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

Nicht die Comonad-Instanz

Das Binobige Beispiel liefert ein Gegenbeispiel zur fmap outOf . inTokorrekten Implementierung von duplicatefor Zipper t. Insbesondere liefert es ein Gegenbeispiel zum fmap extract . duplicate = idGesetz:

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

Was sich auswertet (beachten Sie, dass es Falseüberall voll von s ist, jeder Falsewürde ausreichen, um das Gesetz zu widerlegen)

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 aTreeist ein Baum mit der gleichen Struktur wie aTree, aber überall, wo es einen Wert gab, gibt es stattdessen einen Reißverschluss mit dem Wert und den Rest des Baums mit allen ursprünglichen Werten intakt. fmap (fmap extract . duplicate) . inTo $ aTreeist auch ein Baum mit der gleichen Struktur wie aTree, aber überall, wo es einen Wert gab, gibt es stattdessen einen Reißverschluss mit dem Wert, und der Rest des Baums, bei dem alle Werte durch denselben Wert ersetzt wurden . Mit anderen Worten:

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

Die komplette Test-Suite für alle drei ComonadGesetze, extract . duplicate == id, fmap extract . duplicate == id, und duplicate . duplicate == fmap duplicate . duplicateheißt

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

Bei einer unendlich differenzierbaren DiffKlasse:

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

aroundkann in Bezug auf die geschrieben werden upund downauf der Zipper‚s diff‘ s derivitive, im Wesentlichen wie

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

Das Zipper t abesteht aus a D t aund an a. Wir gehen downdie D t aein immer D t (Zipper (D t) a)in jedem Loch mit einem Reißverschluss. Diese Reißverschlüsse bestehen aus einem D (D t) aund dem a, das sich im Loch befand. Wir gehen zu upjedem von ihnen, holen uns einen D t aund vergleichen ihn mit dem a, der im Loch war. A D t aund a amachen a Zipper t a, geben uns ein D t (Zipper t a), was der Kontext ist, der für a benötigt wird Zipper t (Zipper t a).

Die ComonadInstanz ist dann einfach

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

Das Erfassen des DiffWörterbuchs des Derivats erfordert einige zusätzliche Installationen, die mit Data.Constraint oder in Bezug auf die in einer verwandten Antwort dargestellte Methode durchgeführt werden können

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