Молния монадой трансформаторов

Question

Пакет streaming предлагает a zipsWith функцию

zipsWith
  :: (Monad m, Functor h)
  => (forall x y. f x -> g y -> h (x, y))
  -> Stream f m r -> Stream g m r -> Stream h m r

и немного более обтекаемую версию,

zipsWith'
  :: Monad m
  => (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
  -> Stream f m r -> Stream g m r -> Stream h m r

Они могут быть адаптированы оченьлегко FreeT из пакета free.Но этот пакет предлагает другую версию бесплатного монадного трансформатора:

newtype FT f m a = FT
  { runFT
      :: forall r.
         (a -> m r)
      -> (forall x. (x -> m r) -> f x -> m r)
      -> m r }

Существует также третья (довольно простая) формулировка:

newtype FF f m a = FF
  { runFF
      :: forall n. Monad n
      => (forall x. f x -> n x)  -- A natural transformation
      -> (forall x. m x -> n x)  -- A monad morphism
      -> n a }

Возможноконвертировать туда и обратно между FreeT и FT или FF, что предлагает косвенный способ реализации zipsWith и его родственников для FF и FT.Но это кажется совершенно неудовлетворительным.Я ищу более прямое решение.

Проблема, похоже, связана с проблемой складывания списков с использованием складывания.Об этом говорится в статье Coroutining Folds с гиперфункциями , опубликованной Launchbury et al., А также в блоге Donnacha Kidney.Ни один из них не является ужасно простым, и я понятия не имею, как они могут быть адаптированы к контекстам FT или FF.

---

Когда я изучил эту проблему, я понял,что streaming действительно должен предлагать более мощные версии.Самым простым будет что-то вроде

zipsWith''
  :: Monad m
  => (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
  -> Stream f m r -> Stream g m s -> Stream h m (Either r s)

, но более мощный вариант будет включать остаток:

zipsWithRemains
  :: Monad m
  => (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
  -> Stream f m r
  -> Stream g m s
  -> Stream h m (Either (r, Stream g m s)
                        (f (Stream f m r), s))

Я бы предположил, что zipsWith'' будет не сложнее, чем zipsWith',но это zipsWithRemains может быть более сложной задачей в контексте FT или FF, поскольку, предположительно, остаток придется каким-то образом воссоздать.

Примечание

Поскольку были некоторыепутаница ранее, позвольте мне упомянуть, что я не ищу помощь в написании zipsWithRemains для Stream или FreeT;Я только ищу помощь с функциями на FT и FF.

Answer 1

Применение немного Coyoneda к ответа abacabadabacaba и выполнение некоторого жонглирования приводит к реализации, которая избегает ограничений Functor f и Functor g.Если эти функторы имеют дорогие fmap с, это может улучшить производительность.Я сомневаюсь, что на самом деле лучше в типичных ситуациях, когда f и g такие вещи, как (,) a.Я также до сих пор не совсем понимаю, что из этого получается.

type AFold f m r = m (RecFold f m r -> r)
newtype Fish f m r = Fish {unFish :: forall x. (x -> AFold f m r) -> f x -> r}
type BFold f m r = m (Fish f m r)
newtype RecFold f m r = RecFold { runRecFold :: BFold f m r }

zipsWith'
  :: forall f g h m r.
  Monad m
  => (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
  -> FT f m r
  -> FT g m r
  -> FT h m r
zipsWith' phi a b = loop af bf where
  af :: AFold f m (FT h m r)
  af = runFT a ai ac

  ai :: r -> AFold f m (FT h m r)
  ai r = return $ const $ return r

  ac :: (x -> AFold f m (FT h m r)) -> f x -> AFold f m (FT h m r)
  ac am ae = return $ (lift >=> \(Fish z) -> z am ae) . runRecFold

  bf :: BFold f m (FT h m r)
  bf = runFT b bi bc

  bi :: r -> BFold f m (FT h m r)
  bi r = return $ Fish $ \_ _ -> return r

  bc :: (x -> BFold f m (FT h m r)) -> g x -> BFold f m (FT h m r)
  bc bm be = return $ Fish $ \xa z -> wrap $ phi (\q -> loop (xa q) . bm) z be

  loop :: AFold f m (FT h m r) -> BFold f m (FT h m r) -> FT h m r
  loop av bv = lift av >>= ($ (RecFold bv))

Answer 2

Я реализовал zipsWith', zipsWith'' и zipsWithRemains для FT.Моя реализация близко отражает реализацию zipWith из этого сообщения в блоге .

Во-первых, обратите внимание, что, учитывая zipsWith', реализация zipsWith'' тривиальна:

zipsWith''
  :: (Functor f, Functor g, Monad m)
  => (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
  -> FT f m r
  -> FT g m s
  -> FT h m (Either r s)
zipsWith'' phi a b = zipsWith' phi (Left <$> a) (Right <$> b)

Итак, давайте реализуем zipsWith'.

Начнем с развернутой и аннотированной версии zipWith, используя складки:

newtype RecFold a r = RecFold { runRecFold :: BFold a r }
type AFold a r = RecFold a r -> r
type BFold a r = a -> AFold a r -> r

zipWith
  :: forall f g a b c.
  (Foldable f, Foldable g)
  => (a -> b -> c)
  -> f a
  -> g b
  -> [c]
zipWith c a b = loop af bf where
  af :: AFold a [c]
  af = foldr ac ai a
  ai :: AFold a [c]
  ai _ = []
  ac :: a -> AFold a [c] -> AFold a [c]
  ac ae ar bl = runRecFold bl ae ar
  bf :: BFold a [c]
  bf = foldr bc bi b
  bi :: BFold a [c]
  bi _ _ = []
  bc :: b -> BFold a [c] -> BFold a [c]
  bc be br ae ar = c ae be : loop ar br
  loop :: AFold a [c] -> BFold a [c] -> [c]
  loop al bl = al (RecFold bl)

И превратив ее в zipsWith':

newtype RecFold f m r = RecFold { runRecFold :: BFold f m r }
type AFold f m r = m (RecFold f m r -> r)
type BFold f m r = m (f (AFold f m r) -> r)

zipsWith'
  :: forall f g h m r.
  (Monad m, Functor f, Functor g)
  => (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
  -> FT f m r
  -> FT g m r
  -> FT h m r
zipsWith' phi a b = loop af bf where
  af :: AFold f m (FT h m r)
  af = runFT a ai ac
  ai :: r -> AFold f m (FT h m r)
  ai r = return $ const $ return r
  ac :: (x -> AFold f m (FT h m r)) -> f x -> AFold f m (FT h m r)
  ac am ae = return $ effect . fmap ($ (fmap am ae)) . runRecFold
  bf :: BFold f m (FT h m r)
  bf = runFT b bi bc
  bi :: r -> BFold f m (FT h m r)
  bi r = return $ const $ return r
  bc :: (x -> BFold f m (FT h m r)) -> g x -> BFold f m (FT h m r)
  bc bm be = return $ wrap . flip (phi loop) (fmap bm be)
  loop :: AFold f m (FT h m r) -> BFold f m (FT h m r) -> FT h m r
  loop av bv = effect $ fmap ($ (RecFold bv)) av

Здесь используются две вспомогательные функции: effect и wrap.

effect :: Monad m => m (FT f m r) -> FT f m r
effect m = FT $ \hr hy -> m >>= \r -> runFT r hr hy

wrap :: f (FT f m r) -> FT f m r
wrap s = FT $ \hr hy -> hy (\v -> runFT v hr hy) s

Обратите внимание, что результатом может быть любая монада, для которой эти функции реализованы.

Чтобы реализовать zipsWithRemains, начните с реализации zipWithRemains для обычных Foldable s:

data ListWithTail a b = Nil b | Cons a (ListWithTail a b)
type Result a b c = ListWithTail c (Either [b] (a, [a]))
newtype RecFold a b c = RecFold { runRecFold :: BFold a b c }
type AFold a b c = (RecFold a b c -> Result a b c, [a])
type BFold a b c = (a -> AFold a b c -> Result a b c, [b])

zipWithRemains
  :: forall f g a b c.
  (Foldable f, Foldable g)
  => (a -> b -> c)
  -> f a
  -> g b
  -> Result a b c
zipWithRemains c a b = loop af bf where
  af :: AFold a b c
  af = foldr ac ai a
  ai :: AFold a b c
  ai = (\bl -> Nil $ Left $ snd (runRecFold bl), [])
  ac :: a -> AFold a b c -> AFold a b c
  ac ae ar = (\bl -> fst (runRecFold bl) ae ar, ae : snd ar)
  bf :: BFold a b c
  bf = foldr bc bi b
  bi :: BFold a b c
  bi = (\ae ar -> Nil $ Right (ae, snd ar), [])
  bc :: b -> BFold a b c -> BFold a b c
  bc be br = (\ae ar -> Cons (c ae be) (loop ar br), be : snd br)
  loop :: AFold a b c -> BFold a b c -> Result a b c
  loop al bl = fst al (RecFold bl)

Здесь результатом сгиба является не функция, а 2-кортеж, содержащий функцию иценность.Последний используется для обработки «остатков».

Это также можно адаптировать к FT:

type Result f g h m r s = FT h m (Either (r, FT g m s) (f (FT f m r), s))
newtype RecFold f g h m r s = RecFold { runRecFold :: BFold f g h m r s }
type AFold f g h m r s = m (RecFold f g h m r s -> Result f g h m r s, FT f m r)
type BFold f g h m r s = m (f (AFold f g h m r s) -> Result f g h m r s, FT g m s)

zipsWithRemains
  :: forall f g h m r s.
  (Monad m, Functor f, Functor g)
  => (forall x y p. (x -> y -> p) -> f x -> g y -> h p)
  -> FT f m r
  -> FT g m s
  -> Result f g h m r s
zipsWithRemains phi a b = loop af bf where
  af :: AFold f g h m r s
  af = runFT a ai ac
  ai :: r -> AFold f g h m r s
  ai r = return (return . Left . (r,) . effect . fmap snd . runRecFold, return r)
  ac :: (x -> AFold f g h m r s) -> f x -> AFold f g h m r s
  ac am ae = return (effect . fmap (($ (fmap am ae)) . fst) . runRecFold, wrap $ fmap (effect . fmap snd . am) ae)
  bf :: BFold f g h m r s
  bf = runFT b bi bc
  bi :: s -> BFold f g h m r s
  bi r = return (return . Right . (,r) . fmap (effect . fmap snd), return r)
  bc :: (x -> BFold f g h m r s) -> g x -> BFold f g h m r s
  bc bm be = return (wrap . flip (phi loop) (fmap bm be), wrap $ fmap (effect . fmap snd . bm) be)
  loop :: AFold f g h m r s -> BFold f g h m r s -> Result f g h m r s
  loop av bv = effect $ fmap (($ (RecFold bv)) . fst) av

Я бы хотел, чтобы у Haskell были локальные типы!

Это, вероятно, отвечает на вопрос FT.Относительно FF: этот тип разработан так, что для того, чтобы что-то с ним сделать, сначала нужно преобразовать его в какую-нибудь другую монаду.Итак, вопрос в том, какой?Можно преобразовать его в Stream или FreeT и использовать функции для этих типов.Также возможно преобразовать это в FT и использовать вышеупомянутые реализации на нем.Есть ли монада, лучше подходящая для реализации zipsWith?Может быть.