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$ Commented Feb 10, 2020 at 6:08

1 Answer 1


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
    Commented Feb 10, 2020 at 15:38

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.