12
$\begingroup$

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}]

enter image description here

Example 2

myReplaceRepeated[{1, a, 2, b, 3, c}, _?NumericQ -> F[Infinity], 4](*4 is set the MaxIterations*)

From "Mathematica Cookbook"

Example 3

myReplaceRepeated[{1, 2}, {a_, b_} -> {{a}, {b}}, 5]](*5 is also set the MaxIterations*)

From "Mathematica Cookbook"

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

enter image description here

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?

Improve this question
$\endgroup$
4
  • $\begingroup$ It's an interesting question, but I don't quite understand the rule of the colorization. Could you explain it more please? $\endgroup$ Commented Feb 10, 2015 at 8:32
  • $\begingroup$ I tried to improve the expressions of your question. (Wish I didn't make it worse… ) Well, To be honest, personally I feel your Edit a little verbose… $\endgroup$ Commented Feb 11, 2015 at 3:48
  • $\begingroup$ @xzczd Thank you indeed. Your English is better than mine. SE is really have a typeset than Baidu tieba sites. $\endgroup$ Commented Feb 11, 2015 at 5:08
  • $\begingroup$ Related: (17660) $\endgroup$ Commented Feb 11, 2015 at 8:25

1 Answer 1

Reset to default
10
$\begingroup$

There exists a simple trick for your purpose, here is my implementation:

f[a][b][c][d] //. g_[x_][y__] :> g[x, y] /; (Print[g[x][y] -> g[x, y]]; True)

enter image description here

Log[Sqrt[a (b c^d)^e]] //. {Log[x_ y_] :> Log[x] + Log[y] /; (Print[Log[x y] -> Log[x] + Log[y]]; True), Log[x_^k_] :> k Log[x] /; (Print[Log[x^k] -> k Log[x]]; True)}

enter image description here

Not as colorful as yours, but you can use the trick therein as the core of your myReplaceRepeated.

Update

Here's my trial for a general function monitoring pattern-matching. Needless to say, achieving a perfectly general monitoring function is hard and I'm sure (Yeah, sure) my function will fail under more complicated situations, but it at least works for your samples.

ClearAll[show] SetAttributes[show, HoldAll] show[f_] := Module[{i = 1}, Quiet[ReleaseHold[ Hold[f] /. (Except[MaxIterations, a_] -> b_) :> a :> Evaluate[b] /. (a_ :> b_) :> a :> b /; (Print[(a /. Longest | Shortest | Repeated | RepeatedNull -> List /. Pattern :> Composition[Evaluate, Sequence @@ # &, With[{color = ColorData[1][i++]}, (Style[#, color] &) /@ #] &, Most, List]) -> b]; True)], RuleDelayed::rhs]]

This function is (naively) attempted to handle all the code involving pattern-matching that explicitly containing Rule or RuleDelayed. Let's try it.

Example 1:

show[{1, 3, 1, 4, 1, 3, 4, 2, 7, 1, 8} //. {Longest[a___], b_, c__, b_, d___} :> {b, b, a, c, d}]

enter image description here

Here the scope of different patterns are marked by different colors, and the scope of Longest is additionally marked by {}.

Example 2:

show@ReplaceRepeated[{1, a, 2, b}, _?NumericQ -> F[Infinity], MaxIterations -> 2]

enter image description here

To relieve the embarrassment I cut down the size of this example, I admit that for this example the visual effect of your myReplaceRepeated beats my show, but show does monitor the matching process.

Example 3:

show@ReplaceRepeated[{1, 2}, {a_, b_} -> {{a}, {b}}, MaxIterations -> 5]

enter image description here

Notice in this and the previous example the Except[MaxIterations, a_] part in the definition of show plays a role. If you want to make this function more general, more exceptions should be included in this part. (Or maybe I should think out a completely new testing method?)

Example 4:

show[f[a][b][c][d] //. g_[x_][y__] -> g[x, y]]

enter image description here

Notice that in this example the Evaluate inside Composition is necessary or the Sequence won't disappear.

Example 5:

show[Log[Sqrt[a (b c^d)^e]] //. {Log[x_ y_] :> Log[x] + Log[y], Log[x_^k_] :> k Log[x]}]

enter image description here

This example is actually the simplest among the 5.

As mentioned above, the show function is still quite incomplete, but you can use it as a start. I may also improve it later, but now I'd like to go to bed :)

Improve this answer
$\endgroup$
6
  • 1
    $\begingroup$ You may want to look into using Reap and Sow instead of Print if you want full control of the outputted rules. $\endgroup$ Commented Feb 10, 2015 at 15:25
  • $\begingroup$ @ChipHurst I understand what you mean.If I use Sow and Reap and combine his method,my solution can be shorter $\endgroup$ Commented Feb 10, 2015 at 15:44
  • 2
    $\begingroup$ @ChipHurst Yeah, Reap and Sow is undoubtedly a better choice. The initial intention of this answer is only to show that trick so I chose the relatively simpler Print to avoid distraction :) $\endgroup$ Commented Feb 10, 2015 at 16:21
  • 1
    $\begingroup$ @user15961 You don't need to accept that quick, feel free to wait for 24 hours or more so your question may attract better answers. $\endgroup$ Commented Feb 11, 2015 at 2:08
  • 1
    $\begingroup$ Regarding evaluation you might find interest in my mkMatchRules function posted in answer to the question linked in the comment below this question. You already have my vote of course. $\endgroup$ Commented Feb 11, 2015 at 8:28

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.