56

タイプレベルのナチュラルの典型的な定義を使用して、n次元グリッドを定義しました。

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

data Nat = Z | S Nat

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

dmap :: (U n x -> U m r) -> U (S n) x -> U (S m) r
dmap f (Dimension ls mid rs) = Dimension (map f ls) (f mid) (map f rs)

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

今度はそれをコモナドのインスタンスにしたいのですが、脳を完全に包み込むことはできません。

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

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

instance Comonad (U n) where
  coreturn (Point x) = x
  coreturn (Dimension _ mid _) = coreturn mid

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

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

n次元グリッドで使用cojoinすると、n次元グリッドのn次元グリッドが生成されます。これと同じアイデアをインスタンスに提供したいと思います。つまり、(x、y、z)で結合されたグリッドのは、(x、y、z)にフォーカスされたグリッドある必要があります。そのコードを適応させるには、 「fmaps」と「rolls」を実行するために具象化する必要があるようです。あなたはそのようにそれをする必要はありませんが、それが助けになるなら、あなたはそこに行きます。nnn

4

3 に答える 3

53

ジャガー/リチャーズ:あなたはいつもあなたが望むものを手に入れることができるとは限りませんが、いつか試してみるとあなたはあなたがあなたが必要なものを手に入れることに気付くかもしれません。

リスト内のカーソル

snoc-およびcons-listを使用して構造のコンポーネントを再構築し、空間プロパティを明確に保ちます。私は定義します

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)

コモナドを作ろう

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

カーソルがコマンドであることを確認しましょう

instance Comonad Cursor where
  counit (Cur _ x _) = x
  cojoin c = Cur (lefts c) c (rights c) where
    lefts (Cur B0 _ _) = B0
    lefts (Cur (xz :< x) y ys) = lefts c :< c where c = Cur xz x (y :> ys)
    rights (Cur _ _ F0) = F0
    rights (Cur xz x (y :> ys)) = c :> rights c where c = Cur (xz :< x) y ys

あなたがこの種のものに目を向けているなら、あなたはそれCursorが空間的に楽しい変種であることに気付くでしょうInContext []

InContext f x = (x, ∂f x)

ここで、∂はファンクターの形式微分を取り、ワンホールコンテキストの概念を与えます。この回答で述べたように、InContext fは常にであり、ここにあるのは、フォーカスで要素を抽出し、各要素を独自のコンテキストで装飾して、リフォーカスされたカーソルでいっぱいのコンテキストを効果的に与える微分構造によって引き起こされるものです。カーソルを動かさずにフォーカスします。例を見てみましょう。ComonadComonadcounitcojoin

> cojoin (Cur (B0 :< 1) 2 (3 :> 4 :> F0))
Cur (B0 :< Cur B0 1 (2 :> 3 :> 4 :> F0))
    (Cur (B0 :< 1) 2 (3 :> 4 :> F0))
    (  Cur (B0 :< 1 :< 2) 3 (4 :> F0)
    :> Cur (B0 :< 1 :< 2 :< 3) 4 F0
    :> F0)

見る?フォーカスされている2は、cursor-at-2になるように装飾されています。左側には、cursor-at-1のリストがあります。右側には、cursor-at-3とcursor-at-4のリストがあります。

カーソルの作成、カーソルの転置?

さて、あなたが求めている構造Comonadは、のn倍の構成ですCursor。持ってみましょう

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

コモナドを説得fgて作曲するには、counitsはきちんと作曲しますが、「分配法則」が必要です。

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

だからあなたはcojoinこのような複合体を作ることができます

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

どのような法律がtranspose満たされるべきですか?おそらく次のようなもの

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

または、fとgのシーケンスをある順序から別の順序に移動する2つの方法で同じ結果が得られるようにするために必要なことは何でも。

transposeforCursorをそれ自体で定義できますか?ある種の移調を安価に取得する1つの方法は、それがzippilyBwdに適用可能であることに注意することです。したがって、そうです。FwdCursor

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

instance Applicative Fwd where
  pure x = x :> pure x
  (f :> fs) <*> (s :> ss) = f s :> (fs <*> ss)
  _ <*> _ = F0

instance Applicative Cursor where
  pure x = Cur (pure x) x (pure x)
  Cur fz f fs <*> Cur sz s ss = Cur (fz <*> sz) (f s) (fs <*> ss)

そして、ここであなたはネズミのにおいを嗅ぎ始めるべきです。形状の不一致により切り捨てが発生し、自己転置が自己逆であるという明らかに望ましい特性が損なわれます。どんな種類の不規則さも生き残れません。転置演算子を取得します:sequenceA、そして完全に通常のデータの場合、すべてが明るく美しいです。

> regularMatrixCursor
Cur (B0 :< Cur (B0 :< 1) 2 (3 :> F0))
          (Cur (B0 :< 4) 5 (6 :> F0))
          (Cur (B0 :< 7) 8 (9 :> F0) :> F0)
> sequenceA regularMatrixCursor
Cur (B0 :< Cur (B0 :< 1) 4 (7 :> F0))
          (Cur (B0 :< 2) 5 (8 :> F0))
          (Cur (B0 :< 3) 6 (9 :> F0) :> F0)

しかし、内側のカーソルの1つを位置合わせから外すだけでも(サイズを不規則にすることを気にしないでください)、問題が発生します。

> 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

外側のカーソル位置が1つで、内側のカーソル位置が複数ある場合、正常に動作する転置はありません。自己構成Cursorにより、内部構造を相互に不規則にすることができるため、いいえtranspose、いいえcojoin。あなたは定義することができます、そして私は定義しました

instance (Comonad f, Traversable f, Comonad g, Applicative g) =>
  Comonad (f :.: g) where
    counit = counit . counit . unC
    cojoin = C . fmap (fmap C . sequenceA) . cojoin . fmap cojoin . unC

しかし、内部構造を規則的に保つことは私たちの責任です。あなたがその負担を受け入れる気があるなら、あなたは繰り返すことができます。なぜならApplicative、そしてTraversableは作曲の下ですぐに閉じられるからです。ここに断片があります

instance (Functor f, Functor g) => Functor (f :.: g) where
  fmap h (C fgx) = C (fmap (fmap h) fgx)

instance (Applicative f, Applicative g) => Applicative (f :.: g) where
  pure = C . pure . pure
  C f <*> C s = C (pure (<*>) <*> f <*> s)

instance (Functor f, Foldable f, Foldable g) => Foldable (f :.: g) where
  fold = fold . fmap fold . unC

instance (Traversable f, Traversable g) => Traversable (f :.: g) where
  traverse h (C fgx) = C <$> traverse (traverse h) fgx

編集:完全を期すために、すべてが定期的である場合の動作は次のとおりです。

> cojoin (C regularMatrixCursor)
C {unC = Cur (B0 :< Cur (B0 :<
  C {unC = Cur B0 (Cur B0 1 (2 :> (3 :> F0))) (Cur B0 4 (5 :> (6 :> F0)) :> (Cur B0 7 (8 :> (9 :> F0)) :> F0))}) 
 (C {unC = Cur B0 (Cur (B0 :< 1) 2 (3 :> F0)) (Cur (B0 :< 4) 5 (6 :> F0) :> (Cur (B0 :< 7) 8 (9 :> F0) :> F0))})
 (C {unC = Cur B0 (Cur ((B0 :< 1) :< 2) 3 F0) (Cur ((B0 :< 4) :< 5) 6 F0 :> (Cur ((B0 :< 7) :< 8) 9 F0 :> F0))} :> F0))
(Cur (B0 :<
  C {unC = Cur (B0 :< Cur B0 1 (2 :> (3 :> F0))) (Cur B0 4 (5 :> (6 :> F0))) (Cur B0 7 (8 :> (9 :> F0)) :> F0)})
 (C {unC = Cur (B0 :< Cur (B0 :< 1) 2 (3 :> F0)) (Cur (B0 :< 4) 5 (6 :> F0)) (Cur (B0 :< 7) 8 (9 :> F0) :> F0)}) 
 (C {unC = Cur (B0 :< Cur ((B0 :< 1) :< 2) 3 F0) (Cur ((B0 :< 4) :< 5) 6 F0) (Cur ((B0 :< 7) :< 8) 9 F0 :> F0)} :> F0))
(Cur (B0 :<
  C {unC = Cur ((B0 :< Cur B0 1 (2 :> (3 :> F0))) :< Cur B0 4 (5 :> (6 :> F0))) (Cur B0 7 (8 :> (9 :> F0))) F0})
 (C {unC = Cur ((B0 :< Cur (B0 :< 1) 2 (3 :> F0)) :< Cur (B0 :< 4) 5 (6 :> F0)) (Cur (B0 :< 7) 8 (9 :> F0)) F0})
 (C {unC = Cur ((B0 :< Cur ((B0 :< 1) :< 2) 3 F0) :< Cur ((B0 :< 4) :< 5) 6 F0) (Cur ((B0 :< 7) :< 8) 9 F0) F0} :> F0)
:> F0)}

ハンコックのテンソル積

規則性のためには、作曲よりも強いものが必要です。「g-structures-all-the-same-shapeのf-structure」の概念を捉えることができる必要があります。これは、計り知れないピーター・ハンコックが「テンソル積」と呼んでいるものです。これを書きますf :><: g。すべての内側のg構造に共通する「外側」のf字型と「内側」のg字型が1つあるため、転置は簡単に定義できます。そして常に自己逆です。ハンコックのテンソルはHaskellで便利に定義できませんが、依存型の設定では、このテンソルを持つ「コンテナー」の概念を簡単に定式化できます。

あなたにアイデアを与えるために、コンテナの縮退した概念を考えてみましょう

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

ここで言うsのは「形」pのタイプと「位置」のタイプです。値は、形状の選択とx各位置でのストレージで構成されます。依存するケースでは、位置のタイプは形状の選択に依存する場合があります(たとえば、リストの場合、形状は数値(長さ)であり、その数の位置があります)。これらのコンテナにはテンソル積があります

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

これは一般化されたマトリックスのようなものです。形状のペアが寸法を示し、位置の各ペアに要素があります。との値を入力pしてp'依存する場合、これを完全にうまく行うことができます。これは、まさにハンコックによるコンテナのテンソル積の定義です。ss'

テンソル積のInContext

さて、あなたが高校で学んだかもしれないように、∂(s :<| p) = (s, p) :<| (p-1)どこp-1よりも要素が1つ少ないタイプがありpます。∂(sx ^ p)=(s p)* x ^(p-1)のように。1つの位置を選択して(図形に記録して)、削除します。障害は、p-1依存型なしで手に入れるのが難しいことです。ただし、位置を削除せずにInContext選択します。

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

これは従属ケースでも同様に機能し、喜んで取得します

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

InContext fこれは常にであることがわかります。これは、sのComonadテンソル積InContextはそれ自体がInContextsであるため、コモナティックであることを示しています。つまり、ディメンションごとに1つの位置を選択します(これにより、全体で1つの位置が得られます)。以前は、1つの外側の位置と多くの内側の位置がありました。テンソル積が構成に置き換わるため、すべてがうまく機能します。

ナペリア関手

Functorしかし、テンソル積と構成が一致するサブクラスがあります。これらは、次Functorのようなfものf () ~ ()です。つまり、とにかく形状が1つしかないため、構成内の不規則な値は最初から除外されます。これらFunctorはすべて、対数(与えるために累乗する必要のある指数)と考えることができる(p ->)いくつかの位置セットに対して同型です。それに対応して、ハンコックはジョン・ネイピア(その幽霊はハンコックが住んでいるエジンバラの一部に出没する)にちなんでこれらの関手を呼びます。pxf xNaperian

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

Naperianファンクターには対数があり、そこにある要素に位置をマッピングするイオン関数を誘導しますprojectNaperianファンクターはすべてzippilyApplicativepureあり<*>、プロジェクション用のKおよびSコンビネーターに対応しています。各位置にその位置の表現が格納されている値を作成することもできます。覚えているかもしれない対数の法則が喜んで現れます。

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

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

newtype (:*:) f g x = Pr (f x, g x) deriving Show

instance (Naperian f, Naperian g) => Naperian (f :*: g) where
  type Log (f :*: g) = Either (Log f) (Log g)
  project (Pr (fx, gx)) (Left p) = project fx p
  project (Pr (fx, gx)) (Right p) = project gx p
  positions = Pr (fmap Left positions, fmap Right positions)

固定サイズの配列(ベクトル)は、で与えられることに注意してください(Id :*: Id :*: ... :*: Id :*: One)。ここOneで、は定数単位の関手であり、その対数はVoidです。したがって、配列はNaperianです。今、私たちも持っています

instance (Naperian f, Naperian g) => Naperian (f :.: g) where
  type Log (f :.: g) = (Log f, Log g)
  project (C fgx) (p, q) = project (project fgx p) q
  positions = C $ fmap (\ p -> fmap (p ,) positions) positions

これは、多次元配列がであるということを意味しますNaperian

InContext fforのバージョンを作成するNaperian fには、位置をポイントするだけです。

data Focused f x = f x :@ Log f

instance Functor f => Functor (Focused f) where
  fmap h (fx :@ p) = fmap h fx :@ p

instance Naperian f => Comonad (Focused f) where
  counit (fx :@ p) = project fx p
  cojoin (fx :@ p) = fmap (fx :@) positions :@ p

したがって、特に、Focusedn次元配列は確かにcomonadになります。ベクトルはであるため、ベクトルの合成はn個のベクトルのテンソル積ですNaperian。ただし、Focusedn次元配列は、その次元を決定するn個のベクトルの合成ではなくn倍のテンソル積になります。Focusedこのコモナドをジッパーで表現するには、テンソル積を作成できる形で表現する必要があります。これは将来の演習として残しておきます。

于 2012-10-27T14:03:58.870 に答える
12

pigworkersの投稿とhttp://hackage.haskell.org/packages/archive/representable-functors/3.0.0.1/doc/html/Data-Functor-Representable.htmlに触発されたもう1つの試み。

キー(またはログ)がモノイドである場合、表現可能な(またはナペリアの)ファンクターはそれ自体がコモナドです!次にcoreturn、位置の値を取得しますmempty。そしてcojoin mappend、それが利用できる2つのキー。(のcomonadインスタンスと同じように(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リストが無限に長い場合は表現可能です。次に、形状は1つだけです。のキーはU nn個の整数のベクトルです。

type instance Key (U n) = UKey n

data UKey (n :: Nat) where
  P :: UKey Z
  D :: Integer -> UKey n -> UKey (S n)

instance Lookup (U n) where lookup = lookupDefault
instance Indexable (U n) where
  index (Point x) P = x
  index (Dimension ls mid rs) (D i k) 
    | i < 0 = index (ls `genericIndex` (-i - 1)) k
    | i > 0 = index (rs `genericIndex` ( i - 1)) k
    | otherwise = index mid k

パターンマッチする型の値がないため、Representableインスタンスを2つのケースに分割する必要があります。1つはfor Z、もう1つはforです。SU n

instance Representable (U Z) where
  tabulate f = Point (f P)
instance Representable (U n) => Representable (U (S n)) where
  tabulate f = Dimension 
    (map (\i -> tabulate (f . D (-i))) [1..]) 
    (tabulate (f . D 0))
    (map (\i -> tabulate (f . D   i)) [1..])

instance Monoid (UKey Z) where
  mempty = P
  mappend P P = P
instance Monoid (UKey n) => Monoid (UKey (S n)) where
  mempty = D 0 mempty
  mappend (D il kl) (D ir kr) = D (il + ir) (mappend kl kr)

そして、のキーU nは確かにモノイドであるためU n、表現可能なファンクターパッケージのデフォルトの実装を使用して、コモナドに変えることができます。

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

今回はいくつかのテストを行いました。

testVal :: U (S (S Z)) Int
testVal = Dimension 
  (repeat (Dimension (repeat (Point 1)) (Point 2) (repeat (Point 3))))
          (Dimension (repeat (Point 4)) (Point 5) (repeat (Point 6)))
  (repeat (Dimension (repeat (Point 7)) (Point 8) (repeat (Point 9))))

-- Hacky Eq instance, just for testing
instance Eq x => Eq (U n x) where
  Point a == Point b = a == b
  Dimension la a ra == Dimension lb b rb = take 3 la == take 3 lb && a == b && take 3 ra == take 3 rb

instance Show x => Show (U n x) where
  show (Point x) = "(Point " ++ show x ++ ")"
  show (Dimension l a r) = "(Dimension " ++ show (take 2 l) ++ " " ++ show a ++ " " ++ show (take 2 r) ++ ")"

test = 
  coreturn (cojoin testVal) == testVal && 
  fmap coreturn (cojoin testVal) == testVal && 
  cojoin (cojoin testVal) == fmap cojoin (cojoin testVal)
于 2012-10-27T16:44:15.040 に答える
2

したがって、これは間違っていることがわかります。誰かがそれを修正しようとする場合に備えて、ここに残しておきます。

この実装は、@pigworkerが提案した方法だと思います。コンパイルされますが、テストしていません。(私はhttp://blog.sigfpe.com/2006/12/evaluating-cellular-automata-is.htmlcojoin1から実装を取得しました)

{-# 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)
于 2012-10-27T12:02:28.810 に答える