Запись 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 ответа:
Джаггер / Ричардс: вы не всегда можете получить то, что вы хотите, но если вы попытаетесь когда-нибудь вы просто можете найти, что вы получаете то, что вам нужно.
курсоры в списках
позвольте мне перестроить компоненты вашей структуры, используя 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
всегда aComonad
, как указано в ответ, и то, что мы имеем здесь именно это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
написать тегcounit
s сочиняют аккуратно, но вам нужен "распределительный закон"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
всегда aComonad
, а это говорит нам, что тензорные произведенияInContext
s являются комонадическими, потому что они самиInContext
s. то есть вы выбираете одну позицию для каждого измерения (и это дает вам ровно одну позицию во всем этом), где раньше у нас была одна внешняя позиция и много внутренних позиций. С тензорный продукт, заменяющий композицию, все работает сладко.Naperian Функторы
но есть подкласс
Functor
для которого тензорное произведение и композиция совпадают. ЭтоFunctor
sf
для чего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
функтор имеет логарифм, индуцирующий aproject
ионная функция отображения позиций на элементы, найденные там.Naperian
функторы все zippilyApplicative
С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
. Иcojoin
mappend
s два ключа, которые он имеет в наличии. (Так же, как экземпляр 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)