The multiplicative digital root (MDR) and multiplicative persistence (MP) of a number, 



n


{\displaystyle n}

, is calculated rather like the Digital root except digits are multiplied instead of being added:

 Set 



m


{\displaystyle m}

 to 



n


{\displaystyle n}

 and 



i


{\displaystyle i}

 to 



0


{\displaystyle 0}

.
 While 



m


{\displaystyle m}

 has more than one digit:
 Find a replacement 



m


{\displaystyle m}

 as the multiplication of the digits of the current value of 



m


{\displaystyle m}

.
 Increment 



i


{\displaystyle i}

.
 Return 



i


{\displaystyle i}

 (= MP) and 



m


{\displaystyle m}

 (= MDR)


Task

 Tabulate the MP and MDR of the numbers 123321, 7739, 893, 899998
 Tabulate MDR versus the first five numbers having that MDR, something like:
MDR: [n0..n4]
===  ========
  0: [0, 10, 20, 25, 30]
  1: [1, 11, 111, 1111, 11111]
  2: [2, 12, 21, 26, 34]
  3: [3, 13, 31, 113, 131]
  4: [4, 14, 22, 27, 39]
  5: [5, 15, 35, 51, 53]
  6: [6, 16, 23, 28, 32]
  7: [7, 17, 71, 117, 171]
  8: [8, 18, 24, 29, 36]
  9: [9, 19, 33, 91, 119]

Show all output on this page.

Similar

The Product of decimal digits of n page was redirected here, and had the following description


Find the product of the decimal digits of a positive integer   n,   where n <= 100

The three existing entries for Phix, REXX, and Ring have been moved here, under ===Similar=== headings, feel free to match or ignore them.



References

 Multiplicative Digital Root on Wolfram Mathworld.
 Multiplicative digital root on The On-Line Encyclopedia of Integer Sequences.
 What's special about 277777788888899? - Numberphile video


program MultRoot;
{$IFDEF FPC}
  {$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=16}
{$ENDIF}
{$IFDEF WINDOWS}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils;
type
  tMul3Dgt = array[0..999] of Uint32;
  tMulRoot = record
               mrNum,
               mrMul,
               mrPers : Uint64;
             end;
const
  Testnumbers : array[0..16] of Uint64 =(123321,7739,893,899998,
                                        18446743999999999999,
    //first occurence of persistence 0..11
                                    0,10,25,39,77,679, 6788, 68889, 2677889,
                                        26888999, 3778888999, 277777788888899);
 
var
  Mul3Dgt : tMul3Dgt;
 
procedure InitMulDgt;
var
  i,j,k,l : Int32;
begin
  l := 999;
  For i := 9 downto 0 do
    For j := 9 downto 0 do
      For k := 9 downto 0 do
      Begin
        Mul3Dgt[l] := i*j*k;
        dec(l);
      end;
end;
 
function GetMulDigits(n:Uint64):UInt64;inline;
var
  pMul3Dgt :^tMul3Dgt;
  q :Uint64;
begin
  pMul3Dgt := @Mul3Dgt[0];
  result := 1;
  while n >= 1000 do
  begin
    q := n div 1000;
    result *= pMul3Dgt^[n-1000*q];
    n := q;
  end;
  If n>=100 then
    result *= pMul3Dgt^[n]
  else
    if n>=10 then
       result *= pMul3Dgt^[n+100]
    else
      result *= n;//Mul3Dgt[n+110]
end;
 
procedure GetMulRoot(var MulRoot:tMulRoot);
var
  mr,
  pers : UInt64;
Begin
  pers := 0;
  mr := MulRoot.mrNum;
  while mr >=10 do
  Begin
    mr := GetMulDigits(mr);
    inc(pers);
  end;
  MulRoot.mrMul:= mr;
  MulRoot.mrPers:= pers;
end;
 
const
  MaxDgtCount = 9;
var
  //all initiated with 0
  MulRoot:tMulRoot;
  Sol    : array[0..9,0..MaxDgtCount-1] of tMulRoot;
  SolIds : array[0..9] of Int32;
  i,idx,mr,AlreadyDone : Int32;
 
BEGIN
  InitMulDgt;
 
  AlreadyDone := 10;//0..9
  MulRoot.mrNum := 0;
  repeat
    GetMulRoot(MulRoot);
    mr := MulRoot.mrMul;
    idx := SolIds[mr];
    If idx<MaxDgtCount then
    begin
      Sol[mr,idx]:= MulRoot;
      inc(idx);
      SolIds[mr]:= idx;
      if idx =MaxDgtCount then
        dec(AlreadyDone);
    end;
    inc(MulRoot.mrNum);
  until AlreadyDone = 0;
  writeln('MDR: First');
  For i := 0 to 9 do
  begin
    write(i:3,':');
    For idx := 0 to MaxDgtCount-1 do
      write(Sol[i,idx].mrNum:MaxDgtCount+1);
    writeln;
  end;
  writeln;
  writeln('number':20,' mulroot   persitance');
  For i := 0 to High(Testnumbers) do
  begin
    MulRoot.mrNum := Testnumbers[i];
    GetMulRoot(MulRoot);
    With MulRoot do
      writeln(mrNum:20,mrMul:8,mrPers:8);
  end;
  {$IFDEF WINDOWS}
  readln;
  {$ENDIF}
END.