# Efficient way to give symbolic elements symmetry

I have a symbolic expression that represents a set of operators. These operators have quite a bit of symmetry to simplify expressions:

A[{1,2},{3,4}]==A[{3,2},{1,4}]==A[{1,4},{3,2}]==A[{3,4},{1,2}]
S[{1},{2}]==S[{2},{1}]


I will use the first term of the series to denote positions.

3->"d"
A[{1,2},{"d",4}]


So for example:

In:
temporary=S[{1}, {2}]*v[{1, 2}, {3, 4}]
+ S[{2}, {1}]*v[{3, 2}, {1, 4}]
+ S[{2}, {1}]*v[{3, 4}, {1, 2}]

Out:
3*S[{1},{2}]*A[{1, 4}, {3, 2}]


At current I simply have replacement rules that move indices in a logical way for example:

temporary//.{
x_[{x1_, x2_}, {x3_, x4_}] /; (!condition[x1,x3]) :> v[{x3, x2}, {x1, x4}]
}

(*Condition is a statement that checks the order of indices, for example
if x1="b" and x3="a" it would return false and so the expression would be
reordered so that "a" is now in position 1 and "b" in position 3.*)


It seems if there has to be a better way to do this.

Bonus: Is there a simple way to find the original of a unique value. Say Unique[a]=a$532 unUnique[a$543]=a.

-
Have you seen this? Admittedly I didn't read your question in detail, but it reminded me of that. Disregard this if it's not helpful. – Szabolcs Feb 15 '13 at 16:43
I did, and in brief test worked great! Unfortunately it would take a rewrite of the entire program to implement. It seems that there would be a simple way to do the above, but I could be wrong. – Ophion Feb 15 '13 at 16:50

I'm afraid there's no simple way or shortcut to properly implement tensor symmetries. Manual rules that move indices might work in simple situations, but inevitably fall short when dealing with more complicated symmetries, more indices, or bigger contractions.

That being said, we can take @Szabolcs' cue and rewrite everything in terms of the (as of Mathematica 9) built-in tensor capabilities.

The first step is to write assumptions for our tensors:

$Assumptions = And[ v ∈ Arrays[{d, d, d, d}, Reals, {{{3, 2, 1, 4}, 1}, {{1, 4, 3, 2}, 1}, {{3, 4, 1, 2}, 1}}], S ∈ Matrices[{d, d}, Reals, Symmetric[{1, 2}]] ]  We can then replace S and v in your notation to TensorTranspose notation, and simplify with TensorReduce: temporary = S[{1}, {2}]*v[{1, 2}, {3, 4}] + S[{2}, {1}]*v[{3, 2}, {1, 4}] + S[{2}, {1}]*v[{3, 4}, {1, 2}]; temporary /. S[{i_}, {j_}] * v[{k_, l_}, {m_, n_}] :> TensorProduct[ TensorTranspose[S, {i, j}], TensorTranspose[v, {k, l, m, n}] ] // TensorReduce  3 S \[TensorProduct] v  It then remains to rewrite this back to your notation, but it in this case it's immediately obvious that it gives the same result as yours. As for the bonus question, how about this? Unique[a]  a$15499

Symbol @ First @ StringSplit[ToString[%], "\$"]

a

-