Rosetta Code

Minimum multiple of m where digital sum equals m: Difference between revisions

Page Discussion

Minimum multiple of m where digital sum equals m (view source)

Revision as of 15:38, 30 January 2022

2,026 bytes added ,  2 years ago
→‎{{header|Free Pascal}}: over strechted limit to 100 in 3.2 s
(Add FOCAL)
(→‎{{header|Free Pascal}}: over strechted limit to 100 in 3.2 s)
Line 696:
=={{header|Pascal}}==
==={{header|Free Pascal}}===
over strechted limit to 100.
Constructing minimal start number with sum of digits = m -> k+9+9+9+9+9+9 <BR>
Break up in parts of 4 digits.Could be more optimized.
Up to 100 at home.
<lang pascal>
program m_by_n_sumofdgts_m;
//Like https://oeis.org/A131382/b131382.txt
{$IFDEF FPC} {$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$ENDIF}
uses
sysutils;
const
BASE = 10;
BASE4 = BASE*BASE*BASE*BASE;
var
{$ALIGN 32}
DtgBase4 :array[0..7] of Uint32;
DtgPartSums :array[0..7] of Uint32;
DgtSumBefore :array[0..7] of Uint32;
SoD: array[0..BASE4-1] of byte;
procedure Init_SoD;
var
Line 713 ⟶ 719:
begin
i := 0;
For d1 := 0 to BASE-1 do
For d0 := 0 to BASE-1 do
begin SoD[i]:= d1+d0;inc(i); end;
 
j := Base*Base;
For i := 1 to Base*Base-1 do
For d1 := 0 to BASE-1 do
For d0 := 0 to BASE-1 do
begin
SoD[j] := SoD[i]+d1+d0;
inc(j);
end;
end;
 
procedure OutDgt;
var
i : integer;
begin
for i := 5 downto 0 do
write(DtgBase4[i]:4);
writeln;
for i := 5 downto 0 do
write(DtgPartSums[i]:4);
writeln;
for i := 5 downto 0 do
write(DgtSumBefore[i]:4);
writeln;
end;
 
procedure InitDigitSums(n:NativeUint);
function SumOfDigits(n:nativeUint):NativeUint;
var
q i,s: NativeUint;
begin
resultFor i := 0; to 4 do
while n>0 do
begin
qs := n DIVMOD BASE4;
resultDtgBase4[i] +:= SoD[n-BASE4*q]s;
nDtgPartSums[i] := qSoD[s];
n := n DIV BASE4;
end;
end;
 
s := 0;
For i := 3 downto 0 do
begin
s += DtgPartSums[i+1];
DgtSumBefore[i]:= s;
end;
end;
 
procedure CorrectSums(sum:NativeUint);
var
i : NativeInt;
begin
sum -= Base4;
DtgBase4[0] := sum;
DtgPartSums[0] := SoD[sum];
 
i := 1;
repeat
sum := DtgBase4[i]+1;
if sum < BASE4 then
begin
DtgBase4[i] := sum;
DtgPartSums[i] := SoD[sum];
BREAK;
end;
sum -= Base4;
DtgBase4[i] := sum;
DtgPartSums[i] := SoD[sum];
inc(i);
until i > 4;
 
sum := 0;
For i := 3 downto 0 do
begin
sum += DtgPartSums[i+1];
DgtSumBefore[i]:= sum;
end;
end;
 
function CalcN(n,m:NativeUint):NativeUint;
var
dgtsum,sum,delta: NativeInt;
begin
InitDigitSums(n);
sum := DtgBase4[0];
dgtSum:= m-DgtSumBefore[0];
// while dgtsum+SoD[sum] <> m do
while dgtsum<>SoD[sum] do
begin
inc(n,m);
inc(sum,m);
If sum>=Base4 then
repeat
CorrectSums(sum);
sum -= Base4;
dgtSum:= m-DgtSumBefore[0];
IF dgtSum <= 36{SoD[BASE4-1])} then
BREAK;
//now jump over 4 digits
{
IF dgtSum <= 72{2*SoD[BASE4-1])} then
jump over 8 digits
}
//Base4-1< sum <Base4-1+m
delta := ((BASE4-1-sum) DIV m +1)*m;
n+=delta;
sum += delta;
until false
end;
DtgPartSums[0] := SoD[sum];
DtgBase4[0] := sum;
result := n;
end;
 
var
T0:INt64;
i : NativeInt;
m,n: NativeUint;
Begin
T0 := GetTickCount64;
Init_SoD;
for m := 1 to 90100 do
begin
n := m;
//constructing minimal number with sum of digits = m ;k+9+9+9+9+9+9
//21 -> 299
if n>BASE then
begin
Line 761 ⟶ 857:
//make n multiple of m
n := (n div m)*m;
//m ending in 0
i := m;
while i mod BASE = 0 do
Line 767 ⟶ 863:
n *= BASE;
i := i div BASE;
end;
end;
whilen SumOfDigits:= CalcN(n)<> ,m do);
incwrite(n, DIV m:14);
write(n DIV m:11);
if m mod 10 = 0 then
writeln;
end;
writeln(GetTickCount64-T0,' ms');
{$IFDEF WINDOWS} readln{$ENDIF}
end.
</lang>
{{out|@TIO.RUN}}
<pre>
Real time: 43.161341 s CPU share: 99.3549 %
1 1 1 1 1 1 1 1 1 19
19 4 19 19 13 28 28 11 46 199
19 109 73 37 199 73 37 271 172 1333
289 559 1303 847 1657 833 1027 1576 1282 17497
4339 2119 2323 10909 11111 12826 14617 14581 16102 199999
17449 38269 56413 37037 1108909 142498 103507 154981 150661 1333333
163918 322579 315873 937342 1076923 1030303 880597 1469116 1157971 12842857
4084507 5555554 6849163 37027027 13333333 11710513 11686987 11525641 12656962 374999986
12345679 60852439 72168553 82142857 117647047 93022093 103445977 227272726 112247191 1111111111
658010989 652173913 731172043 849893617 2947368421 2083333228 1030927834 3969377551 11101010101 199999999999
 
3205 ms
@home: ..100
...
12345679 60852439 72168553 82142857 117647047 93022093 103445977 227272726 112247191 1111111111
658010989 652173913 731172043 849893617 2947368421 2083333228 1030927834 3969377551 11101010101 199999999999
 
real 1m15,075 // 99 takes the longest time.
</pre>
 
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/319137"