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$ Commented Dec 13, 2024 at 6:09
  • $\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$ Commented Dec 13, 2024 at 13:38
  • $\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$ Commented Dec 13, 2024 at 14:25
  • $\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$ Commented Dec 14, 2024 at 1:46
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$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.