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

(Fixed)
 
(One intermediate revision by one other user not shown)
Line 2:
 
: 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>
Anonymous user