9

我有这个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有些拉链功能。

+1

从哪里得到您的Fix? – danidiaz

+1

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

+0

你可能想要一个zygohistomorphic prepromorphism。我不知道它做了什么,但有了这样的名字,我无法想象它有多少*不能做。 :) – chepner

回答

4

作用于单个参数的递归方案就够了,因为我们可以从方案应用程序返回一个函数。在这种情况下,我们可以从Expr上的方案应用程序返回Expr -> Bool函数。为了有效地平等检查,我们只需要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,但他们不是活得不一定高效。我们可以通过cata实现para

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偷看值在不变的时间。

+0

是否可以像'cataZipWith :: Fix f - > Fix f - >(f a - > f c - > a) - > a'那样编写'eqExpr'的多态版本? – ais

+0

@AndrásKovács在执行'eqExpr'时,为什么模式匹配背后的catas/paras是必需的?我们不能在第二棵树上直接模式匹配吗? – danidiaz

+0

@danidiaz我认为我们只能使用递归方案。 –

2

(此反应使用数据修复库,因为我无法得到递归的方案编译。)

我们可以两棵树的差异模型作为anamorphism或的展开“差异仿函数“,它是基于原函子的。

考虑以下类型

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 

的的anamorphism的“种子”是对我们要比较的表达式。

如果我们只是想要一个谓词Expr -> Expr -> Bool,我们可以稍后使用一个变形检测Diff分支的存在。