递归方案是否可以用于比较两个树？

Question

我有这个抽象语法树

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

但我希望可以使用某种压缩折叠函数。

- ais

---

你从哪里获取你的修复程序？ - danidiaz

https://hackage.haskell.org/package/recursion-schemes - ais

你可能想要一个zygohistomorphic预处理形态。我不知道它是做什么的，但是像这样的名字，我想象不出它不能做什么。 :) - chepner

在递归方案中，Fix具有Eq1实例。 - xgrommx

Answer 1

针对单个参数的递归方案已经足够，因为我们可以从方案应用中返回一个函数。在这种情况下，我们可以从 Expr 的方案应用中返回一个 Expr -> Bool 函数。为了有效地进行相等性检查，我们只需要使用 paramorphism：

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

从技术上讲，几乎所有有用的功能都可以使用来实现，但它们不一定高效。我们可以使用来实现:

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

然而，如果在eqExpr中使用para'，我们会得到二次复杂度，因为para'的大小始终与输入的大小成线性关系，而我们可以使用para在常数时间内查看顶部的Expr值。

- András Kovács

---

是否有可能编写一个多态版本的 eqExpr，例如 cataZipWith :: Fix f -> Fix f -> (f a -> f c -> a) -> a？ - ais

在eqExpr的实现中，为什么需要在模式匹配后面使用catas/paras？难道我们不能直接在第二棵树上进行模式匹配吗？ - danidiaz

@danidiaz 我理解我们只能使用递归方案。 - András Kovács

@danidiaz，这也违背了香蕉和透镜的精神。 - András Kovács

Answer 2

(这个响应使用数据修复库，因为我无法编译递归方案。)

我们可以将两棵树的差异建模为一个基于原始函子的“差异函子”的展开或非同态。

考虑以下类型：

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分支的存在。请注意保留HTML标记。

- danidiaz