I'm trying to procedurally generate replacement rules of the following form

X[{a,a}] -> X1
X[{a,b}]X[{b,a}] -> X2
X[{a,b}]X[{b,c}]X[{c,a}] -> X3
X[{a,b}]X[{b,c}]X[{c,d}]X[{d,a}] -> X4

Also, I know the number of maximum required replacement rules in advance.

Implementing {a1___, a2___, a3___, ... } instead of {a,b,c, ... }, my pseudocode reads

X[{a[1],a[2]}] X[{a[2],a[3]}]... X[{a[n-1],a[n]}] X[{a[n],a[1]}] -> Xn
Product[ X[{a[i],a[i+1]}], {i,1,n-1} ] X[{a[n],a[1]}] -> Xn

which translated into actual Mathematica code gives:

MyRule[n_] := 
  a___ Product[ 
    Subscript[X, {Symbol["μ"<>ToString[i]<>"___"], Symbol["μ"<>ToString[i+1]<>"___"]}], 
  {i,1,n-1}] Subscript[X, 
      {Symbol["μ"<>ToString[n]<>"___"], Symbol["μ"<>ToString[1]<>"__"]}
  ] :> a Subscript[X, n]


Subscript[X, {a, b}] Subscript[X, {b, a}] /. MyRule[2]

shows that the rule definition is not working properly, allegedly because of a conflict in the way the dummy indices are written and some issues with their 'Symbol' character but I don't really get it. how could I fix this?

  • $\begingroup$ Just a remark: Subscript[X, {b, a}] is not the same as X[{b, a}]. You just have to decide on a single way of indexing. $\endgroup$ – Henrik Schumacher Feb 10 '20 at 6:08

Maybe something like:

ClearAll[cyclicPattern, cyclicPatternRule]

cyclicPattern[n_, h_: X] := Times @@ (h /@ (Pattern[#, Blank[]] & /@ # & /@ 
      Partition[Symbol["x" <> ToString[#]] & /@ Range[n], 2, 1, 1]))

cyclicPatternRule[n_, h_: X] := cyclicPattern[n, h] -> Symbol[SymbolName[h] <> ToString[n]]

cyclicPatternRule /@ Range[4]

{X[{x1_, x1_}] -> X1,
X[{x1_, x2_}] X[{x2_, x1_}] -> X2,
X[{x1_, x2_}] X[{x2_, x3_}] X[{x3_, x1_}] -> X3,
X[{x1_, x2_}] X[{x2_, x3_}] X[{x3_, x4_}] X[{x4_, x1_}] -> X4}


list = {X[{a, a}],
   X[{a, b}] X[{b, a}],
   X[{a, b}] X[{b, c}] X[{c, a}],
   X[{a, b}] X[{b, c}] X[{c, d}] X[{d, a}],
   X[{2, 3}] X[{3, 5}] X[{5, aa}] X[{aa, 100}] X[{100, 2}],
   X[{a, b}] X[{b, c}] X[{c, z}]};

Replace[list, cyclicPatternRule /@ Range[5], 1]

{X1, X2, X3, X4, X5, X[{a, b}] X[{b, c}] X[{c, z}]}

Cases[pat : Alternatives @@ (cyclicPattern /@ Range[5]) :> 
    Symbol["Z" <> ToString[Length @ pat]]] @ list

{Z1, Z2, Z3, Z4, Z5}

  • $\begingroup$ Pretty neat answer. I think using Partition to produce the pattern is an awesome move, thanks ^^ $\endgroup$ – JuanC97 Feb 10 '20 at 15:38

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.