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

Content added Content deleted
(Realize in F#)
m (→‎{{header|Free Pascal}}: increased jumps. Now until 110 posssible on TIO.RUN. Ending in 0 is extrem time consumig.)
Line 718: Line 718:
=={{header|Pascal}}==
=={{header|Pascal}}==
==={{header|Free Pascal}}===
==={{header|Free Pascal}}===
over strechted limit to 100.
over strechted limit to 110.
Constructing minimal start number with sum of digits = m -> k+9+9+9+9+9+9 <BR>
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.
Break up in parts of 4 digits.Could be more optimized.
<lang pascal>
<lang pascal>program m_by_n_sumofdgts_m;
program m_by_n_sumofdgts_m;
//Like https://oeis.org/A131382/b131382.txt
//Like https://oeis.org/A131382/b131382.txt
{$IFDEF FPC} {$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$ENDIF}
{$IFDEF FPC} {$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$ENDIF}
Line 730: Line 729:
BASE = 10;
BASE = 10;
BASE4 = BASE*BASE*BASE*BASE;
BASE4 = BASE*BASE*BASE*BASE;
MAXDGTSUM4 = 4*(BASE-1);
var
var
{$ALIGN 32}
SoD: array[0..BASE4-1] of byte;
{$ALIGN 32}
{$ALIGN 32}
DtgBase4 :array[0..7] of Uint32;
DtgBase4 :array[0..7] of Uint32;
DtgPartSums :array[0..7] of Uint32;
DtgPartSums :array[0..7] of Uint32;
DgtSumBefore :array[0..7] of Uint32;
DgtSumBefore :array[0..7] of Uint32;

SoD: array[0..BASE4-1] of byte;
procedure Init_SoD;
procedure Init_SoD;
var
var
Line 744: Line 747:
For d0 := 0 to BASE-1 do
For d0 := 0 to BASE-1 do
begin SoD[i]:= d1+d0;inc(i); end;
begin SoD[i]:= d1+d0;inc(i); end;

j := Base*Base;
j := Base*Base;
For i := 1 to Base*Base-1 do
For i := 1 to Base*Base-1 do
Line 754: Line 757:
end;
end;
end;
end;

procedure OutDgt;
procedure OutDgt;
var
var
Line 769: Line 772:
writeln;
writeln;
end;
end;

procedure InitDigitSums(n:NativeUint);
procedure InitDigitSums(m:NativeUint);
var
var
i,s: NativeUint;
n,i,s: NativeUint;
begin
begin
//constructing minimal number with sum of digits = m ;k+9+9+9+9+9+9
//21 -> 299
n := m;
if n>BASE then
begin
i := 1;
while n>BASE-1 do
begin
i *= BASE;
dec(n,BASE-1);
end;
n := i*(n+1)-1;
//make n multiple of m
n := (n div m)*m;
//m ending in 0
i := m;
while i mod BASE = 0 do
begin
n *= BASE;
i := i div BASE;
end;
end;
For i := 0 to 4 do
For i := 0 to 4 do
begin
begin
Line 779: Line 805:
DtgBase4[i] := s;
DtgBase4[i] := s;
DtgPartSums[i] := SoD[s];
DtgPartSums[i] := SoD[s];
n := n DIV BASE4;
n := (n-s) DIV BASE4;
end;
end;

s := 0;
s := 0;
For i := 3 downto 0 do
For i := 3 downto 0 do
Line 790: Line 816:
end;
end;


procedure CorrectSums(sum:NativeUint);
function CorrectSums(sum:NativeUint):NativeUint;
var
var
i : NativeInt;
i,q,carry : NativeInt;
begin
begin
sum -= Base4;
i := 0;
DtgBase4[0] := sum;
q := sum MOD Base4;
DtgPartSums[0] := SoD[sum];
sum := sum DIV Base4;
result := q;

i := 1;
DtgBase4[i] := q;
repeat
sum := DtgBase4[i]+1;
DtgPartSums[i] := SoD[q];
if sum < BASE4 then
carry := 0;
repeat
inc(i);
q := sum MOD Base4+DtgBase4[i]+carry;
sum := sum DIV Base4;
carry := 0;
if q >= BASE4 then
begin
begin
DtgBase4[i] := sum;
carry := 1;
DtgPartSums[i] := SoD[sum];
q -= BASE4;
BREAK;
end;
end;
sum -= Base4;
DtgBase4[i]:= q;
DtgBase4[i] := sum;
DtgPartSums[i] := SoD[q];
until (sum =0) AND( carry = 0);
DtgPartSums[i] := SoD[sum];
inc(i);
until i > 4;


sum := 0;
sum := 0;
Line 821: Line 852:
end;
end;


function CalcN(n,m:NativeUint):NativeUint;
function TakeJump(dgtSum,m:NativeUint):NativeUint;
var
var
dgtsum,sum,delta: NativeInt;
n,i,j,carry : nativeInt;
begin
begin
i := dgtsum div MAXDGTSUM4-1;
InitDigitSums(n);
n := 0;
j := 1;
for i := i downto 0 do
Begin
n:= n*BASE4+DtgBase4[i];
j:= j*BASE4;
end;
n := ((j-n) DIV m)*m;
// writeln(n:10,DtgBase4[i]:10);
i := 0;
carry := 0;
repeat
j := DtgBase4[i]+ n mod BASE4 +carry;
n := n div BASE4;
carry := 0;
IF j >=BASE4 then
begin
j -= BASE4;
carry := 1;
end;
DtgBase4[i] := j;
DtgPartSums[i]:= SoD[j];
inc(i);
until (n= 0) AND (carry=0);
j := 0;
For i := 3 downto 0 do
begin
j += DtgPartSums[i+1];
DgtSumBefore[i]:= j;
end;
result := DtgBase4[0];
end;

procedure CalcN(m:NativeUint);
var
dgtsum,sum: NativeInt;
begin
InitDigitSums(m);
sum := DtgBase4[0];
sum := DtgBase4[0];
dgtSum:= m-DgtSumBefore[0];
dgtSum:= m-DgtSumBefore[0];
Line 831: Line 901:
while dgtsum<>SoD[sum] do
while dgtsum<>SoD[sum] do
begin
begin
inc(n,m);
inc(sum,m);
inc(sum,m);
if sum >= BASE4 then
begin
If sum>=Base4 then
sum := CorrectSums(sum);
repeat
CorrectSums(sum);
dgtSum:= m-DgtSumBefore[0];
sum -= Base4;
if dgtSum > MAXDGTSUM4 then
begin
dgtSum:= m-DgtSumBefore[0];
IF dgtSum <= 36{SoD[BASE4-1])} then
sum := TakeJump(dgtSum,m);
BREAK;
dgtSum:= m-DgtSumBefore[0];
//now jump over 4 digits
end;
end;
{
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;
end;
DtgPartSums[0] := SoD[sum];
DtgBase4[0] := sum;
DtgBase4[0] := sum;
result := n;
end;
end;

var
var
T0:INt64;
T0:INt64;
Line 863: Line 923:
T0 := GetTickCount64;
T0 := GetTickCount64;
Init_SoD;
Init_SoD;
for m := 1 to 100 do
for m := 1 to 70 do
begin
begin
n := m;
CalcN(m);
//constructing minimal number with sum of digits = m ;k+9+9+9+9+9+9
//Check sum of digits
//21 -> 299
n := SoD[DtgBase4[4]];
For i := 3 downto 0 do
if n>BASE then
n += SoD[DtgBase4[i]];
If n<>m then
begin
begin
i := 1;
writeln('ERROR at ',m);
while n>BASE-1 do
HALT(-1);
begin
end;
i *= BASE;
dec(n,BASE-1);
n := DtgBase4[4];
end;
For i := 3 downto 0 do
n := i*(n+1)-1;
n := n*BASE4+DtgBase4[i];
write(n DIV m :15);
//make n multiple of m
n := (n div m)*m;
//m ending in 0
i := m;
while i mod BASE = 0 do
begin
n *= BASE;
i := i div BASE;
end;
end;
n := CalcN(n,m);
write(n DIV m:14);
if m mod 10 = 0 then
if m mod 10 = 0 then
writeln;
writeln;
end;
end;
writeln(GetTickCount64-T0,' ms');
writeln;
writeln('Total runtime ',GetTickCount64-T0,' ms');
{$IFDEF WINDOWS} readln{$ENDIF}
{$IFDEF WINDOWS} readln{$ENDIF}
end.
end.</lang>
</lang>
{{out|@TIO.RUN}}
{{out|@TIO.RUN}}
<pre>
<pre>
Real time: 3.341 s CPU share: 99.49 %
Real time: 36.660 s CPU share: 99.48 %
1 1 1 1 1 1 1 1 1 19
1 1 1 1 1 1 1 1 1 19
19 4 19 19 13 28 28 11 46 199
19 4 19 19 13 28 28 11 46 199
19 109 73 37 199 73 37 271 172 1333
19 109 73 37 199 73 37 271 172 1333
289 559 1303 847 1657 833 1027 1576 1282 17497
289 559 1303 847 1657 833 1027 1576 1282 17497
4339 2119 2323 10909 11111 12826 14617 14581 16102 199999
4339 2119 2323 10909 11111 12826 14617 14581 16102 199999
17449 38269 56413 37037 1108909 142498 103507 154981 150661 1333333
17449 38269 56413 37037 1108909 142498 103507 154981 150661 1333333
163918 322579 315873 937342 1076923 1030303 880597 1469116 1157971 12842857
163918 322579 315873 937342 1076923 1030303 880597 1469116 1157971 12842857

4084507 5555554 6849163 37027027 13333333 11710513 11686987 11525641 12656962 374999986
Total runtime 4 ms
12345679 60852439 72168553 82142857 117647047 93022093 103445977 227272726 112247191 1111111111
..100
658010989 652173913 731172043 849893617 2947368421 2083333228 1030927834 3969377551 11101010101 199999999999
4084507 5555554 6849163 37027027 13333333 11710513 11686987 11525641 12656962 374999986
3205 ms
12345679 60852439 72168553 82142857 117647047 93022093 103445977 227272726 112247191 1111111111
</pre>
658010989 652173913 731172043 849893617 2947368421 2083333228 1030927834 3969377551 11101010101 199999999999

Total runtime 642 ms
..110
28900990099 5881372549 6796115533 18173076922 27619047619 18679245283 18691495327 36111111111 44862385321 1090909090909

Total runtime 36486 ms
@home
111 79009009009 17882 ms
112 80356249999 17906 ms
113 78761061946 17910 ms
114 87710526307 17916 ms
115 426086956513 18022 ms
116 258620688793 18033 ms
117 255547008547 18035 ms
118 414406779661 18039 ms
119 411756302521 18040 ms
120 4999999999999 26838 ms

121 2809909090909 27273 ms
122 811475409754 27290 ms
123 730081300813 27291 ms
124 2419193548387 27328 ms
125 5599999999999 29177 ms
126 2380873015873 29181 ms
127 3148818897637 29183 ms
128 5468749999921 29328 ms
129 5348836434031 29334 ms
130 46076923076923 32383 ms

131 6106793893129 32386 ms
132 28030303030303 32559 ms
133 6766917293233 32560 ms
134 22388058880597 32577 ms
135 37037037037037 32665 ms
136 44044117647058 32712 ms
137 56919700729927 32774 ms
138 36231884057971 32775 ms
139 49568345323741 32775 ms
140 571427857142857 58364 ms

141 63822694964539 58366 ms
142 140140838028169 58378 ms
143 391606993006993 58606 ms
144 277777777777777 58698 ms
145 482751724137931 58929 ms
146 471917801369863 58959 ms
147 401360544217687 58961 ms
148 1081081081081081 59207 ms
149 536912751677851 59213 ms
150 13333333333333333 728689 ms</pre>


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