1
$\begingroup$

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]

However, 

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?

Improve this question
$\endgroup$
1
  • $\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

Reset to default
3
$\begingroup$

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}

Usage:

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}

Improve this answer
$\endgroup$
1
  • $\begingroup$ Pretty neat answer. I think using Partition to produce the pattern is an awesome move, thanks ^^ $\endgroup$ Commented Feb 10, 2020 at 15:38

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.