7
$\begingroup$

ReplaceRepeated has an option MaxIterations which indicates Mathematica is keeping track of the number of iterations. Is there a way to obtain the actual number of iterations used in an evaluation of ReplaceRepeated?

(The use case is to obtain the additive persistence of a number by counting the number of times we use a rule that sums digits until we end up with a single digit)

number = 11113132434242342342342342535646657758768872132131111119
sumrule = value_ :> Total[IntegerDigits[value]]
number //. sumrule
(*  and ideally a magic function, e.g., count = `InternalValue`Iterations  etc  *)
$\endgroup$
5
  • $\begingroup$ possible duplicate of How to visualize pattern matching process? $\endgroup$ – xzczd Feb 12 '15 at 13:21
  • $\begingroup$ @xzczd I don't see the duplication. The linked Q/answer/comments describe an entirely new function to visualize replace steps. Yes, you can count the iterations it uses. But I'm just seeking a single value query/return using the built-in ReplaceRepeated. $\endgroup$ – PlaysDice Feb 12 '15 at 13:29
  • $\begingroup$ But you're asking for "a way to obtain the actual number of replacement operation", not a option of ReplaceRepeated that demonstrate the actual number of replacement operation :) $\endgroup$ – xzczd Feb 12 '15 at 13:39
  • $\begingroup$ Edits made for 'clarity' $\endgroup$ – PlaysDice Feb 12 '15 at 13:53
  • $\begingroup$ Tangentially related: (20181) $\endgroup$ – Mr.Wizard Feb 12 '15 at 14:26
5
$\begingroup$

If we wish to handle an arbitrary list of rules in the second parameter of ReplaceRepeated we can by using a single wrapping rule with a counter and handing off the actual processing to ReplaceAll. This avoids the memory overhead of keeping all intermediate results for FixedPointList.

countReplace[expr_, rules_] :=
  Module[{i = -1},
    {expr //. all_ :> (i++; all /. rules), i}
  ]

Example:

countReplace[
  {17, 4381, 423},
  {x_ /; x > 200 :> x/2, x_ /; x > 10 :> x - 1, x_?Positive :> x - 0.3}
]
{{-0.2, -0.29375, -0.15}, 166}

This also works inside held expressions, as mentioned by Jacob:

countReplace[Hold[1728], n_Integer :> RuleCondition[n/2]]
{Hold[27/2], 7}

The example is contrived as I couldn't think of another replacement that would not be infinite. RuleCondition is used to force evaluation of the right-hand-side; that behavior is not characteristic of countReplace itself. Update: With Jacob's own example:

c = 3;

countReplace[HoldComplete @ Hold @ Hold @ c, Hold[c] :> c]
{HoldComplete[c], 2}
$\endgroup$
4
  • $\begingroup$ +1 for the embedded counter and starting at -1. $\endgroup$ – PlaysDice Feb 12 '15 at 18:01
  • $\begingroup$ +1. It took me a while to realise why the examples would cause infinite replacement and it was luck that my own example did not suffer from it. I also like the name countReplace. $\endgroup$ – Jacob Akkerboom Feb 13 '15 at 12:38
  • $\begingroup$ there's deep and then there's Mr Wizard DEEP ! Learning so much ! $\endgroup$ – PlaysDice Feb 13 '15 at 14:02
  • $\begingroup$ @PlaysDice And then there is Leonid deep. If you haven't discovered that layer yet order food in; you'll be reading for a while. ;-) $\endgroup$ – Mr.Wizard Feb 13 '15 at 18:30
7
$\begingroup$
i = 0;
number = 11113132434242342342342342535646657758768872132131111119;
sumrule = value_ :> (i++; Total[IntegerDigits[value]]);
number //. sumrule
i

This is a quick and dirty way to do this.

$\endgroup$
2
  • $\begingroup$ Hah! I didn't know you could just put a counter in a rule. I like quick and dirty. It seems to give an answer that is +1, perhaps due to a final 'ReplaceRepeated' which finds that there is no change. I can easily subtract one $\endgroup$ – PlaysDice Feb 12 '15 at 14:05
  • 1
    $\begingroup$ ReplaceRepeated needs to try one more time to do a ReplaceAll after value reaches 9 in order to verify that it is done. $\endgroup$ – bbgodfrey Feb 12 '15 at 15:01
4
$\begingroup$

Here is another solution, that works with a list of rules and with held expressions

cRepRep2[expr_, snd_] :=
 {Last@#, Length@# - 2} &@
  FixedPointList[# /. snd &, expr]

Here is a similar solution, that saves on memory by using FixedPoint rather than FixedPointList. It also works with held expressions

cRepRep3[expr_, snd_] :=
 Module[
  {c = -1, resExpr},
  resExpr = 
   FixedPoint[# /. snd &, expr, SameTest -> ((c++; SameQ[#, #2]) &)];
  {resExpr, c}
  ]

Below is the dirty way made into a function, which is less nice than the other solutions.

cRepRep[expr_, (Rule | RuleDelayed)[pat_, rep_]] :=
 Module[{c = 0},
  {ReplaceRepeated[expr, pat :> (c++; rep)], c}
  ]

Here is function that tries to let all the replacements be done by ReplaceRepeated, while also working for held expressions. Unfortunately there is a problem with it, which it shares with cRepRep, as we will see further below.

cRepRep4[expr_, (Rule | RuleDelayed)[pat_, rep_]] :=     
 cRepRep4[expr, {pat :> rep}]

cRepRep4[expr_, rules_List] :=
 Module[{c = 0, rLen, cIncrCondArrHeld, repsHeld, newRepsHeld, 
   newRulesHeld, resExpr},
  rLen = Length[rules];
  cIncrCondArrHeld = 
   DeleteCases[Hold@Evaluate@ConstantArray[Hold[c++; True], rLen], 
    Hold, {2, Infinity}, Heads -> True];
  repsHeld = Hold[rules][[All, All, 2]];
  newRepsHeld = 
   Apply[
    Condition, 
    Hold@Evaluate@Thread[Join[repsHeld, cIncrCondArrHeld]], {2}];
  newRulesHeld =
   Apply[RuleDelayed, 
    Hold@Evaluate@Thread@Prepend[newRepsHeld, rules[[All, 1]]], {2}];
  resExpr =
   ReplacePart[
    {
     expr,
     newRulesHeld
     }
    ,
    {0 -> ReplaceRepeated, {2, 0} -> Unevaluated}

    ];
  {resExpr, c}
  ]

Unfortunately ReplaceRepeated can terminate in two ways, which causes trouble. Either it makes a last replacement which results in the same expression, or all the rules fail to match. I think it is not straightforward, if at all possible, to get this information from ReplaceRepeated. Therefore cRepRep, cRepRep4 will fail, like in the following example.

c = 0; (*just to make things harder*)
cRepRep4[HoldComplete@Hold@Hold@c, {Hold[c] :> c}]
cRepRep4[number, {9-> 8, sumrule}]
{HoldComplete[c], 2} (*correct*)
{8, 5} (*count is one too high*)

Mr.Wizard's solution does not suffer from this because the replacement by the rules is really done by ReplaceAll and the rule in ReplaceRepeated always matches, so that ReplaceRepeated always terminates because of "identical expressions".

Good examples

c = 3; (*just to make things harder*)
cRepRep3[HoldComplete@Hold@Hold@c, Hold[c] :> c]
cRepRep3[number, {9 -> 8, sumrule}]
{HoldComplete[c], 2}
{8, 4}
$\endgroup$
8
  • $\begingroup$ Nice, thank you. Like Carlo's answer, it gives +1 more iterations than is 'needed', but I'm guessing MMA includes the final iteration where it sees no change from the (pen)ultimate iteration. So the MMA calculation requires #iterations + (1 final step with no change). but 'real world' iterations are c minus 1. $\endgroup$ – PlaysDice Feb 12 '15 at 14:15
  • $\begingroup$ ReplaceRepeated is able to handle a list of rules; it appears this function is not. Can you fix that? $\endgroup$ – Mr.Wizard Feb 12 '15 at 14:32
  • $\begingroup$ @Mr.Wizard ah yes I was not satisfied anyway. Let's see $\endgroup$ – Jacob Akkerboom Feb 12 '15 at 15:30
  • 1
    $\begingroup$ Cool. cRepRep2 gives the 'correct' answer for iterations = 3. Nice hinting by @Mr.Wizard with FixedPointList and his 20181 $\endgroup$ – PlaysDice Feb 12 '15 at 15:53
  • 1
    $\begingroup$ @Mr.Wizard I went into a coding frenzy, but failed to find a solution that uses ReplaceRepeated. My mistake was that I thought adding a rule _/;(c++;False) to the beginning of the list of rules would work, but here c++ gets evaluated to often. It is also hard to make things work for held expressions, as the original approach fails here. $\endgroup$ – Jacob Akkerboom Feb 12 '15 at 17:10

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.