Is this some kind of morphism in the recursion-schemes?

Question

I implemented Euclid's algorithm in the following way at first.

euclid x 0 = x
euclid x y = euclid y (x `mod` y)

The algorithm is tail-recursion, and I expect that it can be intuitively written with recursion-schemes. Then, the following euc is an extract of the recursive part. This euclid function uses euc, while psi is devoted to one-step processing.

euc :: (a -> Either t a) -> a -> t
euc psi = either id (euc psi) . psi

euclid :: Integral a => a -> a -> a
euclid x y = euc psi (x, y)
  where psi (x, y) | m == 0    = Left  y
                   | otherwise = Right (y, m)
          where m = x `mod` y

The euc function looks like the apo morphism, but I don't know how to specialize apo to euc. It seems to me that they are completely different things. Is it possible to write euc as some kind of morphism in recursion-schemes?

apo :: Functor f => (t -> f (Either (Fix f) t)) -> t -> Fix f
apo psi = In . fmap (uncurry either (id, apo psi)) . psi

Regards.

Answer 1

I don't know if you can write it as an apomorphism, but I do see a way you can write it as a hylomorphism:

euc = hylo $ either id id

I also found a way to write it as an Elgot algebra:

import Data.Functor.Identity
euc psi = elgot runIdentity (fmap Identity . psi)

Answer 2

Either plays differents roles in your euc and in apo. You are using Left to signal a recursive base case, while apo uses Left to signal early termination of corecursion (that is, to add an extra condition for interrupting an unfold). If you want to express your algorithm using an unfold, though, there is no need for early termination, assuming an adequate structure to be unfolded:

{-# LANGUAGE TemplateHaskell, TypeFamilies, KindSignatures #-}
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-# LANGUAGE LambdaCase #-}
import Data.Functor.Foldable
import Data.Functor.Foldable.TH

data Delayed a = Done a | Waiting (Delayed a)
    deriving (Show)
makeBaseFunctor ''Delayed

ghci> :info DelayedF
data DelayedF a r = DoneF a | WaitingF r

psi :: Integral i => (i, i) -> DelayedF i (i, i)
psi (x, y) = case x `mod` y of
    0 -> DoneF y
    m -> WaitingF (y, m)

psi is a coalgebra for Delayed, and ana psi unfolds a Delayed structure with the GCD at its end:

ghci> delayedGCD = ana psi (14,35) :: Delayed Integer
ghci> delayedGCD
Waiting (Waiting (Done 7))

To get the final result, we have to consume the Delayed:

ghci> cata (\case { DoneF n -> n; WaitingF n -> n }) delayedGCD
7

Given we are doing an ana followed by a cata, we'd better switch to hylo, which efficiently combines them:

ghci> hylo (\case { DoneF n -> n; WaitingF n -> n }) psi (14,35)
7

At this point, we might note that DelayedF is isomorphic to Either. Since for our current purposes we only need hylo, as opposed to ana or cata in isolation, it is actually possible to replace DelayedF with Either and skip defining Delayed altogether (note the type of hylo doesn't mention the implied recursive data structure, only its corresponding base functor):

euclid :: Integral a => a -> a -> a
euclid x y = hylo (either id id) psi (x, y)
    where
    psi :: Integral i => (i, i) -> Either i (i, i)
    psi (x, y) = case x `mod` y of
        0 -> Left y
        m -> Right (y, m)

ghci> euclid 14 35
7

And thus we reach Joseph Sible's hylo solution, which works because Either is a base functor for a data structure that in some way materialises your recursive algorithm.

Answer 3

I came up with this solution using apomorphism: Using the Delayed structure from @duplode would probably make this code better.

gcd' x y = cata alg $ apo coalg (x, y)
  where
    alg NilF = 0
    alg (ConsF a b) = a + b
    coalg (a, b) = case a `mod` b of
                     0 -> ConsF b (Left (Fix NilF))
                     m -> ConsF 0 $ Right (b, m)