Neighborhood of a mathematical expression using Haskell

Question

I'm trying to implement with Haskell an algorithm to manipulate mathematical expressions. I have this data type :

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

This will be enough for my question.

Given a set of expression transformations, for example :

(Add a b) => (Add b a)

(Add (Add a b) c) => (Add a (Add b c))

And an expression, for example : x = (Add (Add x y) (Add z t)), I want to find all expressions in the neighborhood of x. Given that neighborhood of x is defined as: y in Neighborhood(x) if y can be reached from x within a single transformation.

I am new to Haskell. I am not even sure Haskell is the right tool for this job.

The final goal is to get a function : equivalent x which returns a set of all expressions that are equivalent to x. In other words, the set of all expressions that are in the closure of the neighborhood of x (given a set of transformations).

Right now, I have the following :

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]

But It's probably slower than needed (nub is O(n^2)) and some terms are missing.

For example, if you have f = (x+y)+z, then, you will not get (x+z)+y, and some others.

Answer 1

Imports, etc. below. I'll be using the multiset package.

import Control.Monad
import Data.MultiSet as M

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

A bit of paper-and-pencil work shows the following fact: expressions e1 and e2 are in the congruence closure of your relation iff the multiset of leaves are equal. By leaves, I mean the Var and IVal values, e.g. the output of the following function:

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

So this suggests a nice clean way to generate all the elements in a particular value's neighborhood (without attempting to generate any duplicates in the first place). First, generate the multiset of leaves; then nondeterministically choose a partition of the multiset and recurse. The code to generate partitions might look like this:

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)

Actually, we only want partitions where both the left and right part are non-empty. But we'll check that after we've generated them all; it's cheap, as there's only two that aren't like that per invocation of partitions. So now we can generate the whole neighborhood in one fell swoop:

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)

By the way, the reason you're not getting all the terms is because you're generating the reflexive, transitive closure but not the congruence closure: you need to apply your rewrite rules deep in the term, not just at the top level.