Можно ли сравнить два дерева с рекуррентными схемами?

Question

У меня есть этот AST

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

и я хочу, чтобы сравнить

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

Но все схемы рекурсии функции, кажется, работает только с одной структурой

Очевидно, что я могу использовать рекурсию

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 

Но я надеюсь, что можно использовать s ome тип функции zipfold.

Answer 1

Рекурсии, которые действуют на один аргумент, достаточно, потому что мы можем вернуть функцию из приложения схемы. В этом случае мы можем вернуть функцию Expr -> Bool из приложения схемы на Expr. Для проверки эффективного равенства нам нужно только 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 

Конечно, cata тривиальных реализуемо с точкой зрения para:

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

Технически, практически все полезными функции реализуемые с помощью cata, но они Арен» t обязательно эффективный. Мы можем реализовать para с помощью cata:

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

Однако, если мы используем para' в eqExpr мы получаем квадратичную сложность, так как para' всегда линейна по размеру входа, в то время как мы можем использовать para, чтобы взглянуть на верхний Expr значения в постоянное время.

Answer 2

(Этот ответ использует данные затруднительного библиотеку, потому что я не мог получить рекурсии-схемы для компиляции.)

Мы можем моделировать диф двух деревьев, как анаморфизм или разворачивание " diff functor ", основанный на исходном функторе.

Рассмотрим следующие типы

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

type ExprDiff = Fix (DiffF ExprF) 

Идея заключается в том, что ExprDiff будет следовать «общей структуры» оригинальных Expr деревьев до тех пор, пока она остается равной, но на данный момент разница встречается, мы включаем на лист Diff, в котором хранятся два поддеревья, которые, как мы обнаружили, различны.

Фактическая функция сравнения будет:

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 

«Семя» из анаморфизма является парой выражений, которые мы хотим сравнить.

Если мы просто хотим предикат Expr -> Expr -> Bool, мы сможем позже использовать катаморфизм, который обнаруживает наличие Diff ветвей.