How to resolve the algorithm Minimum multiple of m where digital sum equals m step by step in the Pascal programming language
Published on 12 May 2024 09:40 PM
How to resolve the algorithm Minimum multiple of m where digital sum equals m step by step in the Pascal programming language
Table of Contents
Problem Statement
Generate the sequence a(n) when each element is the minimum integer multiple m such that the digit sum of n times m is equal to n.
Let's start with the solution:
Step by Step solution about How to resolve the algorithm Minimum multiple of m where digital sum equals m step by step in the Pascal programming language
Source code in the pascal programming language
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;
MAXDGTSUM4 = 4*(BASE-1);
var
{$ALIGN 32}
SoD: array[0..BASE4-1] of byte;
{$ALIGN 32}
DtgBase4 :array[0..7] of Uint32;
DtgPartSums :array[0..7] of Uint32;
DgtSumBefore :array[0..7] of Uint32;
procedure Init_SoD;
var
d0,d1,i,j : NativeInt;
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(m:NativeUint);
var
n,i,s: NativeUint;
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
begin
s := n MOD BASE4;
DtgBase4[i] := s;
DtgPartSums[i] := SoD[s];
n := (n-s) DIV BASE4;
end;
s := 0;
For i := 3 downto 0 do
begin
s += DtgPartSums[i+1];
DgtSumBefore[i]:= s;
end;
end;
function CorrectSums(sum:NativeUint):NativeUint;
var
i,q,carry : NativeInt;
begin
i := 0;
q := sum MOD Base4;
sum := sum DIV Base4;
result := q;
DtgBase4[i] := q;
DtgPartSums[i] := SoD[q];
carry := 0;
repeat
inc(i);
q := sum MOD Base4+DtgBase4[i]+carry;
sum := sum DIV Base4;
carry := 0;
if q >= BASE4 then
begin
carry := 1;
q -= BASE4;
end;
DtgBase4[i]:= q;
DtgPartSums[i] := SoD[q];
until (sum =0) AND( carry = 0);
sum := 0;
For i := 3 downto 0 do
begin
sum += DtgPartSums[i+1];
DgtSumBefore[i]:= sum;
end;
end;
function TakeJump(dgtSum,m:NativeUint):NativeUint;
var
n,i,j,carry : nativeInt;
begin
i := dgtsum div MAXDGTSUM4-1;
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];
dgtSum:= m-DgtSumBefore[0];
// while dgtsum+SoD[sum] <> m do
while dgtsum<>SoD[sum] do
begin
inc(sum,m);
if sum >= BASE4 then
begin
sum := CorrectSums(sum);
dgtSum:= m-DgtSumBefore[0];
if dgtSum > MAXDGTSUM4 then
begin
sum := TakeJump(dgtSum,m);
dgtSum:= m-DgtSumBefore[0];
end;
end;
end;
DtgBase4[0] := sum;
end;
var
T0:INt64;
i : NativeInt;
m,n: NativeUint;
Begin
T0 := GetTickCount64;
Init_SoD;
for m := 1 to 70 do
begin
CalcN(m);
//Check sum of digits
n := SoD[DtgBase4[4]];
For i := 3 downto 0 do
n += SoD[DtgBase4[i]];
If n<>m then
begin
writeln('ERROR at ',m);
HALT(-1);
end;
n := DtgBase4[4];
For i := 3 downto 0 do
n := n*BASE4+DtgBase4[i];
write(n DIV m :15);
if m mod 10 = 0 then
writeln;
end;
writeln;
writeln('Total runtime ',GetTickCount64-T0,' ms');
{$IFDEF WINDOWS} readln{$ENDIF}
end.
You may also check:How to resolve the algorithm Brace expansion step by step in the Nim programming language
You may also check:How to resolve the algorithm Rep-string step by step in the Factor programming language
You may also check:How to resolve the algorithm Letter frequency step by step in the Raven programming language
You may also check:How to resolve the algorithm Sort an array of composite structures step by step in the Scala programming language
You may also check:How to resolve the algorithm Sum and product of an array step by step in the Ruby programming language