Obtaining the number of iterations used in ReplaceRepeated

Question

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  *)

Answer 1

i = 0;
number = 11113132434242342342342342535646657758768872132131111119;
sumrule = value_ :> (i++; Total[IntegerDigits[value]]);
number //. sumrule
i

This is a quick and dirty way to do this.

Answer 2

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}

Answer 3

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}