2

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

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

这对我的问题来说已经足够了。

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

(加 ab) => (加 b)

(加 (加 ab) c) => (加 a (加 bc))

和一个表达式，例如：x = (Add (Add xy) (Add zt))，我想找到x附近的所有表达式。假设 x 的邻域定义为： y in Neighborhood(x) 如果 y 可以在单个变换内从 x 到达。

我是 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，还有一些其他的。

4

1 回答 1

3

进口等如下。我将使用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)

实际上，我们只想要左右部分都非空的分区。但是我们会在我们生成它们之后检查它；它很便宜，因为每次调用partitions. 所以现在我们可以一举生成整个邻域：

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)

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

于 2014-06-17T01:58:52.277 回答