Запись cojoin или cobind для n-мерного типа сетки


используя типичное определение естественных типов, я определил 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

теперь я хочу сделать его экземпляром Comonad, но я не могу полностью обернуть свой мозг вокруг него.

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

используя cojoin на n-мерной сетке будет получена n-мерная сетка из n-мерных сеток. Я хотел бы предоставить экземпляр с той же идеей, что и этот, что стоимостью из cojoined сетка в (x, y, z) должна быть оригинал решетки вопрос on (x,y,z). Чтобы адаптировать этот код, кажется, что нам нужно овеществить n для выполнения n "fmaps" и n "Роллс". Вы не должны делать это таким образом, но если это поможет, тогда вы идете.

3 56

3 ответа:

Джаггер / Ричардс: вы не всегда можете получить то, что вы хотите, но если вы попытаетесь когда-нибудь вы просто можете найти, что вы получаете то, что вам нужно.

курсоры в списках

позвольте мне перестроить компоненты вашей структуры, используя snoc-и cons-списки, чтобы сохранить пространственные свойства ясными. Я определяю

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 всегда a Comonad, как указано в ответ, и то, что мы имеем здесь именно это Comonad индуцируется дифференциальной структурой, где counit извлекает элемент в фокусе и cojoin украшает каждый элемент своим собственным контекстом, эффективно давая вам контекст, полный перефокусированных курсоров и с неподвижным курсором в его фокусе. Давайте приведем пример.

> 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 в фокусе был оформлен, чтобы стать курсором-на-2; слева, у нас есть список курсора-на-1; справа, список курсора-на-3 и курсора-на-4.

Создание Курсоров, Курсоры Транспонирование?

теперь, структура, которую вы просите быть Comonad - это N-кратная композиция Cursor. Давайте уже

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

чтобы убедить comonads f и g написать тег 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 из одного порядка в другой дают то же самое результат.

можем ли мы определить a transpose на Cursor сама с собой? Один из способов получить какую-то транспозицию дешево-это отметить, что Bwd и Fwd и zippily аппликативный, следовательно, так Cursor.

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

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

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

и тут вы должны понюхать крысу. Несоответствие формы приводит к усечение, и что собирается ломать, очевидно, желательно, свойство, которое самостоятельно транспонировать собственн-обратной. Никакой тряпки не будет выжить. Мы получаем оператор транспозиции: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)

но даже если я просто перемещаю один из внутренних курсоров из выравнивания (не говоря уже о том, чтобы сделать размеры рваными), все идет наперекосяк.

> 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

когда у вас есть одна внешняя позиция курсора и несколько внутренних позиций курсора, нет транспозиции, которая будет вести себя хорошо. Самостоятельного составления 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

Edit: для полноты картины, вот что он делает когда все регулярно,

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

тензорное произведение Хэнкока

для регулярности вам нужно что-то более сильное, чем композиция. Вы должны быть в состоянии захватить понятие "f-структура g-структур-все-же-форма". Это то, что неоценимый Питер Хэнкок называет "тензорным произведением", которое я напишу f :><: g: там один "внешний" Ф-образной формы и один "внутренний" Г-образной формы, общие для всех внутри G-структур, так транспозиции легко определима и всегда самообратных. Тензор Хэнкока не является удобно определяемым в Haskell, но в зависимо типизированной настройке легко сформулировать понятие "контейнер", который имеет этот тензор.

чтобы дать вам идею, рассмотрим вырожденное понятие контейнера

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

когда мы говорим s это тип "фигур" и p типа "позиции". Значение состоит из выбора формы и хранения x в каждой позиции. В зависимости от конкретного случая, типа позиции могут зависеть от выбора формы (например, для списков форма-это число (длина), и у вас есть столько позиций). Эти контейнеры имеют тензорное произведение

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

что похоже на обобщенную матрицу: пара фигур дает размеры, а затем у вас есть элемент в каждой паре позиций. Вы можете сделать это отлично, когда типы p и p' зависит от значения s и s', и это именно определение Хэнкока тензорное произведение контейнеров.

InContext для тензорных произведений

теперь, как вы, возможно, узнали в средней школе,∂(s :<| p) = (s, p) :<| (p-1) здесь p-1 это какой-то тип с меньшим количеством элементов, чем p. Как ∂(ыx^p) = (sp)*x^(p-1). Вы выбираете одну позицию (записываете ее в фигуру) и удаляете ее. Загвоздка в том, что p-1 сложно получить ваши руки без зависимых типов. Но InContext выбирает позицию без удаления это.

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

это работает так же хорошо для зависимого случая, и мы радостно приобретаем

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

теперь мы знаем, что InContext f всегда a Comonad, а это говорит нам, что тензорные произведения InContexts являются комонадическими, потому что они сами InContexts. то есть вы выбираете одну позицию для каждого измерения (и это дает вам ровно одну позицию во всем этом), где раньше у нас была одна внешняя позиция и много внутренних позиций. С тензорный продукт, заменяющий композицию, все работает сладко.

Naperian Функторы

но есть подкласс Functor для которого тензорное произведение и композиция совпадают. Это Functors f для чего f () ~ (): т. е. в любом случае есть только одна форма, поэтому в первую очередь исключаются рваные значения в композициях. Эти Functor s все изоморфны (p ->) на некоторые позиции товаров!--50--> что мы можем думать, как логарифм (показатель, к которому x должен быть поднят, чтобы дать f x). Соответственно, Хэнкок называет их Naperian функторы после Джона Нейпира (чей призрак преследует часть Эдинбурга, где живет Хэнкок).

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

A Naperian функтор имеет логарифм, индуцирующий a projectионная функция отображения позиций на элементы, найденные там. Naperian функторы все zippily Applicative С pure и <*> соответствует комбинаторам 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)

обратите внимание, что массив фиксированного размера (a вектор) определяется по формуле (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 f на 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

так, в частности, a Focused n-мерный массив действительно будет комонадой. Состав векторов является тензорным произведением n векторов, потому что векторы Naperian. Но это Focused n-мерный массив будет N-кратным тензорным произведением,не состав, п Focused векторов, которые определяют его размеры. Выразить это comonad с точки зрения застежек-молний, нам нужно будет выразить их в форме, которая позволяет построить тензорное произведение. Я оставлю это как упражнение на будущее.

еще одна попытка, вдохновленная сообщением pigworkers и http://hackage.haskell.org/packages/archive/representable-functors/3.0.0.1/doc/html/Data-Functor-Representable.html.

представимый (или Наперианский) функтор является самой комонадой, если ключ (или журнал) является моноидом! Тогда coreturn получает значение в позиции mempty. И cojoinmappends два ключа, которые он имеет в наличии. (Так же, как экземпляр 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 is представимо, если списки бесконечно длинны. Тогда есть только одна форма. Ключ от U n - вектор из n целых чисел.

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 экземпляр в двух случаях, один для Z и S, потому что у нас нет значения типа U 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)

Так что это оказывается неправильным. Я оставлю его здесь на случай, если кто-нибудь захочет его починить.

эта реализация является способом @pigworker предложил я думаю. Он компилируется, но я его не тестировал. (Я взял cojoin1 реализация от http://blog.sigfpe.com/2006/12/evaluating-cellular-automata-is.html)

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

data Nat = Z | S Nat

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

unPoint :: U Z x -> x
unPoint (Point x) = x

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

right, left :: U (S n) x -> U (S n) x
right (Dimension a b (c:cs)) = Dimension (b:a) c cs
left  (Dimension (a:as) b c) = Dimension as a (b:c)

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

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

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

instance Comonad (U n) where
  coreturn (Point x) = x
  coreturn (Dimension _ mid _) = coreturn mid
  cojoin (Point x) = Point (Point x)
  cojoin d@Dimension{} = fmap unlayer . unlayer . fmap dist . cojoin1 . fmap cojoin . layer $ d

dist :: U (S Z) (U n x) -> U n (U (S Z) x)
dist = layerUnder . unlayer

layerUnder :: U (S n) x -> U n (U (S Z) x)
layerUnder d@(Dimension _ Point{} _) = Point d
layerUnder d@(Dimension _ Dimension{} _) = dmap layerUnder d

unlayer :: U (S Z) (U n x) -> U (S n) x
unlayer = dmap unPoint

layer :: U (S n) x -> U (S Z) (U n x)
layer = dmap Point

cojoin1 :: U (S Z) x -> U (S Z) (U (S Z) x)
cojoin1 a = layer $ Dimension (tail $ iterate left a) a (tail $ iterate right a)