I want a function that does the same job like ReplaceRepeated
, and can make the matching process visible.
I searched the Internet but didn't find any existing code or package that meets my requirement, so I tried to write one:
Clear[myReplaceRepeated];
myReplaceRepeated[lis_List, rule_, n_: Infinity] :=
Module[{variables, mat = rule[[1]], data, tem},
variables =
ToExpression@
StringCases[
ToString[mat], (vars : WordCharacter ..) ~~ "_" | "__" | "___" :> vars];
If[variables != {},
testQ = Table[Cases[#1, #2 -> i, {0}], {i, variables}] &;
data =
Reap[FixedPointList[(Sow[testQ[#, mat]]; # /. rule) &, lis,
n]][[2, 1]];
Labeled[Grid[Prepend[data, variables], Frame -> All,
Background -> {Lighter /@
Hue /@ Range[0, 1, 1/Length[variables]]}],
Column[{lis, "the rule is", rule}], Top],
Labeled[
Grid[tem = Most@FixedPointList[# /. rule &, lis, n], Frame -> All,
Background -> {None, {Lighter /@
Hue /@ Range[0, 1, 1/Length[tem]]}}],
Column[{lis, "the rule is", rule}], Top]
]]
It works in some cases:
Example 1
myReplaceRepeated[{1, 3, 1, 4, 1, 3, 4, 2, 7, 1, 8},
{Longest[a___], b_, c__, b_, d___} -> {b, b, a, c, d}]
Example 2
myReplaceRepeated[{1, a, 2, b, 3, c}, _?NumericQ -> F[Infinity], 4](*4 is set the MaxIterations*)
Example 3
myReplaceRepeated[{1, 2}, {a_, b_} -> {{a}, {b}}, 5]](*5 is also set the MaxIterations*)
but fails in some other cases:
myReplaceRepeated[f[a][b][c][d], g_[x_][y__] -> g[x, y]]
myReplaceRepeated[Log[Sqrt[a (b c^d)^e]], {Log[x_ y_] :> Log[x] + Log[y], Log[x_^k_] :> k Log[x]}]
How to improve my myReplaceRepeated
?
Is there really no existing tool for the visualization of pattern matching?
Edit:
Let me explain my function with the following example.
lis = {1, 3, 1, 4, 1, 3, 4, 2, 7, 1, 8};
rule = {Longest[a___], b_, c__, b_, d___} -> {b, b, a, c, d};
mat(*short for match*) = rule[[1]];
I want to know how those variables i.e. a
,b
,c
and d
in rule
match the sub-sequence in lis
when lis //. rule
executes.
To monitor how those variables match, I need to first know what variables rule
contain:
variables =
ToExpression@StringCases[
ToString[mat], (vars : WordCharacter ..) ~~ "_" | "__" | "___" :> vars]
{a, b, c, b, d}
Then I find out how these variables match lis
respectively, for example the following piece of code shows a
matches 1, 3, 1, 4
in lis
.
Notice the level is {0}
, otherwise we get {}
Cases[{1, 3, 1, 4, 1, 3, 4, 2, 7, 1,
8}, {Longest[a___], b_, c__, b_, d___} -> a, {0}]
{1, 3, 1, 4}
These are combined in a loop.
Table[Cases[{1, 3, 1, 4, 1, 3, 4, 2, 7, 1,
8}, {Longest[a___], b_, c__, b_, d___} -> i, {0}], {i, variables}]
{{1, 3, 1, 4}, {1}, {3, 4, 2, 7}, {1}, {8}}
The output means a
represents {1, 3, 1, 4}
,b
represents {1}
, c
represents {3, 4, 2, 7}
, the next b
represents the latter {1}
and d
represents {8}
in lis
.
Then I define a testQ
to combine all these together:
testQ = Module[{variables},
variables =
ToExpression@
StringCases[
ToString[#2], (vars : WordCharacter ..) ~~
"_" | "__" | "___" :> vars];
Table[Cases[#1, #2 -> i, {0}], {i, variables}]] &;
testQ[lis, mat]
{{1, 3, 1, 4}, {1}, {3, 4, 2, 7}, {1}, {8}}
The functionality of ReplaceRepeated
is achieved by FixedPointList
:
data = Reap[
FixedPointList[(Sow[
testQ[#,
mat]]; # /. {Longest[a___], b_, c__, b_, d___} -> {b, b, a, c,
d}) &, {1, 3, 1, 4, 1, 3, 4, 2, 7, 1, 8}]][[2, 1]];
Grid@data
This is almost the output of example 1, except for the coloring.
You may noticed that the variables
in the above code can't be {}
, so a rule
like
lis = {1, a, 2, b, 3, c}; rule = _?NumericQ -> F[Infinity];
variables =
ToExpression@
StringCases[
ToString[mat], (vars : WordCharacter ..) ~~ "_" | "__" | "___" :> vars]
{}
will cause problem, that's why I add a If
in myReplaceRepeated
.
So long my code gets the ability to handle example 1 ~ 3, but if lis
and rule
are:
lis = f[a][b][c][d]; rule = g_[x_][y__] -> g[x, y]; mat = rule[[1]];
variables =
ToExpression@
StringCases[
ToString[mat], (vars : WordCharacter ..) ~~ "_" | "__" | "___" :>
vars]!={}
True
My program fails, how to fix it?