Talk:Digital root/Multiplicative digital root: Difference between revisions

From Rosetta Code
Content added Content deleted
(Second task and example are inconsistent.)
 
 
(2 intermediate revisions by 2 users not shown)
Line 1: Line 1:
The second task "tabulate MP versus the first five numbers having that MP" is inconsistent with the sample output. Assuming the output values are correct, the task should say "tabulate MDR versus the first five numbers having that MDR", and the "MD" column in the output should be "MDR".
The second task "tabulate MP versus the first five numbers having that MP" is inconsistent with the sample output. Assuming the output values are correct, the task should say "tabulate MDR versus the first five numbers having that MDR", and the "MD" column in the output should be "MDR". --Globules 06:00:08, 20 April 2014 (UTC)

: I've fixed that. Values with an MP of 9 seem to be rather large (I stopped looking at 20000000). --[[User:Rdm|Rdm]] ([[User talk:Rdm|talk]]) 08:39, 20 April 2014 (UTC)

I've promoted this to a task. It's got a clear description, and it's got more than 4 implementations in different languages. –[[User:Dkf|Donal Fellows]] ([[User talk:Dkf|talk]]) 15:58, 27 April 2014 (UTC)

== The product of decimal digits must be a humble numbers ( 2^a*3^b*5^c*7^d ) ==

Decimal digits 2..9 are humble numbers<br>
1 does not change anything. 0 stops.
<lang pascal>program MultRoot;
{$IFDEF FPC}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}
{$ENDIF}
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils;
const
//mul digit of 277777788888899 = 4996238671872
lnMax = ln(4996238671873);//ln(High(Uint64));
type
tnm = record
nmNum : Uint64;
nmLnNum : double;
nmPots: array[0..3] of byte;
nmMulRoot,
nmMulPers : Int16;
end;
tHumble = array[0..4679{15540}] of tnm;
var
Humble : tHumble;
idx: Uint32;

Procedure QuickSort ( Left, Right : LongInt );
Var
i, j : LongInt;
pivot : Uint64;
tmp : tnm;
Begin
i:=Left;
j:=Right;
pivot := Humble[(Left + Right) shr 1].nmNum;
Repeat
While pivot > Humble[i].nmNum Do inc(i);
While pivot < Humble[j].nmNum Do dec(j);

If i<=j Then Begin
tmp:=Humble[i];
Humble[i]:=Humble[j];
Humble[j]:=tmp;
dec(j);
inc(i);
End;
Until i>j;
If Left<j Then QuickSort(Left,j);
If i<Right Then QuickSort(i,Right);
End;

function GetMulDigits(n:Uint64):UInt64;
//inserting only numbers without any '0'
var
i,q :Uint64;
begin
i := 1;
repeat
q := n div 10;
i := (n-10*q)*i;
n := q;
until (i= 0) OR (n= 0);
GetMulDigits := i;
end;

procedure Insert(prime,NumIdx:Uint32);
var
lnPot,
lnPotSum:double;
potNum : Uint64;
i,j,pot :Uint32;
begin
i := idx+1;
pot := 0;
potNum := 1;
lnPot := ln(prime);
lnPotSum := 0.0;
repeat
inc(pot);
potNum := potNum*prime;
lnPotSum := pot*lnPot;
if lnPotSum>lnMax then
BREAK;
for j := 0 to idx do
begin
//ends in '0' 2^x*5*y //x,y > 0 will stay 0
if (numIdx = 2) AND (Humble[j].nmPots[0]<> 0) then continue;
Humble[i] := Humble[j];
with Humble[i] do
begin
if (Potnum>0) AND (nmLnNum+lnPotSum < lnMax) then
begin
nmLnNum := nmLnNum+lnPotSum;
nmNum := nmNum*potNum;
nmPots[NumIdx] := pot;
nmMulRoot := -1;
nmMulPers := 0;
inc(i);
end;
end;
end;
until false;
idx := i-1;

writeln('insert powers of ',prime,' new count ',idx);
end;

procedure OutHumble(h:tnm);
var
s : string[23];
n,last : UInt64;
i,p : Uint32;
ch: char;
begin
with h do
begin
write(h.nmMulPers:3,' : ');
n := nmNum;
For i := 0 to 3 do write(nmPots[i]:3);
//creating smallest number which digits multiply to n
setlength(s,23);
//extract '9'
s[1] := ' ';
p:= 2;
while nmPots[1]>1 do
begin
s[p] :=('9');inc(p);
nmPots[1] := nmPots[1]-2;
end;
//'8'
while nmPots[0]>2 do
begin
s[p] :=('8');inc(p);
nmPots[0] := nmPots[0]-3;
end;
//'7'
while nmPots[3]>0 do
begin
s[p] :=('7');inc(p);
nmPots[3] := nmPots[3]-1;
end;
//'6'
while (nmPots[0]>0) AND (nmPots[1]>0) do
begin
s[p] :=('6');inc(p);
nmPots[0] := nmPots[0]-1;
nmPots[1] := nmPots[1]-1;
end;
//'5'
while (nmPots[2]>0)do
begin
s[p] :=('5');inc(p);
nmPots[2] := nmPots[2]-1;
end;
//'4'
while (nmPots[0]>1)do
begin
s[p] :=('4');inc(p);
nmPots[0] := nmPots[0]-2;
end;
//'3'
if (nmPots[1]>0) then
begin
s[p] :=('3');inc(p);
end;
//'2'
if nmPots[0]>0 then
begin
s[p] :=('2');inc(p);
end;
i := 2;
p := p-1;
setlength(s,p);
//swap digits
while i<p do
begin
ch:= s[i];
s[i] := s[p];
s[p] := ch;
inc(i);
dec(p);
end;
if n >= 10 then
write(s,'->',n)
else
write(' ',n);
last := n;
//
n := GetMulDigits(n);
if last <> n then
begin
repeat
write('->',n);
last := n;
n := GetMulDigits(n);
until last=n;
end;
writeln;
end;
end;
var
n,last : Uint64;
i,j : Uint32;
begin
Humble[0].nmNum :=1;

Insert(2,0);
Insert(3,1);
Insert(5,2);
Insert(7,3);
//remove numbers with one '0' digit
j:= 0;
For i := 0 to Idx do
begin
if GetMulDigits(Humble[i].nmNum) <> 0 then
Begin
Humble[j] := Humble[i];
inc(j);
end;
end;
idx := j-1;
writeln('remove numbers with "0" digit.Remaining ',idx);

QuickSort(0,idx);

For i := 0 to Idx do
begin
j :=0;
n := Humble[i].nmNum;
last := n;
n := GetMulDigits(n);
if last <> n then
begin
j := 1;
repeat
inc(j);
last := n;
n := GetMulDigits(n);
until last=n;
end;
Humble[i].nmMulRoot:= n;
Humble[i].nmMulPers:= j;
end;

For i := 0 to idx do
OutHumble(Humble[i]);
{$IFDEF WINDOWS}
write(' done. Press <ENTER>');readln;
{$ENDIF}
end.
Whats special about 277777788888899
277,777,788,888,899
</lang>
{{out|@TIO.RUN}}
<pre>
//Real time: 0.134 s User time: 0.094 s
insert powers of 2 new count 42
insert powers of 3 new count 595
insert powers of 5 new count 833
insert powers of 7 new count 4679
remove numbers with "0" digit.Remaining 2096
mulpersistance : pot 2,3,5,7
0 : 0 0 0 0 1
0 : 1 0 0 0 2
0 : 0 1 0 0 3
0 : 2 0 0 0 4
0 : 0 0 1 0 5
0 : 1 1 0 0 6
0 : 0 0 0 1 7
0 : 3 0 0 0 8
0 : 0 2 0 0 9
2 : 2 1 0 0 26->12->2
2 : 1 0 0 1 27->14->4
2 : 0 1 1 0 35->15->5
2 : 4 0 0 0 28->16->6
2 : 1 2 0 0 29->18->8
2 : 0 1 0 1 37->21->2
2 : 3 1 0 0 38->24->8

.... 267777777899999->smallest number with mul dgt of -> humble 2^5*3^11*5^0*7^7 =4668421498272

6 : 5 11 0 7 267777777899999->4668421498272->74317824->37632->756->210->0
3 : 6 21 0 1 37889999999999->4686238234944->191102976->0
3 : 0 13 2 6 355777777999999->4689262665675->1567641600->0
3 : 31 7 0 0 68888888888999->4696546738176->1097349120->0
3 : 11 9 0 6 267777778889999->4742523426816->15482880->0
3 : 0 3 4 10 3555577777777779->4766769826875->10241925120->0
3 : 2 20 0 3 47779999999999->4783868198172->260112384->0
3 : 27 6 0 2 77888888888999->4794391461888->334430208->0
3 : 0 1 9 7 35555555557777777->4825447265625->129024000->0
3 : 23 5 0 4 267777888888899->4894274617344->130056192->0
4 : 13 6 0 7 277777778888999->4918172442624->6193152->1620->0
11 : 19 4 0 6 277777788888899->4996238671872->438939648->4478976->338688->27648->2688->768->336->54->20->0</pre>

Latest revision as of 19:39, 7 December 2021

The second task "tabulate MP versus the first five numbers having that MP" is inconsistent with the sample output. Assuming the output values are correct, the task should say "tabulate MDR versus the first five numbers having that MDR", and the "MD" column in the output should be "MDR". --Globules 06:00:08, 20 April 2014 (UTC)

I've fixed that. Values with an MP of 9 seem to be rather large (I stopped looking at 20000000). --Rdm (talk) 08:39, 20 April 2014 (UTC)

I've promoted this to a task. It's got a clear description, and it's got more than 4 implementations in different languages. –Donal Fellows (talk) 15:58, 27 April 2014 (UTC)

The product of decimal digits must be a humble numbers ( 2^a*3^b*5^c*7^d )

Decimal digits 2..9 are humble numbers
1 does not change anything. 0 stops. <lang pascal>program MultRoot; {$IFDEF FPC} 

 {$MODE DELPHI}{$OPTIMIZATION ON,ALL}

{$ENDIF} {$IFDEF WINDOWS} 

 {$APPTYPE CONSOLE}

{$ENDIF} uses 

 sysutils;

const 

 //mul digit of 277777788888899 = 4996238671872
 lnMax = ln(4996238671873);//ln(High(Uint64));

type 

 tnm = record
         nmNum : Uint64;
         nmLnNum : double;
         nmPots: array[0..3] of byte;
         nmMulRoot,
         nmMulPers : Int16;
       end;
 tHumble = array[0..4679{15540}] of tnm;

var 

 Humble : tHumble;
 idx: Uint32;

Procedure QuickSort ( Left, Right : LongInt ); Var 

 i, j : LongInt;
 pivot : Uint64;
 tmp : tnm;

Begin 

 i:=Left;
 j:=Right;
 pivot := Humble[(Left + Right) shr 1].nmNum;
 Repeat
   While pivot > Humble[i].nmNum Do inc(i);
   While pivot < Humble[j].nmNum Do dec(j);

   If i<=j Then Begin
     tmp:=Humble[i];
     Humble[i]:=Humble[j];
     Humble[j]:=tmp;
     dec(j);
     inc(i);
   End;
 Until i>j;
 If Left<j Then QuickSort(Left,j);
 If i<Right Then QuickSort(i,Right);

End;

function GetMulDigits(n:Uint64):UInt64; //inserting only numbers without any '0' var 

 i,q :Uint64;

begin 

 i := 1;
 repeat
   q := n div 10;
   i := (n-10*q)*i;
   n := q;
 until (i= 0) OR (n= 0);
 GetMulDigits := i;

end;

procedure Insert(prime,NumIdx:Uint32); var 

 lnPot,
 lnPotSum:double;
 potNum : Uint64;
 i,j,pot :Uint32;

begin 

 i := idx+1;
 pot := 0;
 potNum := 1;
 lnPot := ln(prime);
 lnPotSum := 0.0;
 repeat
   inc(pot);
   potNum := potNum*prime;
   lnPotSum := pot*lnPot;
   if lnPotSum>lnMax then
     BREAK;
   for j := 0 to idx do
   begin
     //ends in '0' 2^x*5*y //x,y > 0 will stay 0
     if (numIdx = 2) AND (Humble[j].nmPots[0]<> 0) then  continue;
     Humble[i] := Humble[j];
     with Humble[i] do
     begin
       if (Potnum>0) AND (nmLnNum+lnPotSum < lnMax) then
       begin
         nmLnNum := nmLnNum+lnPotSum;
         nmNum := nmNum*potNum;
         nmPots[NumIdx] := pot;
         nmMulRoot := -1;
         nmMulPers := 0;
         inc(i);
       end;
     end;
   end;
 until false;
 idx := i-1;

 writeln('insert powers of ',prime,' new count ',idx);

end;

procedure OutHumble(h:tnm); var 

 s : string[23];
 n,last : UInt64;
 i,p : Uint32;
 ch: char;

begin 

 with h do
 begin
   write(h.nmMulPers:3,' : ');
   n := nmNum;
   For i := 0 to 3 do write(nmPots[i]:3);
   //creating smallest number which digits multiply to n
   setlength(s,23);
   //extract '9'
   s[1] := ' ';
   p:= 2;
   while nmPots[1]>1 do
   begin
     s[p] :=('9');inc(p);
     nmPots[1] := nmPots[1]-2;
   end;
   //'8'
   while nmPots[0]>2 do
   begin
     s[p] :=('8');inc(p);
     nmPots[0] := nmPots[0]-3;
   end;
   //'7'
   while nmPots[3]>0 do
   begin
     s[p] :=('7');inc(p);
     nmPots[3] := nmPots[3]-1;
   end;
   //'6'
   while (nmPots[0]>0) AND (nmPots[1]>0) do
   begin
     s[p] :=('6');inc(p);
     nmPots[0] := nmPots[0]-1;
     nmPots[1] := nmPots[1]-1;
   end;
   //'5'
   while (nmPots[2]>0)do
   begin
     s[p] :=('5');inc(p);
     nmPots[2] := nmPots[2]-1;
   end;
   //'4'
   while (nmPots[0]>1)do
   begin
     s[p] :=('4');inc(p);
     nmPots[0] := nmPots[0]-2;
   end;
   //'3'
   if (nmPots[1]>0) then
   begin
     s[p] :=('3');inc(p);
   end;
   //'2'
   if nmPots[0]>0 then
   begin
     s[p] :=('2');inc(p);
   end;
   i := 2;
   p := p-1;
   setlength(s,p);
   //swap digits

while i

= 10 then write(s,'->',n) else write(' ',n); last := n; // n := GetMulDigits(n); if last <> n then begin repeat write('->',n); last := n; n := GetMulDigits(n); until last=n; end; writeln; end; end; var n,last : Uint64; i,j : Uint32; begin Humble[0].nmNum :=1; Insert(2,0); Insert(3,1); Insert(5,2); Insert(7,3); //remove numbers with one '0' digit j:= 0; For i := 0 to Idx do begin if GetMulDigits(Humble[i].nmNum) <> 0 then Begin Humble[j] := Humble[i]; inc(j); end; end; idx := j-1; writeln('remove numbers with "0" digit.Remaining ',idx); QuickSort(0,idx); For i := 0 to Idx do begin j :=0; n := Humble[i].nmNum; last := n; n := GetMulDigits(n); if last <> n then begin j := 1; repeat inc(j); last := n; n := GetMulDigits(n); until last=n; end; Humble[i].nmMulRoot:= n; Humble[i].nmMulPers:= j; end; For i := 0 to idx do OutHumble(Humble[i]); {$IFDEF WINDOWS} write(' done. Press <ENTER>');readln; {$ENDIF} end. Whats special about 277777788888899 277,777,788,888,899 </lang>

@TIO.RUN:
//Real time: 0.134 s User time: 0.094 s
insert powers of 2 new count 42
insert powers of 3 new count 595
insert powers of 5 new count 833
insert powers of 7 new count 4679
remove numbers with "0" digit.Remaining 2096
mulpersistance : pot 2,3,5,7 
  0 :   0  0  0  0      1
  0 :   1  0  0  0      2
  0 :   0  1  0  0      3
  0 :   2  0  0  0      4
  0 :   0  0  1  0      5
  0 :   1  1  0  0      6
  0 :   0  0  0  1      7
  0 :   3  0  0  0      8
  0 :   0  2  0  0      9
  2 :   2  1  0  0 26->12->2
  2 :   1  0  0  1 27->14->4
  2 :   0  1  1  0 35->15->5
  2 :   4  0  0  0 28->16->6
  2 :   1  2  0  0 29->18->8
  2 :   0  1  0  1 37->21->2
  2 :   3  1  0  0 38->24->8

....  267777777899999->smallest number with mul dgt of -> humble 2^5*3^11*5^0*7^7  =4668421498272

  6 :   5 11  0  7 267777777899999->4668421498272->74317824->37632->756->210->0
  3 :   6 21  0  1 37889999999999->4686238234944->191102976->0
  3 :   0 13  2  6 355777777999999->4689262665675->1567641600->0
  3 :  31  7  0  0 68888888888999->4696546738176->1097349120->0
  3 :  11  9  0  6 267777778889999->4742523426816->15482880->0
  3 :   0  3  4 10 3555577777777779->4766769826875->10241925120->0
  3 :   2 20  0  3 47779999999999->4783868198172->260112384->0
  3 :  27  6  0  2 77888888888999->4794391461888->334430208->0
  3 :   0  1  9  7 35555555557777777->4825447265625->129024000->0
  3 :  23  5  0  4 267777888888899->4894274617344->130056192->0
  4 :  13  6  0  7 277777778888999->4918172442624->6193152->1620->0
 11 :  19  4  0  6 277777788888899->4996238671872->438939648->4478976->338688->27648->2688->768->336->54->20->0
Retrieved from "https://rosettacode.org/wiki/Talk:Digital_root/Multiplicative_digital_root?oldid=246299"