Own digits power sum: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎Python :: Functional: Pruned an unused function, tidied.)
Line 594: Line 594:
=={{header|Pascal}}==
=={{header|Pascal}}==
recursive solution.Just counting the different combination of digits<BR>
recursive solution.Just counting the different combination of digits<BR>
See [[Combinations_with_repetitions]]<BR>
1,2,..8,9->11,12,13..19->22....>99999999->111111111<BR>
recognize that in this case 1 = 10 = 100 = 1000 ...or 123 = 231 = 321 = 3000021 ...
<lang pascal>program PowerOwnDigits;
<lang pascal>program PowerOwnDigits;
{$IFDEF FPC}
{$IFDEF FPC}
Line 603: Line 602:
uses
uses
SysUtils;
SysUtils;

const
const
MAXBASE = 10;//16;
MAXBASE = 10;//16;
Line 609: Line 608:
type
type
tDgtVal = 0..MaxDgtVal;
tDgtVal = 0..MaxDgtVal;
tUsedDigits = array[tDgtVal] of Int32;
tUsedDigits = array[0..15] of Int8;
tPower = array[tDgtVal] of Uint64;
var
var
PowerDgt: array[tDgtVal] of tPower;
UD :tUsedDigits;
UD :tUsedDigits;
CombIdx: array of Int8;
digits: tUsedDigits;
PowerDgt: array[tDgtVal, tDgtVal] of Uint64;
Numbers : array of Uint32;
Numbers: array of Uint64;
rec_cnt : NativeInt;
rec_cnt : NativeInt;

function InitCombIdx(ElemCount: Byte): pbyte;
procedure InitPowerDgt;
begin
setlength(CombIdx, ElemCount + 1);
Fillchar(CombIdx[0], sizeOf(CombIdx[0]) * (ElemCount + 1), #0);
Result := @CombIdx[0];
end;
function NextCombWithRep(pComb: pByte; MaxVal, ElemCount: UInt32): boolean;
var
i, dgt: NativeInt;
begin
i := -1;
repeat
i += 1;
dgt := pComb[i];
if dgt < MaxVal then
break;
until i > ElemCount;
Result := i >= ElemCount;
dgt +=1;
repeat
pComb[i] := dgt;
i -= 1;
until i < 0;
end;
function Init(ElemCount:byte):pByte;
var
var
i, j: tDgtVal;
i, j: tDgtVal;
begin
begin
for i in tDgtVal do
for i in tDgtVal do
begin
digits[i] := 0;
PowerDgt[low(tDgtVal), i] := 1;
PowerDgt[low(tDgtVal), i] := 1;
end;
for j := low(tDgtVal) + 1 to High(tDgtVal) do
for j := low(tDgtVal) + 1 to High(tDgtVal) do
for i in tDgtVal do
for i in tDgtVal do
PowerDgt[j, i] := PowerDgt[j - 1, i] * i;
PowerDgt[j, i] := PowerDgt[j - 1, i] * i;
result := InitCombIdx(ElemCount);
end;
end;

function GetPowerSum(minpot:nativeInt;digits:pbyte;var UD_tmp :tUsedDigits):NativeInt;
procedure calcNum;
var
pPower : pUint64;
res,r,dgt : Uint64;
begin
dgt := minpot;
res := 0;
pPower := @PowerDgt[dgt,0];
repeat
dgt -=1;
res += pPower[digits[dgt]];
until dgt<=0;
result := minPot;
repeat
r := res DIV MAXBASE;
UD_tmp[res-r*MAXBASE]-= 1;
res := r;
dec(result);
until r = 0;
end;
procedure calcNum(digits:pbyte);
var
var
UD_tmp :tUsedDigits;
UD_tmp :tUsedDigits;
r,res: Uint64;
minPot,dgt: nativeInt;
minPot,maxPot,dgt: integer;
res: Uint32;
begin
begin
fillchar(UD,SizeOf(UD),#0);
fillchar(UD,SizeOf(UD),#0);

minPot := 0;
minPot := 0;
repeat
repeat
Line 647: Line 693:
inc(minPot);
inc(minPot);
until minPot > MaxDgtVal;
until minPot > MaxDgtVal;

If (minPot<2) or (digits[0] = 1) then
If (minPot<2) or (digits[0] = 1) then
EXIT;
EXIT;

//maxPot > minPot = number of inserted zeros
maxPot := minPot;
repeat
repeat
UD_tmp := UD;
UD_tmp := UD;
res := 0;
dgt := GetPowerSum(minpot,digits,UD_tmp);
for dgt := minpot-1 downto 0 do
res += PowerDgt[maxpot,digits[dgt]];
dgt := maxPot;
repeat
r := res DIV MAXBASE;
UD_tmp[res-r*MAXBASE]-= 1;
res := r;
dec(dgt);
until r = 0;
//number to small
//number to small
if dgt > 0 then
if dgt > 0 then
Line 676: Line 712:
res := 0;
res := 0;
for dgt := minpot-1 downto 0 do
for dgt := minpot-1 downto 0 do
res += PowerDgt[maxpot,digits[dgt]];
res += PowerDgt[minpot,digits[dgt]];
setlength(Numbers, Length(Numbers) + 1);
setlength(Numbers, Length(Numbers) + 1);
Numbers[high(Numbers)] := res;
Numbers[high(Numbers)] := res;
Line 683: Line 719:
end;
end;
//try one more 0
//try one more 0
maxPot +=1;
minPot +=1;
until maxPot > MaxDgtVal;
until minPot > MaxDgtVal;
end;

function IncDigit:boolean;
var
pDigits : pInt32;
i,dgt : NativeInt;
begin
pDigits := @digits[0];
inc(rec_cnt);
i := -1;
repeat
i += 1;
dgt := pdigits[i]+1;
if dgt <= MaxDgtVal then
break;
until i > MaxDgtVal;
result := i >= MaxDgtVal;

repeat
pdigits[i] := dgt;
i -= 1;
until i<0;
end;
end;


const
rounds = 128;
var
var
digits : pByte;
T0 : Int64;
T0 : Int64;
tmp: Uint64;
tmp: Uint64;
i, j : Int32;
i, j : Int32;

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


writeln('found ',length(Numbers));
writeln('found ',length(Numbers));
writeln(rec_cnt,' recursions in runtime ',T0,' ms');
//sort
//sort
for i := 0 to High(Numbers) - 1 do
for i := 0 to High(Numbers) - 1 do
Line 734: Line 767:
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(Numbers[i]);
writeln(i+1:3,Numbers[i]:11);
{$IFDEF WINDOWS}
{$IFDEF WINDOWS}
readln;
readln;
{$ENDIF}
{$ENDIF}
end.</lang>
end.</lang>
{{out}}
{{out}}
<pre style="height:180px">
<pre style="height:180px">
//doing 1000-times IncDigit until overflow takes: 48620000 recursions in runtime 253 ms->0,253 ms for one turn
//doing rounds = 1024 NextCombWithRep without calcnum(digits); takes: 48620 recursions in runtime 0.23 ms

TIO.RUN CPU share: 99.04 %
TIO.RUN CPU share: 99.04 %
48620 recursions in runtime 3.63 ms //best on TIO.RUN ..5.11 ms
found 22
found 22
1 153
48620 recursions in runtime 6 ms
2 370
153
3 371
370
4 407
371
5 1634
407
6 8208
1634
7 9474
8208
8 54748
9474
9 92727
54748
10 93084
92727
11 548834
93084
12 1741725
548834
13 4210818
1741725
14 9800817
4210818
15 9926315
9800817
16 24678050
9926315
17 24678051
24678050
18 88593477
24678051
19 146511208
88593477
20 472335975
146511208
21 534494836
472335975
22 912985153</pre>
534494836
912985153</pre>


=={{header|Perl}}==
=={{header|Perl}}==

Revision as of 13:16, 29 October 2021

Own digits power sum is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Description

For the purposes of this task, an own digits power sum is a decimal integer which is N digits long and is equal to the sum of its individual digits raised to the power N.


Example

The three digit integer 153 is an own digits power sum because 1³ + 5³ + 3³ = 1 + 125 + 27 = 153.


Task

Find and show here all own digits power sums for N = 3 to N = 8 inclusive.

Optionally, do the same for N = 9 which may take a while for interpreted languages.

ALGOL 68

Avoids spliting the digits using division and modulo operations. Includes the Wren optimisation of if the last digit = 0 then the same number but with last digit = 1 is also a suitable number. <lang algol68># find n digit numbers N such that the sum of the nth powers of their digits = N # FOR n FROM 3 TO 9 DO

   INT fdigit = 10 - n;
   [ 1 :  8 ]INT f; FOR i TO 8 DO f[ i ] := IF i = fdigit THEN 1 ELSE 0 FI OD;
   [ 1 :  8 ]INT t; FOR i TO 8 DO t[ i ] := IF i < fdigit THEN 0 ELSE 9 FI OD;
   [ 0 : 10 ]INT power; FOR i FROM LWB power TO UPB power DO power[ i ] := i ^ n OD;
   INT max n = power[ 10 ];
   FOR d1 FROM f[ 1 ] TO t[ 1 ] DO
       INT p1 = power[ d1 ];
       INT s1 = d1 * 10;
       FOR d2 FROM f[ 2 ] TO t[ 2 ] WHILE INT p2 = power[ d2 ] + p1;
                                          p2 < max n
       DO
           INT s2 = ( s1 + d2 ) * 10;
           FOR d3 FROM f[ 3 ] TO t[ 3 ] WHILE INT p3 = power[ d3 ] + p2;
                                              p3 < max n
           DO
               INT s3 = ( s2 + d3 ) * 10;
               FOR d4 FROM f[ 4 ] TO t[ 4 ] WHILE INT p4 = power[ d4 ] + p3;
                                                  p4 < max n
               DO
                   INT s4 = ( s3 + d4 ) * 10;
                   FOR d5 FROM f[ 5 ] TO t[ 5 ] WHILE INT p5 = power[ d5 ] + p4;
                                                      p5 < max n
                   DO
                       INT s5 = ( s4 + d5 ) * 10;
                       FOR d6 FROM f[ 6 ] TO t[ 6 ] WHILE INT p6 = power[ d6 ] + p5;
                                                          p6 < max n
                       DO
                           INT s6 = ( s5 + d6 ) * 10;
                           FOR d7 FROM f[ 7 ] TO t[ 7 ] WHILE INT p7 = power[ d7 ] + p6;
                                                              p7 < max n
                           DO
                               INT s7 = ( s6 + d7 ) * 10;
                               FOR d8 FROM f[ 8 ] TO t[ 8 ] WHILE INT p8 = power[ d8 ] + p7;
                                                                  p8 < max n
                               DO
                                   INT s8 = ( s7 + d8 ) * 10;
                                   IF s8 = p8 THEN
                                       # found a number with 0 as the final digit #
                                       # the same number with a final digit of 1  #
                                       # must also match the requirements         #
                                       print( ( whole( s8,     0 ), newline ) );
                                       print( ( whole( s8 + 1, 0 ), newline ) )
                                   FI;
                                   FOR d9 FROM 2 TO 9 WHILE INT p9 = power[ d9 ] + p8;
                                                                p9 < max n
                                   DO
                                       INT s9 = s8 + d9;
                                       IF  s9 = p9
                                       THEN
                                           print( ( whole( s9, 0 ), newline ) )
                                       FI
                                   OD
                               OD
                           OD
                       OD
                   OD
               OD
           OD
       OD
   OD

OD</lang>

Output:
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477
146511208
472335975
534494836
912985153

C

Iterative (slow)

Takes about 1.9 seconds to run (GCC 9.3.0 -O3).

Translation of: Wren

<lang c>#include <stdio.h>

  1. include <math.h>
  1. define MAX_DIGITS 9

int digits[MAX_DIGITS];

void getDigits(int i) {

   int ix = 0;
   while (i > 0) {
       digits[ix++] = i % 10;
       i /= 10;
   }

}

int main() {

   int n, d, i, max, lastDigit, sum, dp;
   int powers[10] = {0, 1, 4, 9, 16, 25, 36, 49, 64, 81};
   printf("Own digits power sums for N = 3 to 9 inclusive:\n");
   for (n = 3; n < 10; ++n) {
       for (d = 2; d < 10; ++d) powers[d] *= d;
       i = (int)pow(10, n-1);
       max = i * 10;
       lastDigit = 0;
       while (i < max) {
           if (!lastDigit) {
               getDigits(i);
               sum = 0;
               for (d = 0; d < n; ++d) {
                   dp = digits[d];
                   sum += powers[dp];
               }
           } else if (lastDigit == 1) {
               sum++;
           } else {
               sum += powers[lastDigit] - powers[lastDigit-1];
           }
           if (sum == i) {
               printf("%d\n", i);
               if (lastDigit == 0) printf("%d\n", i + 1);
               i += 10 - lastDigit;
               lastDigit = 0;
           } else if (sum > i) {
               i += 10 - lastDigit;
               lastDigit = 0;
           } else if (lastDigit < 9) {
               i++;
               lastDigit++;
           } else {
               i++;
               lastDigit = 0;
           }
       }
   }
   return 0;

}</lang>

Output:
Same as Wren example.


Recursive (very fast)

Translation of: Pascal

Down now to 14ms. <lang c>#include <stdio.h>

  1. include <string.h>
  1. define MAX_BASE 10

typedef unsigned long long ulong;

int usedDigits[MAX_BASE]; ulong powerDgt[MAX_BASE][MAX_BASE]; ulong numbers[60]; int nCount = 0;

void initPowerDgt() {

   int i, j;
   powerDgt[0][0] = 0;
   for (i = 1; i < MAX_BASE; ++i) powerDgt[0][i] = 1;
   for (j = 1; j < MAX_BASE; ++j) {
       for (i = 0; i < MAX_BASE; ++i) {
           powerDgt[j][i] = powerDgt[j-1][i] * i;
       }
   }

}

ulong calcNum(int depth, int used[MAX_BASE]) {

   int i;
   ulong result = 0, r, n;
   if (depth < 3) return 0;
   for (i = 1; i < MAX_BASE; ++i) {
       if (used[i] > 0) result += powerDgt[depth][i] * used[i];
   }
   if (result == 0) return 0;
   n = result;
   do {
       r = n / MAX_BASE;
       used[n-r*MAX_BASE]--;
       n = r;
       depth--;
   } while (r);
   if (depth) return 0;
   i = 1;
   while (i < MAX_BASE && used[i] == 0) i++;
   if (i >= MAX_BASE) numbers[nCount++] = result;
   return 0;

}

void nextDigit(int dgt, int depth) {

   int i, used[MAX_BASE];
   if (depth < MAX_BASE-1) {
       for (i = dgt; i < MAX_BASE; ++i) {
           usedDigits[dgt]++;
           nextDigit(i, depth+1);
           usedDigits[dgt]--;
       }
   }
   if (dgt == 0) dgt = 1;
   for (i = dgt; i < MAX_BASE; ++i) {
       usedDigits[i]++;
       memcpy(used, usedDigits, sizeof(usedDigits));
       calcNum(depth, used);
       usedDigits[i]--;
   }

}

int main() {

   int i, j;
   ulong t;
   initPowerDgt();
   nextDigit(0, 0);
   // sort and remove duplicates
   for (i = 0; i < nCount-1; ++i) {
       for (j = i + 1; j < nCount; ++j) {
           if (numbers[j] < numbers[i]) {
               t = numbers[i];
               numbers[i] = numbers[j];
               numbers[j] = t;
           }
       }
   }
   j = 0;
   for (i = 1; i < nCount; ++i) {
       if (numbers[i] != numbers[j]) {
           j++;
           t = numbers[i];
           numbers[i] = numbers[j];
           numbers[j] = t;
       }
   }
   printf("Own digits power sums for N = 3 to 9 inclusive:\n");
   for (i = 0; i <= j; ++i) printf("%lld\n", numbers[i]);
   return 0;

}</lang>

Output:
Same as before.

F#

<lang fsharp> // Own digits power sum. Nigel Galloway: October 2th., 2021 let fN g=let N=[|for n in 0..9->pown n g|] in let rec fN g=function n when n<10->N.[n]+g |n->fN(N.[n%10]+g)(n/10) in (fun g->fN 0 g) {3..9}|>Seq.iter(fun g->let fN=fN g in printf $"%d{g} digit are:"; {pown 10 (g-1)..(pown 10 g)-1}|>Seq.iter(fun g->if g=fN g then printf $" %d{g}"); printfn "") </lang>

Output:
3 digit are: 153 370 371 407
4 digit are: 1634 8208 9474
5 digit are: 54748 92727 93084
6 digit are: 548834
7 digit are: 1741725 4210818 9800817 9926315
8 digit are: 24678050 24678051 88593477
9 digit are: 146511208 472335975 534494836 912985153

FreeBASIC

<lang freebasic> dim as uinteger N, curr, temp, dig, sum

for N = 3 to 9

   for curr = 10^(N-1) to 10^N-1
       sum = 0
       temp = curr
       do
           dig = temp mod 10
           temp = temp \ 10
           sum += dig ^ N
       loop until temp = 0
       if sum = curr then print curr
   next curr

next N </lang>

Output:
As above.

Go

Iterative (slow)

Translation of: Wren
Library: Go-rcu

Takes about 16.5 seconds to run including compilation time. <lang go>package main

import (

   "fmt"
   "math"
   "rcu"

)

func main() {

   powers := [10]int{0, 1, 4, 9, 16, 25, 36, 49, 64, 81}
   fmt.Println("Own digits power sums for N = 3 to 9 inclusive:")
   for n := 3; n < 10; n++ {
       for d := 2; d < 10; d++ {
           powers[d] *= d
       }
       i := int(math.Pow(10, float64(n-1)))
       max := i * 10
       lastDigit := 0
       sum := 0
       var digits []int
       for i < max {
           if lastDigit == 0 {
               digits = rcu.Digits(i, 10)
               sum = 0
               for _, d := range digits {
                   sum += powers[d]
               }
           } else if lastDigit == 1 {
               sum++
           } else {
               sum += powers[lastDigit] - powers[lastDigit-1]
           }
           if sum == i {
               fmt.Println(i)
               if lastDigit == 0 {
                   fmt.Println(i + 1)
               }
               i += 10 - lastDigit
               lastDigit = 0
           } else if sum > i {
               i += 10 - lastDigit
               lastDigit = 0
           } else if lastDigit < 9 {
               i++
               lastDigit++
           } else {
               i++
               lastDigit = 0
           }
       }
   }

}</lang>

Output:
Same as Wren example.


Recursive (very fast)

Down to about 128 ms now including compilation time. Actual run time only 8 ms!

Translation of: Pascal

<lang go>package main

import "fmt"

const maxBase = 10

var usedDigits = [maxBase]int{} var powerDgt = [maxBase][maxBase]uint64{} var numbers []uint64

func initPowerDgt() {

   for i := 1; i < maxBase; i++ {
       powerDgt[0][i] = 1
   }
   for j := 1; j < maxBase; j++ {
       for i := 0; i < maxBase; i++ {
           powerDgt[j][i] = powerDgt[j-1][i] * uint64(i)
       }
   }

}

func calcNum(depth int, used [maxBase]int) uint64 {

   if depth < 3 {
       return 0
   }
   result := uint64(0)
   for i := 1; i < maxBase; i++ {
       if used[i] > 0 {
           result += uint64(used[i]) * powerDgt[depth][i]
       }
   }
   if result == 0 {
       return 0
   }
   n := result
   for {
       r := n / maxBase
       used[n-r*maxBase]--
       n = r
       depth--
       if r == 0 {
           break
       }
   }
   if depth != 0 {
       return 0
   }
   i := 1
   for i < maxBase && used[i] == 0 {
       i++
   }
   if i >= maxBase {
       numbers = append(numbers, result)
   }
   return 0

}

func nextDigit(dgt, depth int) {

   if depth < maxBase-1 {
       for i := dgt; i < maxBase; i++ {
           usedDigits[dgt]++
           nextDigit(i, depth+1)
           usedDigits[dgt]--
       }
   }
   if dgt == 0 {
       dgt = 1
   }
   for i := dgt; i < maxBase; i++ {
       usedDigits[i]++
       calcNum(depth, usedDigits)
       usedDigits[i]--
   }

}

func main() {

   initPowerDgt()
   nextDigit(0, 0)
   // sort and remove duplicates
   for i := 0; i < len(numbers)-1; i++ {
       for j := i + 1; j < len(numbers); j++ {
           if numbers[j] < numbers[i] {
               numbers[i], numbers[j] = numbers[j], numbers[i]
           }
       }
   }
   j := 0
   for i := 1; i < len(numbers); i++ {
       if numbers[i] != numbers[j] {
           j++
           numbers[i], numbers[j] = numbers[j], numbers[i]
       }
   }
   numbers = numbers[0 : j+1]
   fmt.Println("Own digits power sums for N = 3 to 9 inclusive:")
   for _, n := range numbers {
       fmt.Println(n)
   }

}</lang>

Output:
Same as before.

Haskell

Using a function from the Combinations with Repetitions task: <lang haskell>import Data.List (sort)


OWN DIGITS POWER SUM -----------------

ownDigitsPowerSums :: Int -> [Int] ownDigitsPowerSums n = sort (ns >>= go)

 where
   ns = combsWithRep n [0 .. 9]
   go xs
     | digitsMatch m xs = [m]
     | otherwise = []
     where
       m = foldr ((+) . (^ n)) 0 xs

digitsMatch :: Show a => a -> [Int] -> Bool digitsMatch n ds =

 sort ds == sort (digits n)

TEST -------------------------

main :: IO () main = do

 putStrLn "N ∈ [3 .. 8]"
 mapM_ print ([3 .. 8] >>= ownDigitsPowerSums)
 putStrLn ""
 putStrLn "N=9"
 mapM_ print $ ownDigitsPowerSums 9

GENERIC ------------------------

combsWithRep ::

 (Eq a) =>
 Int ->
 [a] ->
 a

combsWithRep k xs = comb k []

 where
   comb 0 ys = ys
   comb n [] = comb (pred n) (pure <$> xs)
   comb n peers = comb (pred n) (peers >>= nextLayer)
     where
       nextLayer ys@(h : _) =
         (: ys) <$> dropWhile (/= h) xs

digits :: Show a => a -> [Int] digits n = (\x -> read [x] :: Int) <$> show n</lang>

Output:
N ∈ [3 .. 8]
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477

N=9
146511208
472335975
534494836
912985153

Julia

<lang julia>function isowndigitspowersum(n::Integer, base=10)

   dig = digits(n, base=base)
   exponent = length(dig)
   return mapreduce(x -> x^exponent, +, dig) == n

end

for i in 10^2:10^9-1

   isowndigitspowersum(i) && println(i)

end

</lang>

Output:
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477
146511208
472335975
534494836
912985153

Pascal

recursive solution.Just counting the different combination of digits
See Combinations_with_repetitions
<lang pascal>program PowerOwnDigits; {$IFDEF FPC} // {$R+,O+}

 {$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$COPERATORS ON}

{$ELSE}{$APPTYPE CONSOLE}{$ENDIF} uses

 SysUtils;

const

 MAXBASE = 10;//16;
 MaxDgtVal = MAXBASE - 1;

type

 tDgtVal = 0..MaxDgtVal;
 tUsedDigits = array[0..15] of Int8;
 tPower = array[tDgtVal] of Uint64; 

var

 PowerDgt: array[tDgtVal] of tPower;
 UD :tUsedDigits;
 CombIdx: array of Int8;
 Numbers : array of Uint32;
 rec_cnt : NativeInt;

 function InitCombIdx(ElemCount: Byte): pbyte;
 begin
   setlength(CombIdx, ElemCount + 1);
   Fillchar(CombIdx[0], sizeOf(CombIdx[0]) * (ElemCount + 1), #0);
   Result := @CombIdx[0];
 end;

 function NextCombWithRep(pComb: pByte; MaxVal, ElemCount: UInt32): boolean;
 var
   i, dgt: NativeInt;
 begin
   i := -1;
   repeat
     i += 1;
     dgt := pComb[i];
     if dgt < MaxVal then
       break;
   until i > ElemCount;
   Result := i >= ElemCount;
   dgt +=1;
   repeat
     pComb[i] := dgt;
     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;
 begin
   dgt := minpot;
   res := 0;
   pPower := @PowerDgt[dgt,0];
   repeat
     dgt -=1;
     res += pPower[digits[dgt]];
   until dgt<=0;  
   
   result := minPot;
   repeat
     r := res DIV MAXBASE;
     UD_tmp[res-r*MAXBASE]-= 1;
     res := r;
     dec(result);
   until r = 0;
 end;
 
 procedure calcNum(digits:pbyte);
 var
   UD_tmp :tUsedDigits;
   minPot,dgt: nativeInt;
   res: Uint32;
 begin
   fillchar(UD,SizeOf(UD),#0);

   minPot := 0;
   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;
   repeat
     UD_tmp := UD;
     dgt := GetPowerSum(minpot,digits,UD_tmp);
     //number to small
     if dgt > 0 then
       break;
     if dgt=0 then
     begin
       dgt:= 1;
       while (dgt <= MaxDgtVal) and (UD_tmp[dgt] = 0) do
         dgt +=1;
       if dgt > MaxDgtVal then
       begin
         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;
     //try one more 0
     minPot +=1;
   until minPot > MaxDgtVal;
 end;

const

 rounds = 128;

var

 digits : pByte;
 T0 : Int64;
 tmp: Uint64;
 i, j : Int32;

begin

 digits := Init(MaxDgtVal);
 //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 := 1 to rounds do
 Begin
   setlength(numbers,0);
   digits := InitCombIdx(MaxDgtVal);
   repeat
     calcnum(digits);
     inc(rec_cnt);
   until NextCombWithRep(digits,MaxDgtVal,MaxDgtVal);
 end;
 T0 := GetTickCount64-T0;  
 writeln(rec_cnt DIV rounds,' recursions in runtime ',T0/rounds:5:2,' ms');
 writeln('found ',length(Numbers));
 //sort
 for i := 0 to High(Numbers) - 1 do
   for j := i + 1 to High(Numbers) do
     if Numbers[j] < Numbers[i] then
     begin
       tmp := Numbers[i];
       Numbers[i] := Numbers[j];
       Numbers[j] := tmp;
     end;

 setlength(Numbers, j + 1);
 for i := 0 to High(Numbers) do
    writeln(i+1:3,Numbers[i]:11);
 {$IFDEF WINDOWS}
 readln;
 {$ENDIF}

end.</lang>

Output:
//doing rounds = 1024 NextCombWithRep without calcnum(digits); takes: 48620 recursions in runtime  0.23 ms
TIO.RUN  CPU share: 99.04 %
48620 recursions in runtime  3.63 ms //best on TIO.RUN ..5.11 ms
found 22
  1        153
  2        370
  3        371
  4        407
  5       1634
  6       8208
  7       9474
  8      54748
  9      92727
 10      93084
 11     548834
 12    1741725
 13    4210818
 14    9800817
 15    9926315
 16   24678050
 17   24678051
 18   88593477
 19  146511208
 20  472335975
 21  534494836
 22  912985153

Perl

Brute Force

Use Parallel::ForkManager to obtain concurrency, trading some code complexity for less-than-infinite run time. Still very slow. <lang perl>use strict; use warnings; use feature 'say'; use List::Util 'sum'; use Parallel::ForkManager;

my %own_dps; my($lo,$hi) = (3,9); my $cores = 8; # configure to match hardware being used

my $start = 10**($lo-1); my $stop = 10**$hi - 1; my $step = int(1 + ($stop - $start)/ ($cores+1));

my $pm = Parallel::ForkManager->new($cores);

RUN: for my $i ( 0 .. $cores ) {

   $pm->run_on_finish (
       sub {
           my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data_ref) = @_;
           $own_dps{$ident} = $data_ref;
       }
   );
   $pm->start($i) and next RUN;
   my @values;
   for my $n ( ($start + $i*$step) .. ($start + ($i+1)*$step) ) {
       push @values, $n if $n == sum map { $_**length($n) } split , $n;
   }
   $pm->finish(0, \@values)

}

$pm->wait_all_children;

say $_ for sort { $a <=> $b } map { @$_ } values %own_dps;</lang>

Output:
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477
146511208
472335975
534494836
912985153

Combinatorics

Leverage the fact that all combinations of digits give same DPS. Much faster than brute force, as only non-redundant values tested. <lang perl>use strict; use warnings; use List::Util 'sum'; use Algorithm::Combinatorics qw<combinations_with_repetition>;

my @own_dps; for my $d (3..9) {

   my $iter = combinations_with_repetition([0..9], $d);
   while (my $p = $iter->next) {
       my $dps = sum map { $_**$d } @$p;
       next unless $d == length $dps and join(, @$p) == join , sort split , $dps;
       push @own_dps, $dps;
   }

}

print join "\n", sort { $a <=> $b } @own_dps;</lang>

Output:
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477
146511208
472335975
534494836
912985153

Python

Python :: Procedural

slower

<lang python>""" Rosetta code task: Own_digits_power_sum """

def isowndigitspowersum(integer):

   """ true if sum of (digits of number raised to number of digits) == number """
   digits = [int(c) for c in str(integer)]
   exponent = len(digits)
   return sum(x ** exponent for x in digits) == integer

print("Own digits power sums for N = 3 to 9 inclusive:") for i in range(100, 1000000000):

   if isowndigitspowersum(i):
       print(i)

</lang>

Output:

Same as Wren example. Takes over a half hour to run.

faster

Translation of: Wren

Same output.

<lang python>""" Rosetta code task: Own_digits_power_sum (recursive method)"""

MAX_BASE = 10 POWER_DIGIT = [[1 for _ in range(MAX_BASE)] for _ in range(MAX_BASE)] USED_DIGITS = [0 for _ in range(MAX_BASE)] NUMBERS = []

def calc_num(depth, used):

   """ calculate the number at a given recurse depth """
   result = 0
   if depth < 3:
       return 0
   for i in range(1, MAX_BASE):
       if used[i] > 0:
           result += used[i] * POWER_DIGIT[depth][i]
   if result != 0:
       num, rnum = result, 1
       while rnum != 0:
           rnum = num // MAX_BASE
           used[num - rnum * MAX_BASE] -= 1
           num = rnum
           depth -= 1
       if depth == 0:
           i = 1
           while i < MAX_BASE and used[i] == 0:
               i += 1
           if i >= MAX_BASE:
               NUMBERS.append(result)
   return 0

def next_digit(dgt, depth):

   """ get next digit at the given depth """
   if depth < MAX_BASE - 1:
       for i in range(dgt, MAX_BASE):
           USED_DIGITS[dgt] += 1
           next_digit(i, depth + 1)
           USED_DIGITS[dgt] -= 1
   if dgt == 0:
       dgt = 1
   for i in range(dgt, MAX_BASE):
       USED_DIGITS[i] += 1
       calc_num(depth, USED_DIGITS.copy())
       USED_DIGITS[i] -= 1

for j in range(1, MAX_BASE):

   for k in range(MAX_BASE):
       POWER_DIGIT[j][k] = POWER_DIGIT[j - 1][k] * k

next_digit(0, 0) print(NUMBERS) NUMBERS = list(set(NUMBERS)) NUMBERS.sort() print('Own digits power sums for N = 3 to 9 inclusive:') for n in NUMBERS:

   print(n)</lang>

Python :: Functional

Using a function from the Combinations with Repetitions task: <lang python>Own digit power sums

from itertools import accumulate, chain, islice, repeat from functools import reduce


  1. ownDigitsPowerSums :: Int -> [Int]

def ownDigitsPowerSums(n):

   All own digit power sums of digit length N
   def go(xs):
       m = reduce(lambda a, x: a + (x ** n), xs, 0)
       return [m] if digitsMatch(m)(xs) else []
   return concatMap(go)(
       combinationsWithRepetitions(n)(range(0, 1 + 9))
   )


  1. digitsMatch :: Int -> [Int] -> Bool

def digitsMatch(n):

   True if the digits in ds contain exactly
      the digits of n, in any order.
   
   def go(ds):
       return sorted(ds) == sorted(digits(n))
   return go


  1. ------------------------- TEST -------------------------
  2. main :: IO ()

def main():

   Own digit power sums for digit lengths 3..9
   print(
       '\n'.join([
           'N ∈ [3 .. 8]',
           *map(str, concatMap(ownDigitsPowerSums)(
               range(3, 1 + 8)
           )),
           '\nN=9',
           *map(str, ownDigitsPowerSums(9))
       ])
   )


  1. ----------------------- GENERIC ------------------------
  1. combinationsWithRepetitions :: Int -> [a] -> [kTuple a]

def combinationsWithRepetitions(k):

   Combinations with repetitions.
      A list of tuples, representing
      sets of cardinality k,
      with elements drawn from xs.
   
   def f(a, x):
       def go(ys, xs):
           return xs + [[x] + y for y in ys]
       return accumulate(a, go)
   def combsBySize(xs):
       return [
           tuple(x) for x in next(islice(
               reduce(
                   f, xs, chain(
                       [[[]]],
                       islice(repeat([]), k)
                   )
               ), k, None
           ))
       ]
   return combsBySize


  1. concatMap :: (a -> [b]) -> [a] -> [b]

def concatMap(f):

   A concatenated list over which a function has been
      mapped.
      The list monad can be derived by using a function f
      which wraps its output in a list, (using an empty
      list to represent computational failure).
   
   def go(xs):
       return list(chain.from_iterable(map(f, xs)))
   return go


  1. digits :: Int -> [Int]

def digits(n):

   The individual digits of n as integers
   return [int(c) for c in str(n)]


  1. MAIN ---

if __name__ == '__main__':

   main()</lang>
Output:
N ∈ [3 .. 8]
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477

N=9
146511208
472335975
534494836
912985153

Raku

<lang perl6>(3..8).map: -> $p {

   my %pow = (^10).map: { $_ => $_ ** $p };
   my $start = 10 ** ($p - 1);
   my $end   = 10 ** $p;
   my @temp;
   for ^9 -> $i {
       ([X] ($i..9) xx $p).race.map: {
           next unless [<=] $_;
           my $sum = %pow{$_}.sum;
           next if $sum < $start;
           next if $sum > $end;
           @temp.push: $sum if $sum.comb.Bag eqv $_».Str.Bag
       }
   }
   .say for unique sort @temp;

}</lang>

Output:
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477

Combinations with repetitions

Using code from Combinations with repetitions task, a version that runs relatively quickly, and scales well. <lang perl6>proto combs_with_rep (UInt, @ ) { * } multi combs_with_rep (0, @ ) { () } multi combs_with_rep ($, []) { () } multi combs_with_rep (1, @a) { map { $_, }, @a } multi combs_with_rep ($n, [$head, *@tail]) {

   |combs_with_rep($n - 1, ($head, |@tail)).map({ $head, |@_ }),
   |combs_with_rep($n, @tail);

}

say sort gather {

   for 3..9 -> $d {
       for combs_with_rep($d, [^10]) -> @digits {
           .take if $d == .comb.elems and @digits.join == .comb.sort.join given sum @digits X** $d;
       }
   }

}</lang>

Output:
153 370 371 407 1634 8208 9474 54748 92727 93084 548834 1741725 4210818 9800817 9926315 24678050 24678051 88593477 146511208 472335975 534494836 912985153

Visual Basic .NET

Translation of: ALGOL 68

<lang vbnet>Option Strict On Option Explicit On

Imports System.IO

<summary> Finds n digit numbers N such that the sum of the nth powers of their digits = N </summary> Module OwnDigitsPowerSum

   Public Sub Main
       For n As Integer = 3 To 9
           Dim fdigit As Integer =  10 - n
           Dim f(8) As Integer
           For i As Integer = 1 To 8
               f(i) = If(i = fdigit, 1, 0)
           Next i
           Dim t(8) As Integer
           For i As Integer = 1 To 8
               t(i) = If(i < fdigit, 0, 9)
           Next i
           Dim power(10) As Integer
               For i As Integer = 0 To UBound(power)
               power(i) = Cint(i ^ n)
           Next i
           Dim maxN As Integer = power(10)
           For d1 As Integer = f(1) To t(1)
               Dim p1 As Integer = power(d1)
               Dim s1 As Integer = d1 * 10
               For d2 As Integer = f(2) To t(2)
                   Dim p2 As Integer = power(d2) + p1
                   If p2 >= maxN Then Exit For
                   Dim s2 As Integer = (s1 + d2) * 10
                   For d3 As Integer = f(3) To t(3)
                       Dim p3 As Integer = power(d3) + p2
                       If p3 >= maxN Then Exit For
                       Dim s3 As Integer = (s2 + d3) * 10
                       For d4 As Integer = f(4) To t(4)
                           Dim p4 As Integer = power(d4) + p3
                           If p4 >= maxN Then Exit For
                           Dim s4 As Integer = (s3 + d4) * 10
                           For d5 As Integer = f(5) To t(5)
                               Dim p5 As Integer = power(d5) + p4
                               If p5 >= maxN Then Exit For
                               Dim s5 As Integer = (s4 + d5) * 10
                               For d6 As Integer = f(6) To t(6)
                                   Dim p6 As Integer = power(d6) + p5
                                   If p6 >= maxN Then Exit For
                                   Dim s6 As Integer = (s5 + d6) * 10
                                   For d7 As Integer = f(7) To t(7)
                                       Dim p7 As Integer = power(d7) + p6
                                       If p7 >= maxN Then Exit For
                                       Dim s7 As Integer = (s6 + d7) * 10
                                       For d8 As Integer = f(8) To t(8)
                                           Dim p8 As Integer = power(d8) + p7
                                           If p8 >= maxN Then Exit For
                                           Dim s8 As Integer = (s7 + d8) * 10
                                           If s8 = p8 Then
                                               ' found a number with 0 as the final digit
                                               ' the same number with a final digit of 1
                                               ' must also match the requirements
                                               Console.Out.WriteLine(s8)
                                               Console.Out.WriteLine(s8 + 1)
                                           End If
                                           For d9 As Integer = 2 To 9
                                               Dim p9 As Integer = power(d9) + p8
                                               If p9 >= maxN Then Exit For
                                               Dim s9 As Integer = s8 + d9
                                               If s9 = p9 Then
                                                   Console.Out.WriteLine(s9)
                                               End If
                                           Next d9
                                       Next d8
                                   Next d7
                               Next d6
                           Next d5
                       Next d4
                   Next d3
               Next d2
           Next d1
       Next n
   End Sub


End Module</lang>

Output:
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477
146511208
472335975
534494836
912985153

Real time: 7.553 s
User time: 7.044 s
Sys. time: 0.290 s on TIO.RUN using Visual Basic .NET (VBC)

Wren

Iterative (slow)

Library: Wren-math

Includes some simple optimizations to try and quicken up the search. However, getting up to N = 9 still took a little over 4 minutes on my machine. <lang ecmascript>import "./math" for Int

var powers = [0, 1, 4, 9, 16, 25, 36, 49, 64, 81] System.print("Own digits power sums for N = 3 to 9 inclusive:") for (n in 3..9) {

   for (d in 2..9) powers[d] = powers[d] * d
   var i = 10.pow(n-1)
   var max = i * 10
   var lastDigit = 0
   var sum = 0
   var digits = null
   while (i < max) {
       if (lastDigit == 0) {
           digits = Int.digits(i)
           sum = digits.reduce(0) { |acc, d|  acc + powers[d] }
       } else if (lastDigit == 1) {
           sum = sum + 1
       } else {
           sum = sum + powers[lastDigit] - powers[lastDigit-1]
       }
       if (sum == i) {
           System.print(i)
           if (lastDigit == 0) System.print(i + 1)
           i = i + 10 - lastDigit
           lastDigit = 0
       } else if (sum > i) {
           i = i + 10 - lastDigit
           lastDigit = 0
       } else if (lastDigit < 9) {
           i = i + 1
           lastDigit = lastDigit + 1
       } else {
           i = i + 1
           lastDigit = 0
       }
   }

}</lang>

Output:
Own digits power sums for N = 3 to 9 inclusive:
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315
24678050
24678051
88593477
146511208
472335975
534494836
912985153


Recursive (very fast)

Translation of: Pascal
Library: Wren-seq

Astonishing speed-up. Runtime now only 0.5 seconds! <lang ecmascript>import "./seq" for Lst

var maxBase = 10 var usedDigits = List.filled(maxBase, 0) var powerDgt = List.filled(maxBase, null) var numbers = []

var initPowerDgt = Fn.new {

   for (i in 0...maxBase) powerDgt[i] = List.filled(maxBase, 0)
   for (i in 1...maxBase) powerDgt[0][i] = 1
   for (j in 1...maxBase) {
       for (i in 0...maxBase) powerDgt[j][i] = powerDgt[j-1][i] * i
   }

}

var calcNum = Fn.new { |depth, used|

   if (depth < 3) return 0
   var result = 0
   for (i in 1...maxBase) {
       if (used[i] > 0) result = result + used[i] * powerDgt[depth][i]
   }
   if (result == 0) return 0
   var n = result
   while (true) {
       var r = (n/maxBase).floor
       used[n - r*maxBase] = used[n - r*maxBase] - 1
       n = r
       depth = depth - 1
       if (r == 0) break
   }
   if (depth != 0) return 0
   var i = 1
   while (i < maxBase && used[i] == 0) i = i + 1
   if (i >= maxBase) numbers.add(result)
   return 0

}

var nextDigit // recursive function nextDigit = Fn.new { |dgt, depth|

   if (depth < maxBase-1) {
       for (i in dgt...maxBase) {
           usedDigits[dgt] = usedDigits[dgt] + 1
           nextDigit.call(i, depth + 1)
           usedDigits[dgt] = usedDigits[dgt] - 1
       }
   }
   if (dgt == 0) dgt = 1
   for (i in dgt...maxBase) {
       usedDigits[i] = usedDigits[i] + 1
       calcNum.call(depth, usedDigits.toList)
       usedDigits[i] = usedDigits[i] - 1
   }

}

initPowerDgt.call() nextDigit.call(0, 0) numbers = Lst.distinct(numbers) numbers.sort() System.print("Own digits power sums for N = 3 to 9 inclusive:") System.print(numbers.map { |n| n.toString }.join("\n"))</lang>

Output:
Same as iterative version.