recursion_schemes

recursion_schemes copied to clipboard

Hello @vmchale Here my haskell version of monadic RS

type AlgebraM m f a = f a -> m a
type ParaAlgebraM m t a = Base t (t, a) -> m a
type CataM m t a = AlgebraM m (Base t) a -> t -> m a

paraM
  :: (Recursive t, Traversable (Base t), Monad m) =>
     ParaAlgebraM m t a -> t -> m a
paraM alg = alg <=< traverse(liftA2 (liftA2 (,)) return (paraM alg)) . project

apoM :: (Monad m, Traversable (Base t), Corecursive t) => (a -> m (Base t (Either t a))) -> a -> m t
apoM coalg = (return . embed) <=< traverse(either return (apoM coalg)) <=< coalg

anaM
  :: (Monad m, Traversable (Base t), Corecursive t)
  => (a -> m (Base t a)) -> a -> m t
anaM f = fmap embed . traverse (anaM f) <=< f

futuM :: (Corecursive t, Traversable (Base t), Monad m)
      => (a -> m (Base t (Free (Base t) a)))
      -> a
      -> m t
futuM coalg = anaM go . Pure
  where
    go (Pure a)  = coalg a
    go (Free fa) = return fa

hyloM
  :: (Monad m, Traversable t)
  => (t b -> m b) -> (a -> m (t a)) -> a -> m b
hyloM alg coalg = h
  where h = alg <=< traverse h <=< coalg

cataM
  :: (Monad f, Traversable (Base a), Recursive a) => CataM f a b
cataM f = (>>= f) . (traverse (cataM f)) . project

also interesting examples =)

dropWhileM' :: Monad m => (a -> m Bool) -> [a] -> m [a]
dropWhileM' p = para psi where
  psi = \case
    Nil -> return []
    Cons x (xs, ys) -> do
      flg <- p x
      case () of
        _ | flg -> ys
        _ -> return $ x:xs

takeWhileM' :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
takeWhileM' p = cata psi where
  psi = \case
    Nil -> return []
    Cons x xs -> do
      flg <- p x
      if flg then (x:) <$> xs else return []

insertByM' :: (Monad m) => (a -> a -> m Bool) -> a -> [a] -> m [a]
insertByM' cmp x = paraM psi where
 psi = \case
   Nil -> return [x]
   Cons y (xs, ys) -> (\flg -> return $ if flg then x:xs else y:ys) =<< cmp x y

sortByM :: (Monad m) => (a -> a -> m Bool) -> [a] -> m [a]
sortByM cmp = cataM psi where
  psi = \case
    Nil -> return []
    Cons x xs -> insertByM cmp x xs

filterM' :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
filterM' p = cataM psi where
  psi = \case
    Nil -> return []
    Cons x xs -> do
      flg <- p x
      return $ if flg then x:xs else xs

-- And nice examples for it

permutations' = sortByM (\_ _ -> [False, True])
subsequences' = filterM' (const [False, True])
inits' = takeWhileM' (const [False, True])
tails' = dropWhileM' (const [False, True])

Also metamorphism

meta :: (Recursive t, Corecursive c) => (a -> Base c a) -> (b -> a) -> (Base t b -> b) -> t -> c
meta f e g = ana f . e . cata g

ex1 :: [Int] -> [Int]
ex1 = meta f id g where
  g Nil = 0
  g (Cons x xs) = x + xs
  f n | n <= 0 = Nil
      | otherwise = Cons n (n - 1)

I have dyna and other implementation

Sounds good! I'll get to adding these when I'm less busy with work. Thanks for the issue!

@vmchale Also about zygoM I know about (maybe wrong) signature, but I cannot to implement it. So I think it should be

zygoM
  :: (Monad m, Traversable (Base a), Recursive a) =>
     (Base a b -> m b) -> (Base a (b, c) -> m c) -> a -> m c
zygoM = undefined

I tried to implement it in haskell but maybe I don't know how it should be correct

@vmchale Also oftop but maybe u can create some examples for it https://hackage.haskell.org/package/recursion-schemes-ext-0.1.0.1/docs/Data-Foldable-Functor-Extensions.html ?