4
$\begingroup$

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.

Improve this question
$\endgroup$
10
  • $\begingroup$ "sum over all permutations" - Sum[] can already do that: Sum[(s[#1] + 3 s[#2]) & @@ idx, {idx, Permutations[Range[3]]}] $\endgroup$
    – J. M.'s persistent exhaustion ♦
    Jul 6, 2016 at 12:54
  • $\begingroup$ Can you resolve your task by making replacement rules for s[_Integer] instead of _Integer? Then the integer factors to s[_] terms won't be affected. $\endgroup$
    – Anton Antonov
    Jul 6, 2016 at 12:57
  • $\begingroup$ J.M.: Your method is very nice. Do you know how I can take an arbitrary expression and turn it into a function, eg. to take s[1] + s[2] and return s[#1] + s[#2]? $\endgroup$
    – Joe
    Jul 6, 2016 at 13:04
  • $\begingroup$ Anton Antonov: Yes I can do this, and maybe I will have to resort to generating a list of replacements for all of my variables. The reason that I'm not so keen to do it just yet and see if I can instead single out numerical factors is that I have quite a few different variables, Subscript[s,i], Subscript[k,i], Subscript[e,i] as well as variables with two labels, Subscript[s,i, j]. I would also like my method to be applicable to possible expressions which involve more variables later on too $\endgroup$
    – Joe
    Jul 6, 2016 at 13:06
  • $\begingroup$ @Joe You have to deal with s[_Integer] in one way or the other. Here is an answer to the question you asked J.M. : Function[Evaluate[s[3] + 5 s[5] /. s[i_Integer] :> s[Slot[i]]]] . $\endgroup$
    – Anton Antonov
    Jul 6, 2016 at 13:10

2 Answers 2

Reset to default
3
$\begingroup$

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.!

Improve this answer
$\endgroup$
1
$\begingroup$

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]  *)
Improve this answer
$\endgroup$
5
  • $\begingroup$ Oh great thanks, this is more like what I had in mind originally when I asked the question. Would you mind explaining some of it to me though? I think the part {heads} | heads in the function definition just allows me to enter either s or {s,k} as an argument, and it's the same as Alternatives[heads,{heads}], is that correct? And {heads__} just specifies a list of any length? I also don't understand the second usage of Alternatives[heads][__], how does this work? $\endgroup$
    – Joe
    Jul 7, 2016 at 8:43
  • $\begingroup$ Also when I try to run the function, I get the following error message Pattern::patv: Name heads used for both fixed and variable length patterns.. I'm using Mathematica 8. I tried using this instead, repWithin[expr_, {headslist__} | heads_, rules_] := expr /. foo : Alternatives[heads][__] :> (foo /. rules) /. foo : Alternatives[headslist][__] :> (foo /. rules), does that look like a sensible fix to the error message? $\endgroup$
    – Joe
    Jul 7, 2016 at 8:53
  • $\begingroup$ @Joe (1) Yes, the pattern is to match either a single head or a list of heads. Order within Alternatives matters however so h_ | {h__} is not the same as {h__} | h_}! (2) Alternatives[heads][__] is a pattern to match any expression with one of the specified heads and one or more arguments. (3) The message is not an error and may be safety ignored, so long as you understand it. See: (26690). (continued) $\endgroup$
    – Mr.Wizard
    Jul 7, 2016 at 9:12
  • $\begingroup$ (4) That should work but I would prefer to use "vanishing patterns" like this: repWithin[expr_, {heads__} | head_, rules_] := expr /. foo : (heads | head)[__] :> (foo /. rules) Here whichever Pattern name is not matched (heads or head) is dropped (a la Sequence[]) from (heads | head). $\endgroup$
    – Mr.Wizard
    Jul 7, 2016 at 9:15
  • $\begingroup$ OK great I understand this now, thanks for the explanations $\endgroup$
    – Joe
    Jul 7, 2016 at 12:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.