Обход с биаппликацией

Question

Обход с биаппликацией

Я размышлял об операциях с молнией и понял, что одним из способов их выражения является переход в Biapplicative функтор.

import Data.Biapplicative

class Traversable2 t where
  traverse2 :: Biapplicative p
            => (a -> p b c) -> t a -> p (t b) (t c)

-- Note: sequence2 :: [(a,b)] -> ([a], [b])
sequence2 :: (Traversable2 t, Biapplicative p)
          => t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id

instance Traversable2 [] where
  traverse2 _ [] = bipure [] []
  traverse2 f (x : xs) = bimap (:) (:) (f x) <<*>> traverse2 f xs

Пахнет для меня, как будто каждый экземпляр Traversable может быть механически преобразован в экземпляр Traversable2, Но я еще не нашел способ реально реализовать traverse2 с помощью traverse Если не считать конвертации в списки и из списков или, возможно, играть очень грязные трюки с unsafeCoerce, Есть хороший способ сделать это?

Еще одно доказательство того, что что-нибудь Traversable является Traversable2:

class (Functor t, Foldable t) => Traversable2 t where
  traverse2 :: Biapplicative p
            => (a -> p b c) -> t a -> p (t b) (t c)
  default traverse2 ::
               (Biapplicative p, Generic1 t, GTraversable2 (Rep1 t))
            => (a -> p b c) -> t a -> p (t b) (t c)
  traverse2 f xs = bimap to1 to1 $ gtraverse2 f (from1 xs)

class GTraversable2 r where
  gtraverse2 :: Biapplicative p
             => (a -> p b c) -> r a -> p (r b) (r c)

instance GTraversable2 V1 where
  gtraverse2 _ x = bipure (case x of) (case x of)

instance GTraversable2 U1 where
  gtraverse2 _ _ = bipure U1 U1

instance GTraversable2 t => GTraversable2 (M1 i c t) where
  gtraverse2 f (M1 t) = bimap M1 M1 $ gtraverse2 f t

instance (GTraversable2 t, GTraversable2 u) => GTraversable2 (t :*: u) where
  gtraverse2 f (t :*: u) = bimap (:*:) (:*:) (gtraverse2 f t) <<*>> gtraverse2 f u

instance (GTraversable2 t, GTraversable2 u) => GTraversable2 (t :+: u) where
  gtraverse2 f (L1 t) = bimap L1 L1 (gtraverse2 f t)
  gtraverse2 f (R1 t) = bimap R1 R1 (gtraverse2 f t)

instance GTraversable2 (K1 i c) where
  gtraverse2 f (K1 x) = bipure (K1 x) (K1 x)

instance (Traversable2 f, GTraversable2 g) => GTraversable2 (f :.: g) where
  gtraverse2 f (Comp1 x) = bimap Comp1 Comp1 $ traverse2 (gtraverse2 f) x

instance Traversable2 t => GTraversable2 (Rec1 t) where
  gtraverse2 f (Rec1 xs) = bimap Rec1 Rec1 $ traverse2 f xs

instance GTraversable2 Par1 where
  gtraverse2 f (Par1 p) = bimap Par1 Par1 (f p)

18

haskell traversal bifunctor

Источник

user1477667 12 янв '18 в 06:49

4 ответа

Решение

Я думаю, у меня может быть что-то, что соответствует вашему счету. (Правка: это не так, см. Комментарии.) Вы можете определить новые типы поверх p () c а также p b () и сделать их Functor экземпляров.

Реализация

Вот ваш класс снова с определениями по умолчанию. Я пошел по пути реализации sequence2 с точки зрения sequenceA потому что это казалось проще.

class Functor t => Traversable2 t where
  {-# MINIMAL traverse2 | sequence2 #-}
  traverse2 :: Biapplicative p => (a -> p b c) -> t a -> p (t b) (t c)
  traverse2 f = sequence2 . fmap f

  sequence2 :: Biapplicative p => t (p b c) -> p (t b) (t c)
  sequence2 = traverse2 id

Теперь "правая часть" Biapplicative является

newtype R p c = R { runR :: p () c }

instance Bifunctor p => Functor (R p) where
  fmap f (R x) = R $ bimap id f x

instance Biapplicative p => Applicative (R p) where
  pure x = R (bipure () x)
  R f <*> R x =
    let f' = biliftA2 const (flip const) (bipure id ()) f
    in  R $ f' <<*>> x

mkR :: Biapplicative p => p b c -> R p c
mkR = R . biliftA2 const (flip const) (bipure () ())

sequenceR :: (Traversable t, Biapplicative p) => t (p b c) -> p () (t c)
sequenceR = runR . sequenceA . fmap mkR

с "левой частью" почти то же самое. Полный код в этой сути.

Теперь мы можем сделать p (t b) () а также p () (t c) и собрать их в p (t b) (t c),

instance (Functor t, Traversable t) => Traversable2 t where
  sequence2 x = biliftA2 const (flip const) (sequenceL x) (sequenceR x)

Мне нужно было включить FlexibleInstances и UndecidableInstances для этого объявления экземпляра. Кроме того, так или иначе, GHC хотел, чтобы Functor содержал.

тестирование

Я проверил ваш экземпляр для [] что он дает те же результаты:

main :: IO ()
main = do
  let xs = [(x, ord x - 97) | x <- ['a'..'g']]
  print xs
  print (sequence2 xs)
  print (sequence2' xs)

traverse2' :: Biapplicative p => (a -> p b c) -> [a] -> p [b] [c]
traverse2' _ [] = bipure [] []
traverse2' f (x : xs) = bimap (:) (:) (f x) <<*>> traverse2 f xs

sequence2' :: Biapplicative p => [p b c] -> p [b] [c]
sequence2' = traverse2' id

выходы

[('a',0),('b',1),('c',2),('d',3),('e',4),('f',5),('g',6)]
("abcdefg",[0,1,2,3,4,5,6])
("abcdefg",[0,1,2,3,4,5,6])

Это было забавное упражнение!

3

Источник

user1726797 15 янв '18 в 19:44

Несколько замечаний, за исключением полного оригинального ответа.

Если у тебя есть Biapplicative бифунктор, что вы можете сделать с ним, это применить его к чему-то и разделить его на пару бифункторов, изоморфных его двум компонентам.

data Helper w a b = Helper {
  left :: w a (),
  right :: w () b
}

runHelper :: forall p a b. Biapplicative p => Helper p a b -> p a b
runHelper x = biliftA2 const (flip const) (left x) (right x)

makeHelper :: (Biapplicative p)
           => p a b -> Helper p a b
makeHelper w = Helper (bimap id (const ()) w)
                      (bimap (const ()) id w)

type Separated w a b = (w a (), w () b)

Можно было бы объединить подходы @nnnmmm и @leftroundabout, применив fmap (makeHelper . f) к структуре s, устраняя необходимость undefined, но тогда вам нужно будет сделать Helper или его замена instance некоторого класса типов с полезными операциями, которые позволяют вам решить проблему.

Если у тебя есть Traversable структура, что вы можете сделать, это sequenceAApplicative функторы (в этом случае ваше решение будет выглядеть traverse2 f = fromHelper . sequenceA . fmap (makeHelper . f), где твой Applicative Экземпляр строит пару t структуры) или traverse это с помощью Functor (в этом случае ваше решение будет выглядеть traverse2 f = fromHelper . traverse (g . makeHelper . f) where...). В любом случае, вам нужно определить Functor экземпляр, так как Applicative наследуется от Functor, Вы можете попытаться построить свой Functor от <<*>> а также bipure id id, или же bimapили вы можете работать с обеими разделенными переменными за один проход.

К сожалению, чтобы заставить типы работать на Functor Например, вы должны параматизировать :: p b c к типу мы бы неофициально назвать :: w (b,c) где один параметр является декартовым произведением двух параметров p, Система типов в Haskell, похоже, не позволяет этого без нестандартных расширений, но @leftroundabout умело справляется с этим с помощью Bimock учебный класс. с помощью undefined заставить оба разделенных функтора иметь одинаковый тип.

Что касается производительности, то вы хотите сделать не более одного обхода, который производит объект, изоморфный p (t b) (t c) что вы можете затем преобразовать (аналогично закону естественности). Поэтому вы хотите реализовать traverse2 скорее, чем sequence2 и определить sequence2 как traverse2 id, чтобы избежать обхода дважды. Если вы разделяете переменные и производите что-то изоморфное (p (t b) (), p () (t c))Вы можете затем рекомбинировать их как @mmmnnn.

Я подозреваю, что при практическом использовании вы захотите наложить некоторую дополнительную структуру на проблему. Ваш вопрос сохранил компоненты b а также c из Bifunctor полностью свободны, но на практике они обычно будут либо ковариантными, либо контравариантными функторами, которые можно упорядочить с biliftA2 или пройдены вместе через Bitraversable скорее, чем Traversabletили, возможно, даже есть Semigroup, Applicative или же Monad пример.

Особенно эффективная оптимизация была бы, если ваш p изоморфен Monoid чья <> операция создает структуру данных, изоморфную вашей t, (Это работает для списков и двоичных деревьев; Data.ByteString.Builder является алгебраическим типом, обладающим этим свойством.) В этом случае ассоциативность операции позволяет преобразовать структуру либо в строгую левую, либо в ленивую правую складку.

Это был отличный вопрос, и хотя у меня нет лучшего кода, чем @leftroundabout для общего случая, я многому научился, работая над ним.

2

Источник

user4474419 22 янв '18 в 20:55

Следующее, кажется, делает трюк, используя "только" undefined, Возможно, проходимые законы гарантируют, что это нормально, но я не пытался это доказать.

{-# LANGUAGE GADTs, KindSignatures, TupleSections #-}

import Data.Biapplicative

import Data.Traversable

data Bimock :: (* -> * -> *) -> * -> * where
   Bimock :: p a b -> Bimock p (a,b)
   Bimfmap :: ((a,b) -> c) -> p a b -> Bimock p c
   Bimpure :: a -> Bimock p a
   Bimapp :: Bimock p ((a,b) -> c) -> p a b -> Bimock p c

instance Functor (Bimock p) where
  fmap f (Bimock p) = Bimfmap f p
  fmap f (Bimfmap g p) = Bimfmap (f . g) p
  fmap f (Bimpure x) = Bimpure (f x)
  fmap f (Bimapp gs xs) = Bimapp (fmap (f .) gs) xs
instance Biapplicative p => Applicative (Bimock p) where
  pure = Bimpure
  Bimpure f<*>xs = fmap f xs
  fs<*>Bimpure x = fmap ($x) fs
  fs<*>Bimock p = Bimapp fs p
  Bimfmap g h<*>Bimfmap i xs = Bimfmap (\(~(a₁,a₂),~(b₁,b₂)) -> g (a₁,b₁) $ i (a₂, b₂))
                              $ bimap (,) (,) h<<*>>xs
  Bimapp g h<*>xs = fmap uncurry g <*> ((,)<$>Bimock h<*>xs)

runBimock :: Biapplicative p => Bimock p (a,b) -> p a b
runBimock (Bimock p) = p
runBimock (Bimfmap f p) = bimap (fst . f . (,undefined)) (snd . f . (undefined,)) p
runBimock (Bimpure (a,b)) = bipure a b
runBimock (Bimapp (Bimpure f) xs) = runBimock . fmap f $ Bimock xs
runBimock (Bimapp (Bimfmap h g) xs)
     = runBimock . fmap (\(~(a₂,a₁),~(b₂,b₁)) -> h (a₂,b₂) (a₁,b₁))
           . Bimock $ bimap (,) (,) g<<*>>xs
runBimock (Bimapp (Bimapp h g) xs)
     = runBimock . (fmap (\θ (~(a₂,a₁),~(b₂,b₁)) -> θ (a₂,b₂) (a₁,b₁)) h<*>)
           . Bimock $ bimap (,) (,) g<<*>>xs

traverse2 :: (Biapplicative p, Traversable t) => (a -> p b c) -> t a -> p (t b) (t c)
traverse2 f s = runBimock . fmap (\bcs->(fmap fst bcs, fmap snd bcs)) $ traverse (Bimock . f) s


sequence2 :: (Traversable t, Biapplicative p)
          => t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id

И даже если это безопасно, я не удивлюсь, если он даст ужасную производительность, что с неопровержимыми образцами и квадратичным (или даже экспоненциальным?) Наращиванием дерева кортежей.

2

Источник

user745903 15 янв '18 в 23:59

Другие вопросы по тегам haskell traversal bifunctor

user1477667 01 мар '18 в 09:22 2018-03-01 09:22 · Accepted Answer · 2018-03-01 09:22

Один только слегка злой способ сделать это, используя что-то вроде Magma от lens, Это кажется значительно проще, чем оставленное вокруг решение, хотя и не красиво.

data Mag a b t where
  Pure :: t -> Mag a b t
  Map :: (x -> t) -> Mag a b x -> Mag a b t
  Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
  One :: a -> Mag a b b

instance Functor (Mag a b) where
  fmap = Map

instance Applicative (Mag a b) where
  pure = Pure
  (<*>) = Ap

traverse2 :: forall t a b c f. (Traversable t, Biapplicative f)
          => (a -> f b c) -> t a -> f (t b) (t c)
traverse2 f0 xs0 = go m m
  where
    m :: Mag a x (t x)
    m = traverse One xs0

    go :: forall x y. Mag a b x -> Mag a c y -> f x y
    go (Pure t) (Pure u) = bipure t u
    go (Map f x) (Map g y) = bimap f g (go x y)
    go (Ap fs xs) (Ap gs ys) = go fs gs <<*>> go xs ys
    go (One x) (One y) = f0 x
    go _ _ = error "Impossible"