# Finding coefficients that impose symmetry

To simplify the main question below,consider the following random multivariate polynomial :

c = 0;
r = 4; l = 5;
vars = x^RandomInteger[r, l]*y^RandomInteger[r, l];
expression =
Total@Map[(c++; a[c]*#) &]@
DeleteDuplicates@Join[vars, vars /. {x -> y, y -> x}]


x y^4 a[1] + x y a[2] + x^4 y^2 a[3] + y^4 a[4] + x^2 a[5] + x^4 y a[6] + x^2 y^4 a[7] + x^4 a[8] + y^2 a[9]

In LaTeX :

$$a(3) x^4 y^2+a(6) x^4 y+a(8) x^4+a(7) x^2 y^4+a(5) x^2+a(1) x y^4+a(2) x y+a(4) y^4+a(9) y^2$$

If all the coefficients were 1 then the polynomial above would be symmetric with respect to the permutation : $$x \leftrightarrow y$$. But there is a less restrictive choice of coefficients which is:

a[1]=a[6],a[3]=a[7],a[4]=a[8],a[9]=a[5]

In the past I used FindPermutation on the list of constants after switching x with y but I remember it being a bit of a pain to code. Is there another way ?

Bob Hanlon's answer works quite well even in the more general case I am considering with dot products and products. Here is another way directly inspired from Bob Hanlon's code but it does not sort the list of equations (for my application it is not necessary that the list is sorted):

f[x_, y_] =
x y^4 a[1] + x y a[2] + x^4 y^2 a[3] + y^4 a[4] + x^2 a[5] +
x^4 y a[6] + x^2 y^4 a[7] + x^4 a[8] + y^2 a[9];


Note: • is a unicode character used to distinguish from system functions using CamelCase

•SymRule=
(
(
Flatten@CoefficientList[f[x,y],{x,y}]
==
Flatten@CoefficientList[f[y,x],{x,y}]
)
// DeleteCases[True]
// DeleteDuplicatesBy[Sort]
// ReplaceAll[Equal->Rule]
)


then:

f[x, y] - f[y, x] /. •SymRule


0

Notice that ForAll may help to define the statement that you want. Using Reduce to find the simpler coefficient statement

List@@Sort[
Reduce[
ForAll[{x,y}, f[x, y]==f[y, x] ]
]
]


Or using SolveAlways apparently more conveniently for the OP (as per a comment bellow)

SolveAlways[f[x, y] == f[y, x], {x, y}]


• Very Nice. Thank you for your answer and for giving me the opportunity to use ForAll. I checked the examples on ForAll and the magic of Mathematica's documentation leads to SolveAlways as the last example in the properties and relations section. That then leads to the one liner SolveAlways[f[x, y] == f[y, x], {x, y}] which I found thanks to your answer. Dec 14, 2022 at 15:34
• It's a good idea to stay vigilant for some time, better approaches may come later improving over previous replies. Experienced users may point alternatives, caveats or limitations. Users should test answers before voting and wait at least 24 hours before accepting, so you give an oportunity to answer to people around the many time zones. Dec 14, 2022 at 15:47
• I noticed one drawback of this method which is that it only seems to work with variables that are AtomQ if I am not mistaken, in particular it does not work with the following list of variables {w . x, w . y, x . x, x . y, y . y} but Bob Hanlon's method does (I have to also use TensorReduce). In any case I will just accept whatever answer gets the most points as my question only involves AtomQ variables. Dec 14, 2022 at 18:53
Clear["Global*"]

f[x_, y_] =
x y^4 a[1] + x y a[2] + x^4 y^2 a[3] + y^4 a[4] + x^2 a[5] +
x^4 y a[6] + x^2 y^4 a[7] + x^4 a[8] + y^2 a[9];

cond = Union[
Sort /@ (Thread[Flatten[CoefficientList[f[x, y], {x, y}]] ==
Flatten[CoefficientList[f[y, x], {x, y}]]] /.
True -> Nothing)]

(* {a[1] == a[6], a[3] == a[7], a[4] == a[8], a[5] == a[9]} *)


Verifying,

Assuming[cond, f[x, y] == f[y, x] // Simplify]

(* True *)

• This is quite nice. It makes my last ideas I had of building a matrix from the coefficient rules and equating upper and lower triangles seem silly. Dec 14, 2022 at 3:53
• @userrandrand - I used the Sort to put the equations in canonical order, e.g., a[9] == a[5] and a[5] == a[9] are made the same. Union removes the duplicates like DeleteDuplicates but also sorts the equations. Dec 14, 2022 at 4:04
• ahh so it's to render Equal orderless when applying Union`. Nice. Dec 14, 2022 at 4:09