Digital root/Multiplicative digital root: Difference between revisions

→‎{{header|PARI/GP}}: append =={header|Pascal}}== find the first 9 brute force
(Add CLU)
(→‎{{header|PARI/GP}}: append =={header|Pascal}}== find the first 9 brute force)
Line 2,038:
<pre>%1 = [[3, 8], [3, 8], [3, 2], [2, 0]]
%2 = [[0, 10, 20, 25, 30], [1, 11, 111, 1111, 11111], [2, 12, 21, 26, 34], [3, 13, 31, 113, 131], [4, 14, 22, 27, 39], [5, 15, 35, 51, 53], [6, 16, 23, 28, 32], [7, 17, 71, 117, 171], [8, 18, 24, 29, 36], [9, 19, 33, 91, 119]]</pre>
=={{header|Pascal}}==
==={{header|Free Pascal}}===
inspired by [[Worthwhile_task_shaving]] :-)<BR>
Brute force speed up GetMulDigits.
<lang pascal>
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..14] of Uint64 =(123321,7739,893,899998,
18446743999999999999,
// From http://mathworld.wolfram.com/MultiplicativePersistence.html
29, 47, 277, 769, 8867, 186889, 2678789,
26899889, 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;
var
pMul3Dgt :^tMul3Dgt;
i,q :Uint64;
begin
i := 1;
pMul3Dgt := @Mul3Dgt[0];
while n >= 1000 do
begin
q := n div 1000;
i *= pMul3Dgt^[n-1000*q];
n := q;
end;
If n>=100 then
i *= Mul3Dgt[n]
else
if n>=10 then
i *= pMul3Dgt^[n+100]
else
i *= n;//pMul3Dgt^[n+110]
GetMulDigits := i;
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
MaxCount = 9;
var
//all initiated with 0
MulRoot:tMulRoot;
Sol : array[0..9,0..MaxCount-1] of tMulRoot;
SolIds : array[0..9] of Int32;
i,idx,mr,AlreadyDone : Int32;
BEGIN
InitMulDgt;
 
AlreadyDone := 10;
MulRoot.mrNum := 0;
repeat
GetMulRoot(MulRoot);
mr := MulRoot.mrMul;
idx := SolIds[mr];
If idx<MaxCount then
begin
Sol[mr,idx]:= MulRoot;
inc(idx);
SolIds[mr]:= idx;
if idx =MaxCount 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 MaxCount-1 do
write(Sol[i,idx].mrNum:MaxCount+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.</lang>
{{out|@TIO.RUN}}
<pre>
Real time: 2.086 s CPU share: 99.47 % test til 111,111,111
MDR: First
0: 0 10 20 25 30 40 45 50 52
1: 1 11 111 1111 11111 111111 1111111 11111111 111111111
2: 2 12 21 26 34 37 43 62 73
3: 3 13 31 113 131 311 1113 1131 1311
4: 4 14 22 27 39 41 72 89 93
5: 5 15 35 51 53 57 75 115 135
6: 6 16 23 28 32 44 47 48 61
7: 7 17 71 117 171 711 1117 1171 1711
8: 8 18 24 29 36 38 42 46 49
9: 9 19 33 91 119 133 191 313 331
 
number mulroot persitance
123321 8 3
7739 8 3
893 2 3
899998 0 2
18446743999999999999 0 2
29 8 2
47 6 3
277 4 4
769 6 5
8867 0 6
186889 0 7
2678789 0 8
26899889 0 9
3778888999 0 10
277777788888899 0 11
</pre>
 
=={{header|Perl}}==
Anonymous user