Digital root/Multiplicative digital root: Difference between revisions

Content added Content deleted
(→‎{{header|PARI/GP}}: append =={header|Pascal}}== find the first 9 brute force)
m (→‎{{header|Free Pascal}}: first occurence of persistence 0..11 .Inline GetMulDigits)
Line 2,042: Line 2,042:
inspired by [[Worthwhile_task_shaving]] :-)<BR>
inspired by [[Worthwhile_task_shaving]] :-)<BR>
Brute force speed up GetMulDigits.
Brute force speed up GetMulDigits.
<lang pascal>
<lang pascal>program MultRoot;
program MultRoot;
{$IFDEF FPC}
{$IFDEF FPC}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=16}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=16}
Line 2,060: Line 2,059:
end;
end;
const
const
Testnumbers : array[0..14] of Uint64 =(123321,7739,893,899998,
Testnumbers : array[0..16] of Uint64 =(123321,7739,893,899998,
18446743999999999999,
18446743999999999999,
//first occurence of persistence 0..11
// From http://mathworld.wolfram.com/MultiplicativePersistence.html
29, 47, 277, 769, 8867, 186889, 2678789,
0,10,25,39,77,679, 6788, 68889, 2677889,
26899889, 3778888999, 277777788888899);
26888999, 3778888999, 277777788888899);


var
var
Line 2,083: Line 2,082:
end;
end;


function GetMulDigits(n:Uint64):UInt64;
function GetMulDigits(n:Uint64):UInt64;inline;
var
var
pMul3Dgt :^tMul3Dgt;
pMul3Dgt :^tMul3Dgt;
i,q :Uint64;
q :Uint64;
begin
begin
⚫
i := 1;
pMul3Dgt := @Mul3Dgt[0];
pMul3Dgt := @Mul3Dgt[0];
⚫
result := 1;
while n >= 1000 do
while n >= 1000 do
begin
begin
q := n div 1000;
q := n div 1000;
i *= pMul3Dgt^[n-1000*q];
result *= pMul3Dgt^[n-1000*q];
n := q;
n := q;
end;
end;
If n>=100 then
If n>=100 then
i *= Mul3Dgt[n]
result *= pMul3Dgt^[n]
else
else
if n>=10 then
if n>=10 then
i *= pMul3Dgt^[n+100]
result *= pMul3Dgt^[n+100]
else
else
i *= n;//pMul3Dgt^[n+110]
result *= n;//Mul3Dgt[n+110]
GetMulDigits := i;
end;
end;


Line 2,123: Line 2,121:


const
const
MaxCount = 9;
MaxDgtCount = 9;
var
var
//all initiated with 0
//all initiated with 0
MulRoot:tMulRoot;
MulRoot:tMulRoot;
Sol : array[0..9,0..MaxCount-1] of tMulRoot;
Sol : array[0..9,0..MaxDgtCount-1] of tMulRoot;
SolIds : array[0..9] of Int32;
SolIds : array[0..9] of Int32;
i,idx,mr,AlreadyDone : Int32;
i,idx,mr,AlreadyDone : Int32;

BEGIN
BEGIN
InitMulDgt;
InitMulDgt;


AlreadyDone := 10;
AlreadyDone := 10;//0..9
MulRoot.mrNum := 0;
MulRoot.mrNum := 0;
repeat
repeat
Line 2,139: Line 2,138:
mr := MulRoot.mrMul;
mr := MulRoot.mrMul;
idx := SolIds[mr];
idx := SolIds[mr];
If idx<MaxCount then
If idx<MaxDgtCount then
begin
begin
Sol[mr,idx]:= MulRoot;
Sol[mr,idx]:= MulRoot;
inc(idx);
inc(idx);
SolIds[mr]:= idx;
SolIds[mr]:= idx;
if idx =MaxCount then
if idx =MaxDgtCount then
dec(AlreadyDone);
dec(AlreadyDone);
end;
end;
Line 2,153: Line 2,152:
begin
begin
write(i:3,':');
write(i:3,':');
For idx := 0 to MaxCount-1 do
For idx := 0 to MaxDgtCount-1 do
write(Sol[i,idx].mrNum:MaxCount+1);
write(Sol[i,idx].mrNum:MaxDgtCount+1);
writeln;
writeln;
end;
end;
Line 2,172: Line 2,171:
{{out|@TIO.RUN}}
{{out|@TIO.RUN}}
<pre>
<pre>
Real time: 2.086 s CPU share: 99.47 % test til 111,111,111
Real time: 1.580 s CPU share: 99.59 % inline GetMulDigits ->runtime 100%->76%
MDR: First
MDR: First
0: 0 10 20 25 30 40 45 50 52
0: 0 10 20 25 30 40 45 50 52
Line 2,185: Line 2,184:
9: 9 19 33 91 119 133 191 313 331
9: 9 19 33 91 119 133 191 313 331


number mulroot persitance
number mulroot persistence
123321 8 3
123321 8 3
7739 8 3
7739 8 3
Line 2,191: Line 2,190:
899998 0 2
899998 0 2
18446743999999999999 0 2
18446743999999999999 0 2
29 8 2
0 0 0
47 6 3
10 0 1
277 4 4
25 0 2
769 6 5
39 4 3
8867 0 6
77 8 4
186889 0 7
679 6 5
2678789 0 8
6788 0 6
26899889 0 9
68889 0 7
2677889 0 8
26888999 0 9
3778888999 0 10
3778888999 0 10
277777788888899 0 11
277777788888899 0 11</pre>
</pre>


=={{header|Perl}}==
=={{header|Perl}}==
Retrieved from "https://rosettacode.org/wiki/Digital_root/Multiplicative_digital_root"