4
$\begingroup$

Here is a challenge for you. I have an expression that has an arbitrary number of terms that look like

expression = a[i]          *  f[g[y, i]]
           + b[i, j]       *  f[g[x, j], g[y, i]] 
           + c[i, j, k]    *  f[g[x, j], g[y, k], g[x, i]]
           + d[i, j, k, l] *  f[g[y, j], g[x, l], g[y, i], g[y, k]]
           + ...

There could be any number of terms with a variable number of indices {i,j,k,l,...}. The first argument of g is always either x or y.

I want to rearrange the second arguments of g in each term such that they are in alphabetical order in the entire term. In the above example, this would give the output:

output =     a[i]          *  f[g[y, i]]
           + b[j, i]       *  f[g[x, i], g[y, j]] 
           + c[k, i, j]    *  f[g[x, i], g[y, j], g[x, k]]
           + d[k, i, l, j] *  f[g[y, i], g[x, j], g[y, k], g[y, l]]
           + ...

Another way to say this is that I want to rearrange Einstein-summed dummy indices in the sum such that the indices within f are in alphabetical order.

What is the most straightforward way to accomplish this that you can think of? I'm reaching the limit of my knowledge of Mathematica patterns with this one.

Improve this question
$\endgroup$
0

2 Answers 2

Reset to default
5
$\begingroup$ 
ClearAll["Global`*"];
indexsort := coeff_*terms_f :> Module[{indices},
    indices = Last /@ (List @@ terms);
    coeff*terms /. Thread[indices -> Sort[indices]]];

expression = (a[i]*f[g[y, i]]
    + b[i, j]*f[g[x, j], g[y, i]]
    + c[i, j, k]*f[g[x, j], g[y, k], g[x, i]]
    + d[i, j, k, l]*f[g[y, j], g[x, l], g[y, i], g[y, k]]);

expression /. indexsort

(* a[i] f[g[y, i]] 
   + b[j, i] f[g[x, i], g[y, j]] 
   + c[k, i, j] f[g[x, i], g[y, j], g[x, k]] 
   + d[k, i, l, j] f[g[y, i], g[x, j], g[y, k], g[y, l]]
*)
Improve this answer
$\endgroup$
4
  • $\begingroup$ Amazing! Do you think it would be easy to replace coeff_ * terms_f by "any expression that contains the pattern terms_f"? $\endgroup$
    – Ben
    Commented yesterday
  • $\begingroup$ Well, I tested my code only in your sample. Also I assumed the input expression is complete in the sense that every index is contracted unambiguously and there is no unpaired indices. If you provide much more complicated example, then I would test my code more seriously. $\endgroup$
    – A. Kato
    Commented yesterday
  • $\begingroup$ Your code is great and does the job for my example! That's why I accepted the answer :). But it occurred to me that the code could be generalized to "if a term X contains the pattern f[g[...], g[...], ...], then sort the indices in the entire term X". $\endgroup$
    – Ben
    Commented yesterday
  • $\begingroup$ You are right. That is expected behavior if for every paired index, one appears within f[...] and the other is outside of f[...]. Do you also want to treat the case where the paired indices both appear inside f[...] --- for example b[j,k]*f[g[x,i], g[y,j],g[z,i],g[w,k]]? Then I will revise my code. $\endgroup$
    – A. Kato
    Commented yesterday
5
$\begingroup$

I think this can be simplified, but here's a way. Define a function that does the work on one summand at a time.

fn[Times[h1_[args1__], h2_[args2__]]] :=
  With[
    {ord = Ordering[{args2}[[All, 2]]]},
    Times[h1[args1][[ord]], h2 @@ SubsetMap[Sort, {args2}, {All, 2}]]]

Then map it.

expression =
  a[i]*f[g[y, i]] + 
  b[i, j]*f[g[x, j], g[y, i]] + 
  c[i, j, k]*f[g[x, j], g[y, k], g[x, i]] + 
  d[i, j, k, l]*f[g[y, j], g[x, l], g[y, i], g[y, k]];

fn /@ expression
(* a[i]*f[g[y, i]] + 
   b[j, i]*f[g[x, i], g[y, j]] + 
   c[k, i, j]*f[g[x, i], g[y, j], g[x, k]] + 
   d[k, i, l, j]*f[g[y, i], g[x, j], g[y, k], g[y, l]] *)
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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