# How to remove some elements in a list based on a rule?

I want to deal with the following list.

mylist = Table[cof[i] exp[i], {i, 1, n}]; (*n is very larege *)


exp[ ] is a function of {x1, x2, x3, x4, ...} and cof[] doesn't depend on the variables {x1, x2, x3, x4, ...}. exp[ ] has a pattern like this, x_ Exp[_] (see the following example). I want to deal with this list according to some rule.

That is, if exp[k1] can be obtained by exp[k2] under some permutation of the variables {x1, x2, x3, x4, ...}, then I delete the term cof[k2] exp[k2] in mylist and change cof[k1] to (cof[k1] + cof[k2]). It seems I should compare all the exp[] terms. I cannot find a way to that for this problem. Any help?

Here is a simple example,

inputlist = {2 const x1 x2 Exp[2 x1 x1 + 3 x2 x2 + 2 x3 x3 - x1 x2 + x2 + cf1],
2 x1 x3 Exp[2 x1 x1 + 2 x2 x2 + 4 x3 x3 - x1 x2  ],
-x1 x3 Exp[2 x1 x1 + 3 x3 x3 + 2 x2 x2 - x1 x3 + x3 ],
3 Exp[2 x1 x1 + 3 x2 x2 + 4 x3 x3 ],
-2 Exp[4 x1 x1 + 2 x2 x2 + 3 x3 x3 ]};


The corresponding exp[] can be written as,

exp[1] = x1 x2 Exp[2 x1 x1 + 3 x2 x2 + 2 x3 x3 - x1 x2 + x2];
exp[2] = x1 x3 Exp[2 x1 x1 + 2 x2 x2 + 4 x3 x3 - x1 x2  ];
exp[3] = x1 x3 Exp[2 x1 x1 + 3 x3 x3 + 2 x2 x2 - x1 x3 + x3 ];
exp[4] = Exp[2 x1 x1 + 3 x2 x2 + 4 x3 x3 ];
exp[5] = Exp[4 x1 x1 + 2 x2 x2 + 3 x3 x3 ];


Based on the rule, we notice that

exp[1] /. {x1 -> x1, x2 -> x3, x3 -> x2} == exp[3];
exp[4] /. {x1 -> x2, x2 -> x3, x3 -> x1} == exp[5];


so the output list should be

outputlist = {
(2 const Exp[cf1]-1) x1 x2 Exp[2 x1 x1 + 3 x2 x2 + 2 x3 x3-x1 x2 + x2],
2 x1 x3 Exp[2 x1 x1 + 2 x2 x2 + 4 x3 x3 - x1 x2 ],
Exp[2 x1 x1 + 3 x2 x2 + 4 x3 x3]
}

-
@m_goldberg Thanks for editing ! – Orders Mar 6 '13 at 15:18
I'm not sure I understand this: "and cof[], not exp[], has a pattern like this, x_ Exp[_]" Isn't exp[...] (not cof[]) that has a form of $(\text{product of } x_i)e^{(...)}$? Also, does the exponential always contain a multivariate polynomial? If yes, of what order? – Szabolcs Mar 6 '13 at 21:44
It seems that part of the problem is deciding if expressions are equivalent under some permutation of the variables. How many variables do you have? If we only consider second order multinomials, this test becomes equivalent to graph isomorphism testing (with edge weights), where the CoefficientArray would be the adjacency matrix. This may be slow for lots of variables. (I'm just thinking aloud about which part may have an efficient solution) – Szabolcs Mar 6 '13 at 21:46
I guess how difficult this is going to be depends on the exact form of the elements of the list. Could you give more information about that please? – Szabolcs Mar 6 '13 at 21:52
Is it possible to define a function or functions with Orderless attribute for this problem? – unstable Mar 6 '13 at 23:11

It seems to me that the key challenge is to identify when two expressions are equivalent with a suitable permutation of variables. In this answer I'll address that part first, with a full solution to the problem afterwards.

The variable permutation part

Here is an idea to find the variable permutations using the pattern matcher. The basic concept is to create a pattern from expr1, essentially by replacing the variables with Blank[]s. That pattern is used to define a temporary function f which returns the list of symbols matching the Blank[]s. The function f is then applied to expr2. If expr2 has the same structure as expr1, the pattern will match and f will return a list of the symbols in expr2 which correspond to the variables in expr1.

varPattern = _Symbol?(! NumericQ[#] &);

variableMapping[expr1_, expr2_] := Module[{f},
With[{vars = Union@Cases[{expr1}, varPattern, -1]},
f[_] = {};
f[expr1 /. (# -> Pattern[#, varPattern] & /@ vars)] := vars;
f[expr2] /. v : {__} :> Thread[v -> vars]]]


The function variableMapping[expr1,expr2] returns a rule list that transforms expr2 to expr1. For example:

variableMapping[a + 2 b, 2 c + d]
(*  {d -> a, c -> b}  *)


Using the examples in the question:

variableMapping[exp[1], exp[3]]
(*  {x1 -> x1, x3 -> x2, x2 -> x3}  *)

variableMapping[exp[4], exp[5]]
(*  {x2 -> x1, x3 -> x2, x1 -> x3}  *)


If there is no match an empty list is returned:

variableMapping[exp[1], exp[2]]
(*  {}  *)


I'll step through this using global variables for easier reading, but of course you would want to put it all into a Module eventually.

First we need to separate the inputlist into cof and exp terms. There is probably a much smarter way to do this, but this works:

vars = x1 | x2 | x3;
a = inputlist /. {Exp[_] -> 1, vars -> 1}
b = inputlist /. ___ Exp[x_] :> x /. vars -> 0
cof = a Exp[b];
exp = inputlist/cof;


Now use the variableMapping function on each pair of elements in exp to find the list of replacements. For this problem the actual variable permutation is not required, we just need to know if one exists, so the check is simply whether variableMapping returns an empty list or not:

reps = #2 -> #1 & @@@
Select[Subsets[Range@Length@exp, {2}],
variableMapping @@ exp[[#]] != {} &]
(*  {3 -> 1, 5 -> 4}  *)


There may be cases where three or more exp terms are considered interchangeable, so we need to prune the replacement list:

reps = GatherBy[reps, First][[All, 1]];


Now all that's required is to modify the cof list according to the rules set out in the question:

(cof[[#2]] += cof[[#1]]; cof[[#1]] = 0) & @@@ reps;
cof
(*  {-1 + 2 const E^cf1, 2, 0, 1, 0}  *)

outputlist = cof exp

(*  {E^(2 x1^2 + x2 - x1 x2 + 3 x2^2 + 2 x3^2) (-1 + 2 const E^cf1) x1 x2,
2 E^(2 x1^2 - x1 x2 + 2 x2^2 + 4 x3^2) x1 x3,
0,
E^(2 x1^2 + 3 x2^2 + 4 x3^2),
0}  *)

-
Thanks, waiting for your complete answer. – Orders Mar 8 '13 at 5:49
@Orders, see the update. – Simon Woods Mar 8 '13 at 12:40
Thanks! However, I realized that I should use a numerial method to deal with this problem. Because the computation is not easy for a large expressions in this case. – Orders Mar 8 '13 at 15:04