haskell - 使用 Haskell 的数学表达式的邻域

Question

我正在尝试使用 Haskell 实现一种算法来操作数学表达式。 我有这个数据类型:

data Exp = Var String | IVal Int | Add Exp Exp

这足以回答我的问题。

给定一组表达式转换，例如:

(添加 b)=>(添加 b a)

(添加(添加 b)c)=>(添加 a(添加 b c))

还有一个表达式，例如:x = (Add (Add x y) (Add z t))，我想找到x邻域中的所有表达式。假设 x 的邻域定义为:如果可以在单个变换内从 x 到达 y，则 Neighborhood(x) 中的 y 。

我是 Haskell 新手。我什至不确定 Haskell 是否适合这项工作。

最终目标是获得一个函数:等价 x，它返回一组与 x 等价的所有表达式。换句话说，位于 x 邻域闭包中的所有表达式的集合(给定一组变换)。

现在，我有以下内容:

import Data.List(nub)
import Data.Set

data Exp = IVal Int
    | Scalar String
    | Add Exp Exp
    deriving (Show, Eq, Ord)

commu (Add a b) = (Add b a)
commu x = x
assoc (Add (Add a b) c) = (Add a (Add b c))
assoc (Add a (Add b c)) = (Add (Add a b) c)
assoc x = x

neighbors x = [commu x, assoc x]

equiv :: [Exp] -> [Exp]
equiv closure
    | closure == closureUntilNow = closure
    | otherwise = equiv closureUntilNow
    where closureUntilNow = nub $ closure ++ concat [neighbors x|x<-closure]

但是它可能比需要的慢(nub 是 O(n^2))并且缺少一些项。

例如，如果你有 f = (x+y)+z，那么，你将不会得到 (x+z)+y 以及其他一些结果。

Answer 1

下面是导入等。我将使用 multiset包。

import Control.Monad
import Data.MultiSet as M

data Exp = Var String | IVal Int | Add Exp Exp deriving (Eq, Ord, Show, Read)

一些纸笔工作显示了以下事实:表达式 e1 和 e2 位于关系的同余闭包中，当且仅当叶子的多重集相等时。我所说的叶子是指 Var 和 IVal 值，例如以下函数的输出:

leaves :: Exp -> MultiSet Exp
leaves (Add a b) = leaves a `union` leaves b
leaves e = singleton e

因此，这提出了一种很好的干净方法来生成特定值邻域中的所有元素(而不是首先尝试生成任何重复项)。首先，生成叶子的多重集；然后不确定地选择多重集的一个分区并递归。生成分区的代码可能如下所示:

partitions :: Ord k => MultiSet k -> [(MultiSet k, MultiSet k)]
partitions = go . toOccurList where
    go [] = [(empty, empty)]
    go ((k, n):bag) = do
        n' <- [0..n]
        (left, right) <- go bag
        return (insertMany k n' left, insertMany k (n-n') right)

实际上，我们只想要左右部分都非空的分区。但我们会在生成所有这些之后进行检查；它很便宜，因为每次调用分区时只有两个不是这样的。现在我们可以一举生成整个社区:

neighborhood :: Exp -> [Exp]
neighborhood = go . leaves where
    full = guard . not . M.null
    go m
        | size m == 1 = toList m
        | otherwise = do
            (leftBag, rightBag) <- partitions m
            full leftBag
            full rightBag
            left  <- go leftBag
            right <- go rightBag
            return (Add left right)

顺便说一句，您没有获得所有术语的原因是因为您正在生成自反、传递闭包，而不是同余闭包:您需要在术语深处应用重写规则，而不仅仅是在顶层。