# Optimizing my code to generate symmetric tensors

I have written code that does carries out the following task:

Construct a fully symmetric rank-$P$ "tensor" out of a collection of user-input rank-1 vectors, and a rank-2 symmetric tensor $h$. The number of times each vector is to be repeated, and the indices of the final rank-$P$ tensor are user-input.

Example #1: Three vectors, three indices-- Given input vectors $u$ repeated once, $v$ repeated twice, and indices {$a,b,c$}, the output should be the symmetric tensor:

$$u_a v_b v_c + u_b v_a v_c + u_c v_a v_b$$

Example #2: Two vectors, four indices-- This time, take input vector $u$ repeated twice, but with four indices {$a,b,c,d$}. Since there are two excess indices, they must be assigned to $h$. The output:

$$u_a u_b h_{c d}+u_a u_c h_{b d}+u_a u_d h_{b c}+u_b u_c h_{a d}+u_b u_d h_{a c}+u_c u_d h_{a b}$$

Note: User must input such that number of excess indices must be even, and can never be less than the number of rank-1 tensors.

My code here as follows, starting with definitions and input:

(*Tells engine that \[DoubleStruckH] is symmetric *)
Clear[\[DoubleStruckH]];
Subscript[\[DoubleStruckH], i_, j_] ^:= Subscript[\[DoubleStruckH], j, i] /; ! OrderedQ[{i, j}];


Here are the input variables:

(*Example 1*)
sym = {u, v};  (*symbols of rank-1 vectors*)
n = {1, 2};    (*repetition: u once, v twice*)
indices = {a, b, c};   (*Indices of rank-3 tensor.*)

(*Example 2*)
sym = {u};     (*symbols of rank-1 vectors*)
n = {2};       (*repetition: u twice*)
indices = {a, b, c, d};   (*Indices of rank-4 tensor.*)


Useful definitions:

P = Length[indices];  (*rank of final tensor*)
r = (P - Total[n])/2; (*number of \[DoubleStruckH] in tensor*)


So now my clumsy code: strategy is to begin with one-representative term of the symmetric tensor (which needs some help).

representative = Apply[Function[#,
Product[1/
n[[j]]! Product[Subscript[
sym[[j]], #[[i]]], {i, 1 + Sum[n[[k]], {k, 1, j - 1}],
Sum[n[[k]], {k, 1, j}]}], {j, 1, Length[sym]}]*1/(r! 2^r)
Product[
Subscript[\[DoubleStruckH], #[[i]], #[[i + 1]]], {i,
Total[n] + 1, P, 2}]] &, {Table[Unique[], {P}]}]


In the case of (*Example 1*), the output of representative is:

I know I need help here, since representative is supposed to be a pure function, with the arguments being the slots where the indices go. But the output of this reveals that it doesn't fully evaluate the products.

Anyway, carrying on. Now all I need is to add up all possible permutations:

answer = Plus @@ With[{func = representative}, Map[Apply[func, #] &, Permutations[indices]]]


It works, but it slow for large ($P\gtrsim 6$) tensors.

The two places where I need help is:

1. I need to make this work somewhat quickly for large tensors (with 6 or 8 indices). Clearly the code does more work than it needs to because of the factorials that I use in representative to divide out extra terms.

2. My representative function needs help, too (see above).

-
I see that you updated your post (fixing that infinite recursion) but you haven't commented on my answer. Does it do what you want? –  Mr.Wizard Feb 5 '14 at 18:44
Yes actually, your answer works wonderfully. I should have commented. –  QuantumDot Feb 5 '14 at 19:10

I am not going to try to understand everything you wrote, and I shall not attempt a full breakdown of your code as I have done for other questions tagged , unless specifically requested, as it seems to me you have a working solution with a simple flaw: you are not evaluating the body of the Function that you are generating. To that end you could write:

representative =
Function @@ {#,
Product[1/n[[j]]! Product[
Subscript[sym[[j]], #[[i]]], {i, 1 + Sum[n[[k]], {k, 1, j - 1}],
Sum[n[[k]], {k, 1, j}]}], {j, 1, Length[sym]}]*1/(r! 2^r) Product[
Subscript[\[DoubleStruckH], #[[i]], #[[i + 1]]], {i, Total[n] + 1, P, 2}]} &[
Table[Unique[], {P}]]

Function[{$1,$2, $3}, 1/2 Subscript[u,$1] Subscript[v, $2] Subscript[v,$3]]


I would apply it with:

representative @@@ Permutations[indices] // Tr


$u_c v_a v_b+u_b v_a v_c+u_a v_b v_c$