Own digits power sum: Difference between revisions

Content added Content deleted
(→‎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: Line 682:
uses
uses
SysUtils;
SysUtils;

const
const
MAXBASE = 10;//16;
MAXBASE = 10;
MaxDgtVal = MAXBASE - 1;
MaxDgtVal = MAXBASE - 1;
MaxDgtCount = 19;
type
type
tDgtVal = 0..MaxDgtVal;
tDgtCnt = 0..MaxDgtCount;
tUsedDigits = array[0..15] of Int8;
tValues = 0..MaxDgtVal;
tPower = array[tDgtVal] of Uint64;
tUsedDigits = array[0..31] of Int8;
tPower = array[tValues] of Uint64;
var
var
PowerDgt: array[tDgtVal] of tPower;
PowerDgt: array[tDgtCnt] of tPower;

UD :tUsedDigits;
CombIdx: array of Int8;
CombIdx: array of Int8;
Numbers : array of Uint32;
Numbers : array of Uint64;
rec_cnt : NativeInt;
rec_cnt : NativeInt;

function InitCombIdx(ElemCount: Byte): pbyte;
function InitCombIdx(ElemCount: Byte): pbyte;
begin
begin
Line 703: Line 705:
Result := @CombIdx[0];
Result := @CombIdx[0];
end;
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;
function NextCombWithRep(pComb: pByte; MaxVal, ElemCount: UInt32): boolean;
var
var
i, dgt: NativeInt;
i,dgt: NativeInt;
begin
begin
i := -1;
i := -1;
Line 715: Line 736:
break;
break;
until i > ElemCount;
until i > ElemCount;

Result := i >= ElemCount;
Result := i >= ElemCount;
dgt +=1;
dgt +=1;
Line 721: Line 743:
i -= 1;
i -= 1;
until i < 0;
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;
end;

function GetPowerSum(minpot:nativeInt;digits:pbyte;var UD_tmp :tUsedDigits):NativeInt;
function GetPowerSum(minpot:nativeInt;digits:pbyte;var UD_tmp :tUsedDigits):NativeInt;
var
var
pPower : pUint64;
pPower : pUint64;
res,r,dgt : Uint64;
res,r : Uint64;
dgt :Int32;
begin
begin
dgt := minpot;
pPower := @PowerDgt[minpot,0];
dgt := minpot-1;
res := 0;
res := 0;
pPower := @PowerDgt[dgt,0];
repeat
repeat
dgt -=1;
r := res;
res += pPower[digits[dgt]];
res += pPower[digits[dgt]];
until dgt<=0;
dgt -=1;
until dgt<0;
//convert res into digits
result := minPot;
result := minPot;
repeat
repeat
dec(result);
r := res DIV MAXBASE;
r := res DIV MAXBASE;
UD_tmp[res-r*MAXBASE]-= 1;
UD_tmp[res-r*MAXBASE]-= 1;
res := r;
res := r;
dec(result);
until r = 0;
until r = 0;
end;
end;

procedure calcNum(digits:pbyte);
procedure calcNum(minPot:Int32;digits:pbyte);
var
var
UD_tmp :tUsedDigits;
UD :tUsedDigits;
minPot,dgt: nativeInt;
res: Uint64;
res: Uint32;
i: nativeInt;
begin
begin
fillchar(UD,SizeOf(UD),#0);
fillchar(UD,SizeOf(UD),#0);
For i := minpot-1 downto 0 do
minPot := 0;
UD[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
UD_tmp := UD;
if i > 0 then
EXIT;
dgt := GetPowerSum(minpot,digits,UD_tmp);
//number to small
if i = 0 then
begin
if dgt > 0 then
while (i <= minPot) and (UD[digits[i]] = 0) do
break;
if dgt=0 then
i +=1;
// all digits are in sum then solution found.
if i > minPot then
begin
begin
dgt:= 1;
res := 0;
while (dgt <= MaxDgtVal) and (UD_tmp[dgt] = 0) do
for i := minpot-1 downto 0 do
dgt +=1;
res += PowerDgt[minpot,digits[i]];
setlength(Numbers, Length(Numbers) + 1);
if dgt > MaxDgtVal then
begin
Numbers[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;
end;
//try one more 0
minPot +=1;
until minPot > MaxDgtVal;
end;
end;


const
rounds = 128;
var
var
digits : pByte;
digits : pByte;
Line 810: Line 804:
tmp: Uint64;
tmp: Uint64;
i, j : Int32;
i, j : Int32;

begin
begin
digits := Init(MaxDgtVal);
digits := Init(MaxDgtCount);
//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;
T0 := GetTickCount64;
rec_cnt := 0;
rec_cnt := 0;
For i := 1 to rounds do
For i := 3 to MaxDgtCount do
Begin
Begin
digits := InitCombIdx(MaxDgtCount);
setlength(numbers,0);
digits := InitCombIdx(MaxDgtVal);
repeat
repeat
calcnum(digits);
calcnum(i,digits);
inc(rec_cnt);
inc(rec_cnt);
until NextCombWithRep(digits,MaxDgtVal,MaxDgtVal);
until NextCombWithRep(digits,MaxDgtVal,i);
end;
end;
T0 := GetTickCount64-T0;
T0 := GetTickCount64-T0;
writeln(rec_cnt DIV rounds,' recursions in runtime ',T0/rounds:5:2,' ms');
writeln(rec_cnt DIV rounds,' recursions in runtime ',T0/rounds:5:2,' ms');


Line 847: Line 830:
Numbers[j] := tmp;
Numbers[j] := tmp;
end;
end;

setlength(Numbers, j + 1);
setlength(Numbers, j + 1);
for i := 0 to High(Numbers) do
for i := 0 to High(Numbers) do
writeln(i+1:3,Numbers[i]:11);
writeln(i+1:3,Numbers[i]:20);
{$IFDEF WINDOWS}
{$IFDEF WINDOWS}
readln;
readln;
{$ENDIF}
{$ENDIF}
end.</lang>
end.
</lang>
{{out}}
{{out}}
<pre style="height:180px">
<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
1 153
2 370
2 370
3 371
3 371
4 407
4 407
5 1634
5 1634
6 8208
6 8208
7 9474
7 9474
8 54748
8 54748
9 92727
9 92727
10 93084
10 93084
11 548834
11 548834
12 1741725
12 1741725
13 4210818
13 4210818
14 9800817
14 9800817
15 9926315
15 9926315
16 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}}==
=={{header|Perl}}==
Retrieved from "https://rosettacode.org/wiki/Own_digits_power_sum"