haskell - monadologia - monadas filosofia

Transformadores de mónada sin cremallera

Question

El paquete de streaming ofrece una función de 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

y una versión un poco más simplificada,

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

Estos se pueden adaptar muy fácilmente a FreeT del paquete free . Pero ese paquete ofrece otra versión del transformador de mónada gratuito:

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

También hay una tercera formulación (bastante simple):

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 }

Es posible realizar conversiones entre FreeT y FT o FF , lo que ofrece una manera indirecta de implementar zipsWith y sus parientes para FF y FT . Pero eso parece bastante insatisfactorio. Busco una solución más directa.

El problema parece estar relacionado con el desafío de comprimir las listas usando pliegues. Esto ha sido abordado en un artículo, Coroutining Folds with Hyperfunctions , por Launchbury et al, así como en una publicación de blog de Donnacha Kidney. Ninguno de estos es terriblemente simple, y no tengo idea de cómo podrían adaptarse a los contextos FT o FF .

Al analizar este problema, me di cuenta de que la streaming debería ofrecer algunas versiones más potentes. Lo más simple sería algo así como

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)

pero una opción más poderosa incluiría el resto:

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

Supongo que las zipsWith'''' no serían más difíciles que las zipsWith'' , pero que las zipsWithRemains pueden ser un desafío mayor en el contexto de FT o FF , ya que el resto probablemente tendrá que reconstituirse de alguna manera.

Nota

Ya que hubo cierta confusión anteriormente, permítame mencionar que no estoy buscando ayuda para escribir zipsWithRemains for Stream o FreeT ; Sólo estoy buscando ayuda con las funciones de FT y FF .

Answer 1

Aplicando un poco de Coyoneda a la respuesta de abacabadabacaba y haciendo malabarismos se obtiene una implementación que evita las restricciones de Functor f y Functor g . Si esos functores tienen fmap s caros, esto puede mejorar el rendimiento. Dudo que sea realmente mejor en situaciones típicas donde f y g son cosas como (,) a . También todavía no entiendo bien lo que esto hace.

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

Implementé zipsWith'' , zipsWith'''' y zipsWithRemains para FT . Mi implementación refleja fielmente la implementación de zipWith de esta publicación de blog .

En primer lugar, observe que, dados los zipsWith'' , la implementación de zipsWith'''' es trivial:

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)

Así que vamos a implementar zipsWith'' .

Comience con una versión expandida y anotada de zipWith con pliegues:

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)

Y convertirlo en 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

Aquí, se utilizan dos funciones auxiliares: effect y 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

Tenga en cuenta que el resultado podría ser cualquier mónada para la que se implementan estas funciones.

Para implementar zipsWithRemains , comience implementando zipWithRemains para los Foldable s comunes:

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)

Aquí, el resultado de un pliegue no es una función sino una tupla que contiene una función y un valor. Este último se utiliza para manejar el caso de "restos".

Esto también se puede adaptar a 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

¡Ojalá Haskell tuviera tipos locales!

Esto probablemente responde a la pregunta de FT . Respecto a FF : este tipo está diseñado de tal manera que para hacer cualquier cosa con él, primero debes convertirlo en otra mónada. Entonces, la pregunta es, ¿cuál? Es posible convertirlo a Stream o FreeT , y usar las funciones para esos tipos. También es posible convertirlo a FT y usar las implementaciones anteriores en él. ¿Hay una mónada más adecuada para implementar zipsWith ? Tal vez.