Permuting indices to form fully symmetric tensor with repeated indices

Question

I have written a function (version 8) that takes as an input a list of indices such as {i,j,k} and outputs a fully symmetric tensor function containing $p_i$ and $g_{ij}$ ($g_{ij}$ is itself understood to be symmetric under $i\leftrightarrow j$).

myFunc[tensorList_?ListQ] := Module[{rank = Length[tensorList], perms, i, j, k, r},
  perms = Select[Permutations[tensorList, {rank}], Signature[#] == 1 &];

  Return[Sum[If[rank <= 1, 1, 2^(1 - r)/(r! (rank - 2 r)!)]*
    Factor[Sum[
      Product[Subscript[p, perms[[i]][[j]]],
        {j, 1, rank - 2 r}] 
      Product[Subscript[g, Times @@ perms[[i]][[2 k - 1 ;; 2 k]]],
        {k, rank/2 - r + 1, rank/2}], {i, 1, Max[1, rank!/2]}]] 
    f[2 r, rank], {r, 0, rank/2}]]
]

Example of usage:

myFunc[{i}] returns $f[0, 1]p_i$

myFunc[{i,j}] returns $f[2, 2]g_{ij}+f[0,2]p_i p_j$.

etc.

Problem: My function only works when all elements of input list have unique names like {i,j,k}. I don't know how to modify it so that it can accept lists like {i,j,j}.

for example, I'd like myFunc[{i,i}] to return $f[2,2]\,g_{i^2}+f[0,2]p_i p_i$.

and yes, I know that I'm multiplying indices of g, which I'd like to keep.

Any hints please? (and any pointers on ethics of function construction would be nice!)

Answer 1

To address your question on a high level only (how do I make my function to interpret the input {i, j, j} to contain distinct elements, like {i, j, k}), I recommend an approach similar to one that I made in one of my own questions:

myOtherFunc[list_] := 
  With[{tempList = Array[Unique[] &, Length@list]}, 
     myFunc[tempList] /. Thread[tempList -> list]]

This gives you the results you're looking for because it replaces your input symbols with temporary unique symbols (which are treated as such in your function), and then replaces them with the desired ones afterwards.

Regarding your function, since you asked for some pointers:

A bit of Part cleanup helps. Instead of [[i]][[j]] consider [[i, j]].

For symbols like perms, which you only define once then keep unchanged, it's better to use the faster With rather than Module. In fact, LetL makes more sense than nested Withs (the code for LetL is somewhere on this site, I swear).

Get rid of the Return.

Instead of using your If construct (whose static condition is needlessly evaluated for every Sum iteration), create a variable e (again using the ever so convenient LetL).

EDIT: scoping i, j, k, r is unnecessary if you use the myOtherFunc construct b/c it already replaces your variables with unique ones, effectively re-creating the Module.

Here's the improved myFunc:

myFunc[tensorList_?ListQ] := 
  LetL[{
    rank = Length[tensorList], 
    perms = Select[Permutations[tensorList, {rank}], Signature[#] == 1 &],
    e = If[rank <= 1, 1, 2^(1 - r)/(r! (rank - 2 r)!)]},
    Sum[
      e *
      Factor[Sum[
        Product[Subscript[p, perms[[i, j]]], {j, 1, rank - 2 r}] *
        Product[Subscript[g, Times @@ perms[[i, 2 k - 1 ;; 2 k]]], {k, rank/2 - r + 1, rank/2}],
        {i, 1, Max[1, rank!/2]}]] *
      f[2 r, rank],
    {r, 0, rank/2}]
  ]

EDIT 2: Just something that came to me as I was viewing myOtherFunc:

#[] & /@ ConstantArray[Unique, len]

Is functionally equivalent to

Array[Unique[] &, len]

But the former is 10x faster b/c it takes advantage of the controlled evaluation and is more memory efficient during computation.