web-dev-qa-db-ja.com

ジッパーComonads、一般的に

任意のコンテナタイプを考えると、（要素中心の）ジッパーを形成し、この構造がComonadであることがわかります。これは最近、次のタイプの 別のスタックオーバーフローの質問 で詳細に調査されました。

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

次のジッパー付き

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

ZipがComonadである場合は、そのインスタンスの構築が少し毛深いものです。とはいえ、ZipはTreeから完全に機械的に派生することができ、この方法で派生した型はすべて自動的にComonadであるため、そうである必要があると思いますこれらのタイプとそれらのコマンドを一般的かつ自動的に構築できること。

ジッパー構造の一般性を実現する1つの方法は、次のクラスとタイプファミリを使用することです

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

haskell CafeのスレッドとConal Elliottのブログに（ほぼ）表示されています。このクラスは、さまざまなコア代数型に対してインスタンス化できるため、ADTの派生物について話すための一般的なフレームワークを提供します。

だから、最終的に、私の質問は、私たちが書くことができるかどうかです

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

上記の特定のComonadインスタンスを組み込むために使用できます。

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

残念ながら、このようなインスタンスを作成することはできませんでした。 inTo/outOf署名で十分ですか？型を制限するために他に必要なものはありますか？このインスタンスは可能ですか？

haskellzipperderivingcomonad
80
J. Abrahamson

Chitty-Chitty-Bang-Bangのチャイルドキャッチャーのように、お菓子やおもちゃで子供たちを捕虜に誘います。偏微分について！」私も。私はあなたに警告しなかったと言ってはいけません。

別の警告があります。次のコードには_{-# LANGUAGE KitchenSink #-}_が必要です。

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

順不同。

微分可能なファンクターは、共通のジッパーを提供します

とにかく、微分可能なファンクターとは何ですか？

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

それはファンクタでもあり、派生物を持っています。これはファンクタでもあります。導関数は、elementの1ホールコンテキストを表します。ジッパータイプ_ZF f x_は、ワンホールコンテキストとホール内の要素のペアを表します。

_Diff1_の操作は、ジッパーで行うことができるナビゲーションの種類を説明します（「左向き」と「右向き」という概念はありません。これについては Clowns and Jokers paperを参照してください）。 「上」に進み、穴に要素を差し込むことで構造を再構築できます。 「下向き」に進み、give構造内の要素にアクセスするあらゆる方法を見つけることができます。すべての要素をそのコンテキストで装飾します。既存のジッパーを取り、各要素をそのコンテキストで装飾することにより、「回避」することができます。そのため、すべての再フォーカス方法（および現在のフォーカスを維持する方法）を見つけます。

さて、aroundFのタイプはあなたの何人かを思い出させるかもしれません

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

そして、あなたは思い出されるのは正しいです！ホップとスキップを使用して、

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

そして私たちはそれを主張します

_extract . duplicate == id
fmap extract . duplicate == id
duplicate . duplicate == fmap duplicate . duplicate
_

それも必要です

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

多項式ファンクターは微分可能です

定数ファンクタは微分可能です。

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

要素を配置する場所がないため、コンテキストを形成することは不可能です。 upFやdownFから行く場所はありません。downFに行く方法はどれもありません。

identityファンクタは微分可能です。

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

些細なコンテキストには1つの要素があり、downFはそれを見つけ、upFはそれを再パックし、aroundFは置くことしかできません。

Sumは微分可能性を保持します。

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

他の断片は、ほんの少しだけです。 downFに移動するには、タグ付きコンポーネント内にdownFを移動し、結果のジッパーを修正して、コンテキストでタグを表示する必要があります。

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

aroundFに移動するには、タグを削除し、タグなしのものを回避する方法を見つけて、結果のすべてのジッパーでタグを復元します。フォーカスされている要素xは、ジッパー全体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
_

ScopedTypeVariablesの再帰呼び出しを明確にするためにaroundFを使用しなければならなかったことに注意してください。型関数として、DFは単射ではないため、_f' :: D f x_が_f' :<-: x :: Z f x_を強制するには不十分です。

Productは微分可能性を保持します。

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

ペアの要素に焦点を合わせるには、左側に焦点を合わせて右側をそのままにするか、その逆を行います。ライプニッツの有名な製品ルールは、単純な空間的直感に対応しています！

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

現在、downFは合計の場合と同じように機能しますが、ジッパーコンテキストをタグ（どの方向に進むかを示すため）だけでなく、変更されていない他のコンポーネントでも修正する必要があります。

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

しかし、aroundFは大笑いです。現在どちらの側にアクセスしている場合でも、2つの選択肢があります。

  1. aroundFをその側に移動します。
  2. upFをその側から移動し、downFを反対側に移動します。

いずれの場合も、部分構造の操作を使用してから、コンテキストを修正する必要があります。

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

ふう！多項式はすべて微分可能であり、したがって、コモナドを与えます。

うーん。それは少し抽象的です。だから私は_deriving Show_をどこでも追加して、投げた

_deriving instance (Show (DF f x), Show x) => Show (ZF f x)
_

これにより、次の相互作用が可能になりました（手作業で調整）

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

Exercisechain ruleを使用して、微分可能なファンクターの構成が微分可能であることを示します。

甘い！今すぐ家に帰れますか？もちろん違います。まだ再帰構造を区別していません。

Bifunctorから再帰的なファンクターを作成する

Bifunctorは、データ型ジェネリックプログラミングに関する既存の文献（Patrik JanssonとJohan Jeuringの研究、またはJeremy Gibbonsの優れた講義ノートを参照）が、2種類のパラメーターに対応する2つのパラメーターを持つ型コンストラクターであると説明しています下部構造。両方を「マッピング」できるはずです。

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

Bifunctorsを使用して、再帰的なコンテナーのノード構造を提供できます。各ノードには、サブノードおよび要素があります。これらは、2種類のサブ構造になります。

_data Mu b y = In (b (Mu b y) y)
_

見る？ bの最初の引数に「再帰的な結び目を結び」、2番目の引数にパラメーターyを保持します。したがって、私たちは一度に取得します

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

これを使用するには、Bifunctorインスタンスのキットが必要です。

バイファンクターキット

定数は二機能です。

_newtype K a x y = K a

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

識別子が短いので、私はこのビットを最初に書いたと言うことができますが、コードが長いのでそれは良いことです。

変数はバイファンクションです。

いずれかのパラメーターに対応するbifunctorが必要なので、それらを区別するデータ型を作成し、適切なGADTを定義しました。

_data Var = X | Y

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

これにより、_V X x y_はxのコピーになり、_V Y x y_はyのコピーになります。したがって

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

SumsおよびbifunctorのProductはbifunctorです

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

これまでのところ、定型句ですが、今では次のようなものを定義できます

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

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

実際のデータにこれらのタイプを使用し、ジョルジュ・スーラの伝統的な点を盲目にしない場合は、pattern synonymsを使用します。

しかし、ジッパーはどうですか？ _Mu b_が微分可能であることをどのように示しますか？ bがboth変数で微分可能であることを示す必要があります。クラン！偏微分について学びましょう。

バイファンクターの偏微分

2つの変数があるため、それらを時々まとめて、また時には個別に話す必要があります。シングルトンファミリが必要です。

_data Vary :: Var -> * where
  VX :: Vary X
  VY :: Vary Y
_

Bifunctorが各変数に偏導関数を持ち、それに対応するジッパーの概念を与えることの意味を言うことができます。

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

このD操作では、ターゲットとする変数を知る必要があります。対応するジッパー_Z b v_は、どの変数vにフォーカスする必要があるかを示します。 「コンテキストで装飾する」ときは、x- contextsでX-- elementsを、y- contextsでY-- elementsを飾る必要があります。しかし、それ以外は同じ話です。

残りの2つのタスクがあります。まず、bifunctorキットが微分可能であることを示します。次に、_Diff2 b_を使用してDiff1 (Mu b)を確立できることを示します。

Bifunctorキットの差別化

このビットは、啓発的というよりは、いやらしいものだと思います。一緒にスキップしてください。

定数は以前と同じです。

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

この場合、型レベルのクロネッカーデルタの理論を開発するには寿命が短すぎるため、変数を個別に扱いました。

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

構造的なケースでは、変数を均一に処理できるヘルパーを導入すると便利です。

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

次に、downおよびaroundに必要な「再タグ付け」を容易にするガジェットを作成しました。 （もちろん、作業中に必要なガジェットを確認しました。）

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

準備が整ったら、詳細を確認できます。合計は簡単です。

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

製品は大変な仕事であるため、エンジニアではなく数学者です。

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

概念的には、以前と同じですが、官僚主義が強化されています。プレタイプホールテクノロジーを使用してこれらを構築し、undefinedをスタブとして使用する準備ができていなかった場所で使用し、意図したタイプエラーを1つの場所（いつでも）に導入しましたタイプチェッカーからの有用なヒント。 Haskellでも、ビデオゲーム体験として型チェックを行うことができます。

再帰コンテナ用のサブノードジッパー

bに関するXの偏微分は、ノード内の1ステップでサブノードを見つける方法を示しているため、従来のジッパーの概念が得られます。

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

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

ただし、element-zippersが必要です。

Bifunctorの固定点の要素ジッパー

各要素はノード内のどこかにあります。そのノードは、X-誘導体のスタックの下にあります。ただし、そのノード内の要素の位置はY-- derivativeによって指定されます。我々が得る

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

大胆に、私は主張します

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

しかし、操作を開発する前に、いくつかの断片が必要になります。

Functor-zippersとbifunctor-zippersの間で次のようにデータを交換できます。

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

これで定義できます：

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

つまり、最初に要素があるノードを再組み立てし、要素ジッパーをサブノードジッパーに変えてから、上記のようにズームアウトします。

次に、私は言う

_  downF  = yOnDown []
_

空のスタックから始めて、任意のスタックの下から繰り返しdownになるヘルパー関数を定義します。

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

これで、_down b_はノード内のみを取得します。必要なジッパーには、ノードのコンテキストも含める必要があります。それがcontextualiseが行うことです：

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

すべてのY- positionに対して、要素ジッパーを指定する必要があります。そのため、dXsだけでなく、ルートに戻るdYコンテキスト全体を知っていると便利です。要素がノードにどのように配置されるかを説明します。 X-の位置ごとに、探索するサブツリーがあります。そのため、スタックを拡大していきます。

それは焦点を変えるビジネスだけを残します。私たちは置かれたままになるか、私たちがいる場所から降りて行くか、上に行くか、または他の道を上ってから下に行くかもしれません。ここに行きます。

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

相変わらず、既存の要素はジッパー全体に置き換えられます。 belowY部分については、既存のノードのどこに行くことができるかを調べます。代替要素Y- positionsまたはさらに探索するX- subnodesを見つけます。 contextualiseそれら。 aboveY部分については、訪問していたノードを再構築した後、X-誘導体のスタックをバックアップする必要があります。

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

道の各ステップで、aroundである他の場所に曲がるか、上に向かっていくことができます。

以上です！私は法律の正式な証拠を提出していませんが、操作が構造をクロールする際にコンテキストを正しく維持しているように見えます。

私たちは何を学びましたか？

微分可能性は、コンテキスト内のものの概念を誘導し、extractがあなたに与え、duplicateがコンテキスト化する他のものを探してコンテキストを探索する、共通構造を誘導します。ノードに適切な微分構造があれば、ツリー全体の微分構造を作成できます。

ああ、タイプコンストラクターの個々のアリティを個別に扱うのはひどく恐ろしいです。より良い方法は、インデックス付きセット間でファンクターを使用することです

_f :: (i -> *) -> (o -> *)
_

oさまざまな種類の要素を格納するiさまざまな種類の構造を作成します。これらはヤコビアン構造の下でclosedです

_J f :: (i -> *) -> ((o, i) -> *)
_

ここで、それぞれの_(o, i)_- structuresは偏微分であり、i- structureにo- element-holeを作成する方法を示します。しかし、それはまた別の時間に依存して入力された楽しみです。

110
pigworker

ジッパーのComonadインスタンスはnotです

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

ここで、outOfおよびinToは、_Zipper t_自体のDiffインスタンスから取得されます。上記のインスタンスはComonad law _fmap extract . duplicate == id_に違反しています。代わりに、次のように動作します。

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

Diff（ジッパーt）

DiffのZipperインスタンスは、それらを製品として識別し、製品のコードを再利用することで提供されます（以下）。

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

データ型間の同型、およびそれらの派生間の同型を考えると、1つの型のinToとoutOfを他の型に再利用できます。

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

既存のDiffインスタンスの単なるnewTypesであるタイプの場合、それらの派生物は同じタイプです。型チェッカーにその型の等価性_D r ~ D t_を伝えると、導関数に同型を提供する代わりに、それを利用できます。

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

これらのツールを装備すると、Diff (Zipper t)を実装する製品のDiffインスタンスを再利用できます

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

ボイラープレート

ここに示されているコードを実際に使用するには、いくつかの言語拡張、インポート、および提案された問題の修正が必要です。

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

製品、合計、および定数

Diff (Zipper t)インスタンスは、製品_:*:_、合計_:+:_、定数Diff、およびゼロIdentityの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の例は、積の和の同型として提示しました。その派生物だけでなく、その二次派生物も必要です

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

前の回答 のサンプルデータは

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

Comonadインスタンスではない

上記のBinの例は、_fmap outOf . inTo_のduplicateの正しい実装である_Zipper t_の反例です。特に、それは_fmap extract . duplicate = id_法の反例を提供します：

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

評価される（Falsesがどこでもいっぱいであることに注意してください。Falseであれば、法に反するのに十分です）

_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_は、aTreeと同じ構造を持つツリーですが、値が存在するすべての場所に、その値を持つジッパーがあり、残りの元の値がすべて残っているツリーの残りの部分があります。 fmap (fmap extract . duplicate) . inTo $ aTreeも、aTreeと同じ構造を持つツリーですが、値がある場合は、代わりに値を持つジッパーがあり、ツリーの残りの部分はすべて同じ値で置き換えられた値。言い換えると：

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

3つのComonadのすべての法則、_extract . duplicate == id_、_fmap extract . duplicate == id_、および_duplicate . duplicate == fmap duplicate . duplicate_の完全なテストスイートは

_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

無限に微分可能なDiffクラスが与えられた場合：

_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は、upのdownの導関数上のZipperおよびdiffに関して記述できます。

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

_Zipper t a_は、_D t a_とaで構成されます。 downを_D t a_に移動し、すべての穴にジッパー付きのD t (Zipper (D t) a)を取得します。これらのジッパーは、D (D t) aと、穴にあったaで構成されています。それぞれupに行き、_D t a_を取得して、それを穴にあったaと比較します。 _D t a_とaは_Zipper t a_を作成し、D t (Zipper t a)を提供します。これはZipper t (Zipper t a)に必要なコンテキストです。

Comonadインスタンスは単純です

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

派生物のDiff辞書をキャプチャするには、追加の配管が必要です。これは、Data.Constraintを使用して、または 関連する回答で提示された方法

_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