Generating all permutations of labels in an expression

Question

I have some very long and complex expressions which involve a set of $n$ variables, and I want to be able to permute the labels of the variables. I will give a simple example, instead of my awful expressions. Suppose $n = 3$, and consider s[1] + s[3] + s[1,3]. I start by defining a function to turn permutations into replacement rules;

permreplacements[n_] := 
  MapIndexed[First[#2] -> #1 &, #] & /@ Permutations[Range[n]]

And then I can apply this to my expression, eg.

s[1] + s[3] + s[1,3] /. permreplacements[3][[2]]
s[1] + s[3] + s[1,3] /. permreplacements[3][[4]]

etc.

This is great for my current expression, but now consider instead the expression s[1] + 3 s[2] + s[1,3]. When I apply my method to this expression, it permutes the numerical factor '3' as well as the labels on my variables.

Does anyone have a good method to permute only the labels on my variables and not any numerical factors? If I had only variables of the form s[i], I could just generate a set of rules for each variable, eg. {s[1]-> s[3], s[2]-> s[1], s[3]-> s[2]}. But as I must also consider s[1,2], I can't see how to do this without generating a very large set of replacement rules which covers all possible cases of s[i,j]

Extra information which may or may not be relevant:

• I also have labels of the form Subscript[s, 2], but I guess if I'm shown how to deal with s[2] I can extend to subscripts

• In the end, I want to apply the function

  sumperms[expr_, n_] := Sum[expr /. permreplacements[3][[i]], {i, n!}]
  

  to sum over all permutations.

Answer 1

Solution provided by Anton and J.M.:

labelstoarguments[expr_, variables_] := With[{
   temp = expr /. ((#[idx__Integer] :> # @@ Slot /@ {idx}) & /@ variables)
     /. ((Subscript[#, idx__Integer] :> Subscript[#, Sequence @@ Slot /@ {idx}]) & /@ variables)
  },
  Function[temp]
 ]

An example usage:

labelstoarguments[s[1] + 3 s[2] + k[1,3], {s, k}]

producing

s[#1] + 3 s[#2] + k[#1, #2] &

which can then be applied to a given permutation. So to sum an expression over a given set of permutations, you can use eg.

Sum[labelstoarguments[s[1] + 3 s[2] + k[1,3], {s, k}]@@i, {i, Permutations[Range[3]]]

Thanks very much Anton and J.M.!

Answer 2

Another approach you might find use in:

repWithin[expr_, {heads__} | heads_, rules_] :=
  expr /. foo : Alternatives[heads][__] :> (foo /. rules)

Now:

repWithin[s[1] + s[3] + s[1, 3], s, permreplacements[3][[2]]]

(* out=  s[1] + s[2] + s[1, 2]  *)

repWithin[s[1] + 3 s[2] + k[1, 3], {s, k}, permreplacements[3][[4]]]

(* out=  k[2, 1] + s[2] + 3 s[3]  *)

repWithin[s[1] + s[3] + Subscript[z, 2], {s, Subscript}, permreplacements[3][[5]]]

(* out=  s[2] + s[3] + Subscript[z, 1]  *)