Is it possible to compare two trees with recursion schemes?

Question

I have this AST

data ExprF r = Const Int | Add   r r
type Expr = Fix ExprF

and I want to compare

x = Fix $ Add (Fix (Const 1)) (Fix (Const 1))
y = Fix $ Add (Fix (Const 1)) (Fix (Const 2))

But all recursion schemes functions seems to work only with single structure

Obviously I can use recursion

eq (Fix (Const x)) (Fix (Const y)) = x == y
eq (Fix (Add x1 y1)) (Fix (Add x2 y2)) = (eq x1 x2) && (eq y1 y2)
eq _ _ = False

But I hope it is possible to use some sort of zipfold function.

Answer 1

Recursion schemes that act on a single argument are enough, because we can return a function from a scheme application. In this case, we can return an Expr -> Bool function from a scheme application on Expr. For efficient equality checking we only need paramorphisms:

{-# language DeriveFunctor, LambdaCase #-}

newtype Fix f = Fix (f (Fix f))
data ExprF r = Const Int | Add r r deriving (Functor, Show)
type Expr = Fix ExprF

cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = go where go (Fix ff) = f (go <$> ff)

para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
para f (Fix ff) = f ((\x -> (x, para f x)) <$> ff)

eqExpr :: Expr -> Expr -> Bool
eqExpr = cata $ \case
  Const i -> cata $ \case
    Const i' -> i == i'
    _        -> False
  Add a b -> para $ \case
    Add a' b' -> a (fst a') && b (fst b')
    _         -> False

Of course, cata is trivially implementable in terms of para:

cata' :: Functor f => (f a -> a) -> Fix f -> a
cata' f = para (\ffa -> f (snd <$> ffa)

Technically, almost all useful functions are implementable using cata, but they aren't necessarily efficient. We can implement para using cata:

para' :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
para' f = snd . cata (\ffa -> (Fix (fst <$> ffa) , f ffa))

However, if we use para' in eqExpr we get quadratic complexity, since para' is always linear in the size of the input, while we can use para to peek at the topmost Expr values in constant time.

Answer 2

(This response uses the data-fix library because I couldn't get recursion-schemes to compile.)

We can model the diff of two trees as an anamorphism or unfolding of a "diff functor" that is based on the original functor.

Consider the following types

data DiffF func r = Diff (Fix func) (Fix func) 
                  | Nodiff (func r)
                  deriving (Functor)

type ExprDiff = Fix (DiffF ExprF) 

The idea is that ExprDiff will follow the "common structure" of the original Expr trees as long as it remains equal, but at the moment a difference is encountered, we switch to the Diff leaf, that stores the two subtrees that we found to be different.

The actual comparison function would be:

diffExpr ::  Expr -> Expr -> ExprDiff  
diffExpr e1 e2 = ana comparison (e1,e2)
    where
    comparison :: (Expr,Expr) -> DiffF ExprF (Expr,Expr)
    comparison (Fix (Const i),Fix (Const i')) | i == i' = 
        Nodiff (Const i')
    comparison (Fix (Add a1 a2),Fix (Add a1' a2')) = 
        Nodiff (Add (a1,a1') (a2,a2'))
    comparison (something, otherthing) = 
        Diff something otherthing

The "seed" of the anamorphism is the pair of expressions we want to compare.

If we simply want a predicate Expr -> Expr -> Bool we can later use a catamorphism that detects the presence of Diff branches.