Own digits power sum: Difference between revisions

m
→‎{{header|Pascal}}: extend to 19 digits one more than ruby,hoping overflow will not generate the needed digits.
(→‎Combinations with repetitions: Separated Ruby and Raku examples.)
m (→‎{{header|Pascal}}: extend to 19 digits one more than ruby,hoping overflow will not generate the needed digits.)
Line 682:
uses
SysUtils;
 
const
MAXBASE = 10;//16;
MaxDgtVal = MAXBASE - 1;
MaxDgtCount = 19;
type
tDgtValtDgtCnt = 0..MaxDgtValMaxDgtCount;
tUsedDigitstValues = array[0..15] of Int8MaxDgtVal;
tPowertUsedDigits = array[tDgtVal0..31] of Uint64Int8;
tPower = array[tValues] of Uint64;
var
PowerDgt: array[tDgtValtDgtCnt] of tPower;
 
UD :tUsedDigits;
CombIdx: array of Int8;
Numbers : array of Uint32Uint64;
rec_cnt : NativeInt;
 
function InitCombIdx(ElemCount: Byte): pbyte;
begin
Line 703 ⟶ 705:
Result := @CombIdx[0];
end;
 
function Init(ElemCount:byte):pByte;
var
pP1,Pp2 : pUint64;
i, j: Int32;
begin
pP1 := @PowerDgt[low(tDgtCnt)];
for i in tValues do
pP1[i] := 1;
pP1[0] := 0;
for j := low(tDgtCnt) + 1 to High(tDgtCnt) do
Begin
pP2 := @PowerDgt[j];
for i in tValues do
pP2[i] := pP1[i]*i;
pP1 := pP2;
end;
result := InitCombIdx(ElemCount);
end;
 
function NextCombWithRep(pComb: pByte; MaxVal, ElemCount: UInt32): boolean;
var
i, dgt: NativeInt;
begin
i := -1;
Line 715 ⟶ 736:
break;
until i > ElemCount;
 
Result := i >= ElemCount;
dgt +=1;
Line 721 ⟶ 743:
i -= 1;
until i < 0;
end;
function Init(ElemCount:byte):pByte;
var
i, j: tDgtVal;
begin
for i in tDgtVal do
PowerDgt[low(tDgtVal), i] := 1;
for j := low(tDgtVal) + 1 to High(tDgtVal) do
for i in tDgtVal do
PowerDgt[j, i] := PowerDgt[j - 1, i] * i;
result := InitCombIdx(ElemCount);
end;
 
function GetPowerSum(minpot:nativeInt;digits:pbyte;var UD_tmp :tUsedDigits):NativeInt;
var
pPower : pUint64;
res,r,dgt : Uint64;
dgt :Int32;
begin
dgtpPower := @PowerDgt[minpot,0];
dgt := minpot-1;
res := 0;
pPower := @PowerDgt[dgt,0];
repeat
dgtr -:=1 res;
res += pPower[digits[dgt]];
until dgt< -=01;
until dgt<0;
//convert res into digits
result := minPot;
repeat
dec(result);
r := res DIV MAXBASE;
UD_tmp[res-r*MAXBASE]-= 1;
res := r;
dec(result);
until r = 0;
end;
 
procedure calcNum(minPot:Int32;digits:pbyte);
var
UD_tmpUD :tUsedDigits;
minPot,dgtres: nativeIntUint64;
resi: Uint32nativeInt;
begin
fillchar(UD,SizeOf(UD),#0);
For i := minpot-1 downto 0 do
minPot := 0UD[digits[i]]+=1;
i := GetPowerSum(minpot,digits,UD);
repeat
dgt := digits[minPot];
if dgt = 0 then
break;
UD[dgt]+=1;
inc(minPot);
until minPot > MaxDgtVal;
If (minPot<2) or (digits[0] = 1) then
EXIT;
 
//powersum to small
repeat
if i UD_tmp> :=0 UD;then
EXIT;
dgt := GetPowerSum(minpot,digits,UD_tmp);
if i //number= to0 smallthen
begin
if dgt > 0 then
while (i <= minPot) and (UD[digits[i]] = 0) do
break;
if dgt=0 theni +=1;
// all digits are in sum then solution found.
if i > minPot then
begin
dgtres := 10;
whilefor (dgti <:= MaxDgtVal)minpot-1 and (UD_tmp[dgt] =downto 0) do
dgtres +=1 PowerDgt[minpot,digits[i]];
setlength(Numbers, Length(Numbers) + 1);
if dgt > MaxDgtVal then
beginNumbers[high(Numbers)] := res;
res := 0;
for dgt := minpot-1 downto 0 do
res += PowerDgt[minpot,digits[dgt]];
setlength(Numbers, Length(Numbers) + 1);
Numbers[high(Numbers)] := res;
BREAK;
end;
end;
end;
//try one more 0
minPot +=1;
until minPot > MaxDgtVal;
end;
 
const
rounds = 128;
var
digits : pByte;
Line 810 ⟶ 804:
tmp: Uint64;
i, j : Int32;
 
begin
digits := Init(MaxDgtValMaxDgtCount);
//warm up
For i := 1 to 50 do
Begin
setlength(numbers,0);
digits := InitCombIdx(MaxDgtVal);
repeat
calcnum(digits);
until NextCombWithRep(digits,MaxDgtVal,MaxDgtVal);
end;
//warm up
T0 := GetTickCount64;
rec_cnt := 0;
For i := 13 to roundsMaxDgtCount do
Begin
digits := InitCombIdx(MaxDgtCount);
setlength(numbers,0);
digits := InitCombIdx(MaxDgtVal);
repeat
calcnum(i,digits);
inc(rec_cnt);
until NextCombWithRep(digits,MaxDgtVal,MaxDgtVali);
end;
T0 := GetTickCount64-T0;
writeln(rec_cnt DIV rounds,' recursions in runtime ',T0/rounds:5:2,' ms');
 
Line 847 ⟶ 830:
Numbers[j] := tmp;
end;
 
setlength(Numbers, j + 1);
for i := 0 to High(Numbers) do
writeln(i+1:3,Numbers[i]:1120);
{$IFDEF WINDOWS}
readln;
{$ENDIF}
end.</lang>
</lang>
{{out}}
<pre style="height:180px">
TIO.RUN CPU share: 99.49 %
//doing rounds = 1024 NextCombWithRep without calcnum(digits); takes: 48620 recursions in runtime 0.23 ms
20029944 recursions in runtime 1755.00 ms
TIO.RUN CPU share: 99.04 %
found 41
48620 recursions in runtime 3.63 ms //best on TIO.RUN ..5.11 ms
1 153
found 22
12 153 370
23 370 371
34 371 407
45 407 1634
56 1634 8208
67 8208 9474
78 9474 54748
89 54748 92727
10 9 92727 93084
1011 93084 548834
1112 548834 1741725
1213 1741725 4210818
1314 4210818 9800817
1415 9800817 9926315
1516 9926315 24678050
17 24678051
16 24678050
18 88593477
17 24678051
19 146511208
18 88593477
20 472335975
19 146511208
21 534494836
20 472335975
22 912985153
21 534494836
23 4679307774
22 912985153</pre>
24 32164049650
25 32164049651
26 40028394225
27 42678290603
28 44708635679
29 49388550606
30 82693916578
31 94204591914
32 28116440335967
33 4338281769391370
34 4338281769391371
35 21897142587612075
36 35641594208964132
37 35875699062250035
38 1517841543307505039
39 3289582984443187032
40 4498128791164624869
41 4929273885928088826</pre>
 
=={{header|Perl}}==
Anonymous user