Disarium numbers
A Disarium number is an integer where the sum of each digit raised to the power of its position in the number, is equal to the number.
You are encouraged to solve this task according to the task description, using any language you may know.
- E.G.
135 is a Disarium number:
11 + 32 + 53 == 1 + 9 + 125 == 135
There are a finite number of Disarium numbers.
- Task
- Find and display the first 18 Disarium numbers.
- Stretch
- Find and display all 20 Disarium numbers.
- See also
- Geeks for Geeks - Disarium numbers
- OEIS:A032799 - Numbers n such that n equals the sum of its digits raised to the consecutive powers (1,2,3,...)
- Related task: Narcissistic decimal number
- Related task: Own digits power sum Which seems to be the same task as Narcissistic decimal number...
11l
F is_disarium(n)
V digitos = String(n).len
V suma = 0
V x = n
L x != 0
suma += (x % 10) ^ digitos
digitos--
x I/= 10
I suma == n
R 1B
E
R 0B
V limite = 19
V cont = 0
V n = 0
print(‘The first ’limite‘ Disarium numbers are:’)
L cont < limite
I is_disarium(n)
print(n, end' ‘ ’)
cont++
n++- Output:
The first 19 Disarium numbers are: 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Action!
which is
;;; find some Disarium Numbers - numbers whose digit-position power sume
;;; are equal to the number, e.g.: 135 = 1^1 + 3^2 + 5^3
PROC Main()
DEFINE MAX_DISARIUM = "9999"
CARD ARRAY power( 40 ) ; table of powers up to the fourth power ( 1:4, 0:9 )
CARD n, d, powerOfTen, count, length, v, p, dps, nsub, nprev
; compute the n-th powers of 0-9
FOR d = 0 TO 9 DO power( d ) = D OD
nsub = 10
nprev = 0
FOR n = 2 TO 4 DO
power( nsub ) = 0
FOR d = 1 TO 9 DO
power( nsub + d ) = power( nprev + d ) * d
OD
nprev = nsub
nsub ==+ 10
OD
; print the Disarium numbers up to 9999 or the 18th, whichever is sooner
powerOfTen = 10
length = 1
count = 0 n = 0
WHILE n < MAX_DISARIUM AND count < 18 DO
IF n = powerOfTen THEN
; the number of digits just increased
powerOfTen ==* 10
length ==+ 1
FI
; form the digit power sum
v = n
p = length * 10;
dps = 0;
FOR d = 1 TO length DO
p ==- 10
dps ==+ power( p + ( v MOD 10 ) )
v ==/ 10
OD
IF dps = N THEN
; n is Disarium
count ==+ 1;
Put( ' )
PrintC( n )
FI
n ==+ 1
OD
RETURN- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
Ada
with Ada.Text_IO;
procedure Disarium_Numbers is
Disarium_Count : constant := 19;
function Is_Disarium (N : Natural) return Boolean is
Nn : Natural := N;
Pos : Natural := 0;
Sum : Natural := 0;
begin
while Nn /= 0 loop
Nn := Nn / 10;
Pos := Pos + 1;
end loop;
Nn := N;
while Nn /= 0 loop
Sum := Sum + (Nn mod 10) ** Pos;
Nn := Nn / 10;
Pos := Pos - 1;
end loop;
return N = Sum;
end Is_Disarium;
Count : Natural := 0;
begin
for N in 0 .. Natural'Last loop
if Is_Disarium (N) then
Count := Count + 1;
Ada.Text_IO.Put (N'Image);
end if;
exit when Count = Disarium_Count;
end loop;
end Disarium_Numbers;
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
ALGOL 60
begin comment find some Disarium numbers
- numbers whose digit position-power sums are equal to the
number, e.g. 135 = 1^1 + 3^2 + 5^3;
integer array power [ 1 : 9, 0 : 9 ];
integer count, powerOfTen, length, n, d;
comment compute the nth powers of 0-9;
for d := 0 step 1 until 9 do power[ 1, d ] := d;
for n := 2 step 1 until 9 do begin
power[ n, 0 ] := 0;
for d := 1 step 1 until 9 do power[ n, d ] := power[ n - 1, d ] * d
end n;
comment print the first few Disarium numbers;
count := 0;
powerOfTen := 10;
length := 1;
n := -1;
for n := n + 1 while count < 19 do begin
integer v, dps, p;
if n = powerOfTen then begin
comment the number of digfits just increased;
powerOfTen := powerOfTen * 10;
length := length + 1
end;
comment form the digit power sum;
v := n;
dps := 0;
for p := length step -1 until 1 do begin
dps := dps + power[ p, v - ( ( v % 10 ) * 10 ) ];
v := v % 10
end p;
if dps = n then begin
comment n is Disarium;
count := count + 1;
outinteger( 1, n )
end
end n
end- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
ALGOL 68
Finds the first 19 Disarium numbers - to find the 20th would require a lot more time and also the table of digit powers would need to be increased to at least 20th powers (and 64 bit integers would be required).
BEGIN # find some Disarium numbers - numbers whose digit position-power sums #
# are equal to the number, e.g. 135 = 1^1 + 3^2 + 5^3 #
# compute the nth powers of 0-9 #
[ 1 : 9, 0 : 9 ]INT power;
FOR d FROM 0 TO 9 DO power[ 1, d ] := d OD;
FOR n FROM 2 TO 9 DO
power[ n, 0 ] := 0;
FOR d TO 9 DO
power[ n, d ] := power[ n - 1, d ] * d
OD
OD;
# print the first few Disarium numbers #
INT max disarium = 19;
INT count := 0;
INT power of ten := 10;
INT length := 1;
FOR n FROM 0 WHILE count < max disarium DO
IF n = power of ten THEN
# the number of digits just increased #
power of ten *:= 10;
length +:= 1
FI;
# form the digit power sum #
INT v := n;
INT dps := 0;
FOR p FROM length BY -1 TO 1 DO
dps +:= power[ p, v MOD 10 ];
v OVERAB 10
OD;
IF dps = n THEN
# n is Disarium #
count +:= 1;
print( ( " ", whole( n, 0 ) ) )
FI
OD
END- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
ALGOL W
begin % find some Disarium numbers - numbers whose digit position-power sums %
% are equal to the number, e.g. 135 = 1^1 + 3^2 + 5^3 %
integer array power ( 1 :: 9, 0 :: 9 );
integer MAX_DISARIUM;
integer count, powerOfTen, length, n;
% compute the nth powers of 0-9 %
for d := 0 until 9 do power( 1, d ) := d;
for n := 2 until 9 do begin
power( n, 0 ) := 0;
for d := 1 until 9 do power( n, d ) := power( n - 1, d ) * d
end for_n;
% print the first few Disarium numbers %
MAX_DISARIUM := 19;
count := 0;
powerOfTen := 10;
length := 1;
n := 0;
while count < MAX_DISARIUM do begin
integer v, dps;
if n = powerOfTen then begin
% the number of digits just increased %
powerOfTen := powerOfTen * 10;
length := length + 1
end if_m_eq_powerOfTen ;
% form the digit power sum %
v := n;
dps := 0;
for p := length step -1 until 1 do begin
dps := dps + power( p, v rem 10 );
v := v div 10;
end FOR_P;
if dps = n then begin
% n is Disarium %
count := count + 1;
writeon( i_w := 1, s_w := 0, " ", n )
end if_dps_eq_n ;
n := n + 1
end
end.
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Amazing Hopper
#include <basico.h>
#proto encontrarunDisariumpara(_X_)
#synon _encontrarunDisariumpara siencontréunDisarium
algoritmo
decimales '0'
iterar para ( n=3000000, n, --n )
si encontré un Disarium 'n', entonces{
imprimir( #(utf8("El número ")),n," es Disarium\n")
}
siguiente
terminar
subrutinas
encontrar un Disarium para (n)
i=0
n, obtener tamaño parte entera, mover a 'i'
m=0, tn=n, d=0
iterar mientras ( tn )
último dígito de 'tn', mover a 'd,tn'
d, elevado a 'i', más 'm'
mover a 'm'
--i
reiterar
retornar ' #(m==n) '
- Output:
El número 2646798 es Disarium El número 2427 es Disarium El número 1676 es Disarium El número 1306 es Disarium El número 598 es Disarium El número 518 es Disarium El número 175 es Disarium El número 135 es Disarium El número 89 es Disarium El número 9 es Disarium El número 8 es Disarium El número 7 es Disarium El número 6 es Disarium El número 5 es Disarium El número 4 es Disarium El número 3 es Disarium El número 2 es Disarium El número 1 es Disarium
APL
(⊢(/⍨)(⊢=(⍎¨(+/*)⍳∘⍴)∘⍕)¨)0,⍳3000000
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
AppleScript
This returns the first 19 Disarium numbers.
on isDisarium(n)
set temp to n
set digitCount to 1
repeat while (temp > 9)
set temp to temp div 10
set digitCount to digitCount + 1
end repeat
set temp to n
set sum to 0
repeat with position from digitCount to 2 by -1
set sum to sum + (temp mod 10) ^ position
set temp to temp div 10
end repeat
return (sum + temp = n)
end isDisarium
local Disaria, n
set Disaria to {}
set n to 0
repeat until ((count Disaria) = 19)
if (isDisarium(n)) then set end of Disaria to n
set n to n + 1
end repeat
return Disaria
- Output:
{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798}
Arturo
disarium?: function [x][
j: 0
psum: sum map digits x 'dig [
j: j + 1
dig ^ j
]
return psum = x
]
cnt: 0
i: 0
while [cnt < 18][
if disarium? i [
print i
cnt: cnt + 1
]
i: i + 1
]
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
AWK
# syntax: GAWK -f DISARIUM_NUMBERS.AWK
BEGIN {
stop = 19
printf("The first %d Disarium numbers:\n",stop)
while (count < stop) {
if (is_disarium(n)) {
printf("%d ",n)
count++
}
n++
}
printf("\n")
exit(0)
}
function is_disarium(n, leng,sum,x) {
x = n
leng = length(n)
while (x != 0) {
sum += (x % 10) ^ leng
leng--
x = int(x/10)
}
return((sum == n) ? 1 : 0)
}
- Output:
The first 19 Disarium numbers: 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
BASIC
BASIC256
function isDisarium(n)
digitos = length(string(n))
suma = 0
x = n
while x <> 0
suma += (x % 10) ^ digitos
digitos -= 1
x = x \ 10
end while
if suma = n then return True else return False
end function
limite = 19
cont = 0 : n = 0
print "The first"; limite; " Disarium numbers are:"
while cont < limite
if isDisarium(n) then
print n; " ";
cont += 1
endif
n += 1
end while
end
- Output:
Same as FreeBASIC entry.
Chipmunk Basic
100 cls
110 sub isdisarium(n)
120 digitos = len(str$(n))
130 suma = 0
140 x = n
150 while x <> 0
160 r = (x mod 10)
170 suma = suma+(r^digitos)
180 digitos = digitos-1
190 x = int(x/10)
200 wend
210 if suma = n then isdisarium = true else isdisarium = false
220 end sub
230 '
240 limite = 19
250 cnt = 0
260 n = 0
270 print "The first ";limite;" Disarium numbers are:"
280 while cnt < limite
290 if isdisarium(n) then
300 print n;" ";
310 cnt = cnt+1
320 endif
330 n = n+1
340 wend
350 end
- Output:
Same as FreeBASIC entry.
FreeBASIC
#define limite 19
Function isDisarium(n As Integer) As Boolean
Dim As Integer digitos = Len(Str(n))
Dim As Integer suma = 0, x = n
While x <> 0
suma += (x Mod 10) ^ digitos
digitos -= 1
x \= 10
Wend
Return Iif(suma = n, True, False)
End Function
Dim As Integer cont = 0, n = 0, i
Print "The first"; limite; " Disarium numbers are:"
Do While cont < limite
If isDisarium(n) Then
Print n; " ";
cont += 1
End If
n += 1
Loop
Sleep
- Output:
Same as Python entry.
Run BASIC
function isDisarium(n)
digitos = len(str$(n))
suma = 0 : x = n
while x <> 0
r = (x mod 10)
suma = suma + (r ^ digitos)
digitos = digitos - 1
x = int(x / 10)
wend
if suma = n then isDisarium = 1 else isDisarium = 0
end function
limite = 18 : cont = 0 : n = 0
print "The first"; limite; " Disarium numbers are:"
while cont < limite
if isDisarium(n) = 1 then
print n; " ";
cont = cont + 1
end if
n = n + 1
wend
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
True BASIC
FUNCTION isDisarium(n)
LET digitos = LEN(str$(n))
LET suma = 0
LET x = n
DO WHILE x <> 0
LET r = REMAINDER(x, 10)
LET suma = suma + (r ^ digitos)
LET digitos = digitos - 1
LET x = INT(x / 10)
LOOP
IF suma = n THEN LET isDisarium = 1 ELSE LET isDisarium = 0
END FUNCTION
LET limite = 18
LET cont = 0
LET n = 0
PRINT "The first"; limite; " Disarium numbers are:"
DO WHILE cont < limite
IF isDisarium(n) = 1 THEN
PRINT n; " ";
LET cont = cont + 1
END IF
LET n = n + 1
LOOP
END
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
PureBasic
Procedure isDisarium(n.i)
digitos.i = Len(Str(n))
suma.i = 0
x.i = n
While x <> 0
r.i = (x % 10)
suma + Pow(r, digitos)
digitos - 1
x / 10
Wend
If suma = n
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
OpenConsole()
limite.i = 19
cont.i = 0
n.i = 0
PrintN("The first" + Str(limite) + " Disarium numbers are:")
While cont < limite
If isDisarium(n)
Print(Str(n) + #TAB$)
cont + 1
EndIf
n + 1
Wend
Input()
CloseConsole()
- Output:
Same as FreeBASIC entry.
e>
Yabasic
limite = 18 : cont = 0 : n = 0
print "The first", limite, " Disarium numbers are:"
while cont < limite
if isDisarium(n) then
print n, " ";
cont = cont + 1
fi
n = n + 1
wend
end
sub isDisarium(n)
digitos = len(str$(n))
suma = 0 : x = n
while x <> 0
r = mod(x, 10)
suma = suma + (r ^ digitos)
digitos = digitos - 1
x = int(x / 10)
wend
if suma = n then return True else return False : fi
end sub- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
bc
define is_disarium (num) {
n = num
sum = 0
len = length(n)
while (n > 0) {
sum += (n % 10) ^ len
n = n/10
len -= 1
}
return (sum == num)
}
count = 0
i = 0
while (count < 19) {
if (is_disarium(i)) {
print i, "\n"
count += 1
}
i += 1
}
quit
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
BCPL
get "libhdr"
let length(n) = n < 10 -> 1,
length(n/10) + 1
let pow(b, e) = e = 0 -> 1,
b * pow(b, e-1)
let dps(n) = dpsl(n, length(n))
and dpsl(n, p) = n = 0 -> 0,
pow(n rem 10, p) + dpsl(n/10, p-1)
let disarium(n) = dps(n) = n
let start() be
for n=0 to 2500 if disarium(n)
do writef("%N*N", n)- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
BQN
Digits ← {𝕊 0: ⟨⟩; (𝕊⌊𝕩÷10)∾10|𝕩}
DigitPowerSum ← (+´⊢⋆1+↕∘≠)∘Digits
Disarium ← ⊢=DigitPowerSum
Disarium¨⊸/ ↕2500
- Output:
⟨ 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 ⟩
C
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
int power (int base, int exponent) {
int result = 1;
for (int i = 1; i <= exponent; i++) {
result *= base;
}
return result;
}
int is_disarium (int num) {
int n = num;
int sum = 0;
int len = n <= 9 ? 1 : floor(log10(n)) + 1;
while (n > 0) {
sum += power(n % 10, len);
n /= 10;
len--;
}
return num == sum;
}
int main() {
int count = 0;
int i = 0;
while (count < 19) {
if (is_disarium(i)) {
printf("%d ", i);
count++;
}
i++;
}
printf("%s\n", "\n");
}
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
C#
using System;
class DisariumNumbers {
// Method to check if a number is a Disarium number
public static bool IsDisarium(int num) {
int n = num;
int len = num.ToString().Length;
int sum = 0;
int i = 1;
while (n > 0) {
// C# does not support implicit conversion from double to int, so we explicitly convert the result of Math.Pow to int
sum += (int)Math.Pow(n % 10, len - i + 1);
n /= 10;
i++;
}
return sum == num;
}
static void Main(string[] args) {
int i = 0;
int count = 0;
// Find and print the first 19 Disarium numbers
while (count <= 18) {
if (IsDisarium(i)) {
Console.Write($"{i} ");
count++;
}
i++;
}
Console.WriteLine();
}
}
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
C++
#include <vector>
#include <iostream>
#include <cmath>
#include <algorithm>
std::vector<int> decompose( int n ) {
std::vector<int> digits ;
while ( n != 0 ) {
digits.push_back( n % 10 ) ;
n /= 10 ;
}
std::reverse( digits.begin( ) , digits.end( ) ) ;
return digits ;
}
bool isDisarium( int n ) {
std::vector<int> digits( decompose( n ) ) ;
int exposum = 0 ;
for ( int i = 1 ; i < digits.size( ) + 1 ; i++ ) {
exposum += static_cast<int>( std::pow(
static_cast<double>(*(digits.begin( ) + i - 1 )) ,
static_cast<double>(i) )) ;
}
return exposum == n ;
}
int main( ) {
std::vector<int> disariums ;
int current = 0 ;
while ( disariums.size( ) != 18 ){
if ( isDisarium( current ) )
disariums.push_back( current ) ;
current++ ;
}
for ( int d : disariums )
std::cout << d << " " ;
std::cout << std::endl ;
return 0 ;
}
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
CLU
is_disarium = proc (n: int) returns (bool)
digits: array[int] := array[int]$[]
number: int := n
while n > 0 do
array[int]$addl(digits, n//10)
n := n / 10
end
array[int]$set_low(digits, 1)
digit_power_sum: int := 0
for i: int in array[int]$indexes(digits) do
digit_power_sum := digit_power_sum + digits[i] ** i
end
return(digit_power_sum = number)
end is_disarium
disaria = iter (amount: int) yields (int)
n: int := 0
while amount > 0 do
if is_disarium(n) then
amount := amount - 1
yield(n)
end
n := n + 1
end
end disaria
start_up = proc ()
po: stream := stream$primary_output()
for n: int in disaria(19) do
stream$putl(po, int$unparse(n))
end
end start_up- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
COBOL
IDENTIFICATION DIVISION.
PROGRAM-ID. DISARIUM.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 VARIABLES.
03 CANDIDATE PIC 9(9).
03 DIGITS PIC 9 OCCURS 9 TIMES, REDEFINES CANDIDATE.
03 IDX PIC 99.
03 EXPONENT PIC 99.
03 DGT-POWER PIC 9(9).
03 DGT-POWER-SUM PIC 9(9).
03 CAND-OUT PIC Z(8)9.
03 AMOUNT PIC 99 VALUE 18.
PROCEDURE DIVISION.
BEGIN.
PERFORM DISARIUM-TEST VARYING CANDIDATE FROM ZERO BY 1
UNTIL AMOUNT IS ZERO.
STOP RUN.
DISARIUM-TEST.
MOVE ZERO TO DGT-POWER-SUM.
MOVE 1 TO EXPONENT, IDX.
INSPECT CANDIDATE TALLYING IDX FOR LEADING ZEROES.
PERFORM ADD-DIGIT-POWER UNTIL IDX IS GREATER THAN 9.
IF DGT-POWER-SUM IS EQUAL TO CANDIDATE,
MOVE CANDIDATE TO CAND-OUT,
DISPLAY CAND-OUT,
SUBTRACT 1 FROM AMOUNT.
ADD-DIGIT-POWER.
COMPUTE DGT-POWER = DIGITS(IDX) ** EXPONENT.
ADD DGT-POWER TO DGT-POWER-SUM.
ADD 1 TO EXPONENT.
ADD 1 TO IDX.
- Output:
0
1
2
3
4
5
6
7
8
9
89
135
175
518
598
1306
1676
2427
Comal
0010 FUNC dps#(n#) CLOSED
0020 DIM digits#(10)
0030 length#:=0
0040 rest#:=n#
0050 WHILE rest#>0 DO
0060 length#:+1
0070 digits#(length#):=rest# MOD 10
0080 rest#:=rest# DIV 10
0090 ENDWHILE
0100 sum#:=0
0110 FOR i#:=1 TO length# DO
0120 sum#:+digits#(i#)^(length#-i#+1)
0130 ENDFOR i#
0140 RETURN sum#
0150 ENDFUNC dps#
0160 //
0170 amount#:=18
0180 num#:=0
0190 WHILE amount#>0 DO
0200 IF dps#(num#)=num# THEN
0210 amount#:-1
0220 PRINT num#
0230 ENDIF
0240 num#:+1
0250 ENDWHILE
0260 PRINT
0270 END
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
Cowgol
include "cowgol.coh";
sub pow(base: uint8, exp: uint8): (power: uint32) is
power := 1;
while exp > 0 loop
power := power * base as uint32;
exp := exp - 1;
end loop;
end sub;
sub digit_power_sum(n: uint32): (dps: uint32) is
var digits: uint8[10]; # 2**32 has 10 digits
var digit := &digits[0];
var length: uint8 := 0;
while n > 0 loop
[digit] := (n % 10) as uint8;
digit := @next digit;
length := length + 1;
n := n / 10;
end loop;
dps := 0;
var power: uint8 := 1;
while power <= length loop
digit := @prev digit;
dps := dps + pow([digit], power);
power := power + 1;
end loop;
end sub;
var amount: uint8 := 19;
var candidate: uint32 := 0;
while amount > 0 loop
if digit_power_sum(candidate) == candidate then
amount := amount - 1;
print_i32(candidate);
print_nl();
end if;
candidate := candidate + 1;
end loop;- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Delphi
Finds the first 19 numbers in 425 miliseconds. It uses a look up table for the powers and tests about 5 million numbers per second. However, this is not fast enough to find the 20th number. By my calculation, at this speed, it would only take 77,000 years. In other words, the brute force method can't be used to find the 20th number.
{Table to speed up calculating powers. Contains all the powers
of the digits 0..9 raised to the 0..21 power}
const PowersTable: array [0..21,0..9] of int64 = (
($01,$01,$01,$01,$01,$01,$01,$01,$01,$01),
($00,$01,$02,$03,$04,$05,$06,$07,$08,$09),
($00,$01,$04,$09,$10,$19,$24,$31,$40,$51),
($00,$01,$08,$1B,$40,$7D,$D8,$157,$200,$2D9),
($00,$01,$10,$51,$100,$271,$510,$961,$1000,$19A1),
($00,$01,$20,$F3,$400,$C35,$1E60,$41A7,$8000,$E6A9),
($00,$01,$40,$2D9,$1000,$3D09,$B640,$1CB91,$40000,$81BF1),
($00,$01,$80,$88B,$4000,$1312D,$44580,$C90F7,$200000,$48FB79),
($00,$01,$100,$19A1,$10000,$5F5E1,$19A100,$57F6C1,$1000000,$290D741),
($00,$01,$200,$4CE3,$40000,$1DCD65,$99C600,$267BF47,$8000000,$17179149),
($00,$01,$400,$E6A9,$100000,$9502F9,$39AA400,$10D63AF1,$40000000,$CFD41B91),
($00,$01,$800,$2B3FB,$400000,$2E90EDD,$159FD800,$75DB9C97,$200000000,$74E74F819),
($00,$01,$1000,$81BF1,$1000000,$E8D4A51,$81BF1000,$339014821,$1000000000,$41C21CB8E1),
($00,$01,$2000,$1853D3,$4000000,$48C27395,$30A7A6000,$168F08F8E7,$8000000000,$24FD3027FE9),
($00,$01,$4000,$48FB79,$10000000,$16BCC41E9,$123EDE4000,$9DE93ECE51,$40000000000,$14CE6B167F31),
($00,$01,$8000,$DAF26B,$40000000,$71AFD498D,$6D79358000,$45160B7A437,$200000000000,$BB41C3CA78B9),
($00,$01,$10000,$290D741,$100000000,$2386F26FC1,$290D7410000,$1E39A5057D81,$1000000000000,$6954FE21E3E81),
($00,$01,$20000,$7B285C3,$400000000,$B1A2BC2EC5,$F650B860000,$D39383266E87,$8000000000000,$3B3FCEF3103289),
($00,$01,$40000,$17179149,$1000000000,$3782DACE9D9,$5C5E45240000,$5C908960D05B1,$40000000000000,$2153E468B91C6D1),
($00,$01,$80000,$4546B3DB,$4000000000,$1158E460913D,$22A359ED80000,$287F3C1A5B27D7,$200000000000000,$12BF307AE81FFD59),
($00,$01,$100000,$CFD41B91,$10000000000,$56BC75E2D631,$CFD41B9100000,$11B7AA4B87E16E1,$1000000000000000,$A8B8B452291FE821),
($00,$01,$200000,$26F7C52B3,$40000000000,$1B1AE4D6E2EF5,$4DEF8A56600000,$7C05A810B72A027,$8000000000000000,$EE7E56E3721F2929));
function GetPower(X,Y: integer): int64;
{Extract power from table}
begin
Result:=PowersTable[Y,X];
end;
function IsDisarium(N: integer): boolean;
{Sum all powers of the digits raised to position power}
var S: string;
var I,J: integer;
var Sum: int64;
begin
Sum:=0;
S:=IntToStr(N);
for I:=1 to Length(S) do
begin
Sum:=Sum+GetPower(byte(S[I])-$30,I);
end;
Result:=Sum=N;
end;
procedure ShowDisariumNumbers(Memo: TMemo);
{Show Disarium numbers up to specified limit}
{Processes about 5 million numbers per second}
var I,Cnt: int64;
begin
Cnt:=0;
I:=0;
while I<High(int64) do
begin
if IsDisarium(I) then
begin
Inc(Cnt);
Memo.Lines.Add(IntToStr(Cnt)+': '+IntToStr(I));
if Cnt>=19 then break;
end;
Inc(I);
end;
end;
- Output:
1: 0 2: 1 3: 2 4: 3 5: 4 6: 5 7: 6 8: 7 9: 8 10: 9 11: 89 12: 135 13: 175 14: 518 15: 598 16: 1306 17: 1676 18: 2427 19: 2646798
D
import std.stdio;
import std.math;
import std.conv;
bool is_disarium(int num) {
int n = num;
int sum = 0;
ulong len = to!string(num, 10).length;
while (n > 0) {
sum += pow(n % 10, len);
n /= 10;
len--;
}
return num == sum;
}
void main() {
int i = 0;
int count = 0;
while (count < 19) {
if (is_disarium(i)) {
printf("%d ", i);
count++;
}
i++;
}
writeln(" ");
}
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Dart
import "dart:math";
import "dart:io";
void main() {
var count = 0;
var i = 0;
while (count < 19) {
if (is_disarium(i)) {
stdout.write("$i ");
count++;
}
i++;
}
}
bool is_disarium(numb) {
var n = numb;
var len = n.toString().length;
var sum = 0;
while (n > 0) {
sum += (pow(n % 10, len)).toInt();
n = (n / 10).toInt();
len--;
}
return numb == sum;
}
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
dc
[10/ll1+sld0<Lx] sL [d10%ll^ls+ss10/ll1-sld0<Dx] sD[lc1+sc
lnp]sP[Osslisnln0sllLx0ssclnlDxlsln=Pli1+silc18>Ix] sI0si0sclIx- Output:
$ dc -e '[10/ll1+sld0<Lx] sL [d10%ll^ls+ss10/ll1-sld0<Dx] sD[lc1+sc lnp]sP[Osslisnln0sllLx0ssclnlDxlsln=Pli1+silc18>Ix] sI0si0sclIx' 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
Note that I printed out only 18 disarium numbers because it is getting very slow.
Explained version of the above:
# Macro for computing the input number length
[10 # pushes 10 to stack
/ # divides input by 10 and stores result on stack
ll # push length on stack
1+ # add one to stack (length)
# p # prints intermediate length (for debugging)
sl # saves length to register l
d # duplicates value (number) on top of stack
0 # pushes 0 to stack
<Lx # executes length macro (L) if number > 0
] sL # end of length macro, store it in L
# is Disarium macro
[d # duplicates value (number) on top of stack
10 # pushes 10 to stack
% # pushes (number % 10) to stack
ll # pushes length to stack
^ # computes (n % 10) ^ len
ls # pushes sum to stack
+ss # computes new sum and stores it in s
10/ # integer division number / 10
ll # pushes length on stack
1- # subtract 1 froml length
sl # stores new length in l
d # duplicates value (number) on top of stack
0 # pushes 0 to stack
<Dx # executes recursively disarium macro (D) if number > 0
] sD # stores disarium macro in D
# Printing and counting macro
[lc1+sc # increments disarium number counter
lnp # print number
]sP # Stores printing macro in P
# Iteration macro
[Oss # stores 0 in register s (sum)
li sn # Stores iteration variable in number register
ln # pushes number to stack
0sl # stores 0 in register l (length)
lLx # runs the length macro
0ss # inititialize sum to 0
cln # clear stack and pushes number onto it
# llp # print the length
lDx # runs the Disarium macro once
lsln # pushes sum and number
=P # runs the printing macro if numbers are equal
li # loads iteration variable
1+si # increments iteration variable
lc18 # pushes counter and 18 on stack
>Ix # runs recursively iteration macro if counter < 18
] sI # end of iteration macro, stores it in I
# Main
0si # Initiate iteration variable
0sc # Initiate disarium numbers counter
lIx # running iteration macro the first timeDraco
proc nonrec pow(byte base, exp) word:
word p;
p := 1;
while exp>0 do
p := p*base;
exp := exp-1
od;
p
corp
proc nonrec disarium(word n) bool:
[5]byte digits;
short i, len;
word input_n, dps;
dps := 0;
i := 0;
input_n := n;
while n > 0 do
digits[i] := n % 10;
n := n / 10;
i := i + 1
od;
len := i;
for i from 0 upto len-1 do
dps := dps + pow(digits[i], len-i)
od;
dps = input_n
corp
proc nonrec main() void:
word n;
for n from 0 upto 2500 do
if disarium(n) then writeln(n:5) fi
od
corp- Output:
0
1
2
3
4
5
6
7
8
9
89
135
175
518
598
1306
1676
2427
EasyLang
func disarium x .
h = x
while h > 0
d[] &= h mod 10
h = h div 10
.
for i = 1 to len d[]
h += pow d[i] (len d[] - i + 1)
.
return if h = x
.
while count < 19
if disarium n = 1
count += 1
print n
.
n += 1
.Factor
USING: io kernel lists lists.lazy math.ranges math.text.utils
math.vectors prettyprint sequences ;
: disarium? ( n -- ? )
dup 1 digit-groups dup length 1 [a,b] v^ sum = ;
: disarium ( -- list ) 0 lfrom [ disarium? ] lfilter ;
19 disarium ltake [ pprint bl ] leach nl
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
FOCAL
01.10 F N=0,2500;D 2
01.20 Q
02.10 D 3
02.20 I (N-S)2.4,2.3,2.4
02.30 T %5,N,!
02.40 R
03.10 S Z=N;S L=0
03.20 G 3.7
03.30 S K=FITR(Z/10)
03.40 S L=L+1
03.50 S D(L)=Z-K*10
03.60 S Z=K
03.70 I (-Z)3.3
03.80 S S=0
03.90 F I=1,L;S S=S+D(L-I+1)^I- Output:
= 0 = 1 = 2 = 3 = 4 = 5 = 6 = 7 = 8 = 9 = 89 = 135 = 175 = 518 = 598 = 1306 = 1676 = 2427
Forth
: pow 1 swap 0 ?do over * loop nip ;
: len 1 swap begin dup 10 >= while 10 / swap 1+ swap repeat drop ;
: dps 0 swap dup len
begin dup while
swap 10 /mod swap
2 pick pow
3 roll +
rot 1- rot
swap
repeat
2drop
;
: disarium dup dps = ;
: disaria 2700000 0 ?do i disarium if i . cr then loop ;
disaria
bye
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
FutureBasic
long c = 0, n = 0, t, i
CFStringRef s
while ( c < 18 )
s = fn StringWithFormat(@"%ld",n)
t = 0
for i = 0 to len(s) - 1
t += intVal(mid(s,i,1))^(i+1)
next
if ( t == n )
print n
c++
end if
n++
wend
HandleEventsGo
A translation of Version 2.
Although Go has native unsigned 64 bit arithmetic, much quicker than I was expecting at a little under a minute.
package main
import (
"fmt"
"strconv"
)
const DMAX = 20 // maximum digits
const LIMIT = 20 // maximum number of disariums to find
func main() {
// Pre-calculated exponential and power serials
EXP := make([][]uint64, 1+DMAX)
POW := make([][]uint64, 1+DMAX)
EXP[0] = make([]uint64, 11)
EXP[1] = make([]uint64, 11)
POW[0] = make([]uint64, 11)
POW[1] = make([]uint64, 11)
for i := uint64(1); i <= 10; i++ {
EXP[1][i] = i
}
for i := uint64(1); i <= 9; i++ {
POW[1][i] = i
}
POW[1][10] = 9
for i := 2; i <= DMAX; i++ {
EXP[i] = make([]uint64, 11)
POW[i] = make([]uint64, 11)
}
for i := 1; i < DMAX; i++ {
for j := 0; j <= 9; j++ {
EXP[i+1][j] = EXP[i][j] * 10
POW[i+1][j] = POW[i][j] * uint64(j)
}
EXP[i+1][10] = EXP[i][10] * 10
POW[i+1][10] = POW[i][10] + POW[i+1][9]
}
// Digits of candidate and values of known low bits
DIGITS := make([]int, 1+DMAX) // Digits form
Exp := make([]uint64, 1+DMAX) // Number form
Pow := make([]uint64, 1+DMAX) // Powers form
var exp, pow, min, max uint64
start := 1
final := DMAX
count := 0
for digit := start; digit <= final; digit++ {
fmt.Println("# of digits:", digit)
level := 1
DIGITS[0] = 0
for {
// Check limits derived from already known low bit values
// to find the most possible candidates
for 0 < level && level < digit {
// Reset path to try next if checking in level is done
if DIGITS[level] > 9 {
DIGITS[level] = 0
level--
DIGITS[level]++
continue
}
// Update known low bit values
Exp[level] = Exp[level-1] + EXP[level][DIGITS[level]]
Pow[level] = Pow[level-1] + POW[digit+1-level][DIGITS[level]]
// Max possible value
pow = Pow[level] + POW[digit-level][10]
if pow < EXP[digit][1] { // Try next since upper limit is invalidly low
DIGITS[level]++
continue
}
max = pow % EXP[level][10]
pow -= max
if max < Exp[level] {
pow -= EXP[level][10]
}
max = pow + Exp[level]
if max < EXP[digit][1] { // Try next since upper limit is invalidly low
DIGITS[level]++
continue
}
// Min possible value
exp = Exp[level] + EXP[digit][1]
pow = Pow[level] + 1
if exp > max || max < pow { // Try next since upper limit is invalidly low
DIGITS[level]++
continue
}
if pow > exp {
min = pow % EXP[level][10]
pow -= min
if min > Exp[level] {
pow += EXP[level][10]
}
min = pow + Exp[level]
} else {
min = exp
}
// Check limits existence
if max < min {
DIGITS[level]++ // Try next number since current limits invalid
} else {
level++ // Go for further level checking since limits available
}
}
// All checking is done, escape from the main check loop
if level < 1 {
break
}
// Finally check last bit of the most possible candidates
// Update known low bit values
Exp[level] = Exp[level-1] + EXP[level][DIGITS[level]]
Pow[level] = Pow[level-1] + POW[digit+1-level][DIGITS[level]]
// Loop to check all last bits of candidates
for DIGITS[level] < 10 {
// Print out new Disarium number
if Exp[level] == Pow[level] {
s := ""
for i := DMAX; i > 0; i-- {
s += fmt.Sprintf("%d", DIGITS[i])
}
n, _ := strconv.ParseUint(s, 10, 64)
fmt.Println(n)
count++
if count == LIMIT {
fmt.Println("\nFound the first", LIMIT, "Disarium numbers.")
return
}
}
// Go to followed last bit candidate
DIGITS[level]++
Exp[level] += EXP[level][1]
Pow[level]++
}
// Reset to try next path
DIGITS[level] = 0
level--
DIGITS[level]++
}
fmt.Println()
}
}
- Output:
# of digits: 1 0 1 2 3 4 5 6 7 8 9 # of digits: 2 89 # of digits: 3 135 175 518 598 # of digits: 4 1306 1676 2427 # of digits: 5 # of digits: 6 # of digits: 7 2646798 # of digits: 8 # of digits: 9 # of digits: 10 # of digits: 11 # of digits: 12 # of digits: 13 # of digits: 14 # of digits: 15 # of digits: 16 # of digits: 17 # of digits: 18 # of digits: 19 # of digits: 20 12157692622039623539 Found the first 20 Disarium numbers. real 0m57.430s user 0m57.420s sys 0m0.105s
Haskell
module Disarium
where
import Data.Char ( digitToInt)
isDisarium :: Int -> Bool
isDisarium n = (sum $ map (\(c , i ) -> (digitToInt c ) ^ i )
$ zip ( show n ) [1 , 2 ..]) == n
solution :: [Int]
solution = take 18 $ filter isDisarium [0, 1 ..]
- Output:
[0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427]
J
digits=: "."0@":
disarium=: = (+/@:^ #\)@digits"0
I. disarium i. 27e5
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Java
import java.lang.Math;
public class DisariumNumbers {
public static boolean is_disarium(int num) {
int n = num;
int len = Integer.toString(n).length();
int sum = 0;
int i = 1;
while (n > 0) {
sum += Math.pow(n % 10, len - i + 1);
n /= 10;
i ++;
}
return sum == num;
}
public static void main(String[] args) {
int i = 0;
int count = 0;
while (count <= 18) {
if (is_disarium(i)) {
System.out.printf("%d ", i);
count++;
}
i++;
}
System.out.printf("%s", "\n");
}
}
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
JavaScript
function is_disarium (num) {
let n = num
let len = n.toString().length
let sum = 0
while (n > 0) {
sum += (n % 10) ** len
n = parseInt(n / 10, 10)
len--
}
return num == sum
}
let count = 0
let i = 1
while (count < 18) {
if (is_disarium(i)) {
process.stdout.write(i + " ")
count++
}
i++
}
- Output:
1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
jq
Also works with gojq, the Go implementation of jq
The naive algorithm is good enough to find the first 19 disarium numbers, ergo `limit(19; ...)` below.
# To take advantage of gojq's arbitrary-precision integer arithmetic:
def power($in;$b): reduce range(0;$b) as $i (1; . * $in);
# $n is assumed to be a non-negative integer
def is_disarium:
. as $n
| {$n, sum: 0, len: (tostring|length) }
| until (.n == 0;
.sum += power(.n % 10; .len)
| .n = (.n/10 | floor)
| .len -= 1 )
| .sum == $n ;
# Emit a stream ...
def disariums:
range(0; infinite) | select(is_disarium);
limit(19; disariums)- Output:
0 ... 2646798
Julia
isdisarium(n) = sum(last(p)^first(p) for p in enumerate(reverse(digits(n)))) == n
function disariums(numberwanted)
n, ret = 0, Int[]
while length(ret) < numberwanted
isdisarium(n) && push!(ret, n)
n += 1
end
return ret
end
println(disariums(19))
@time disariums(19)
- Output:
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798] 0.555962 seconds (5.29 M allocations: 562.335 MiB, 10.79% gc time)
Kotlin
fun power(n: Int, exp: Int): Int {
return when {
exp > 1 -> n * power(n, exp-1)
exp == 1 -> n
else -> 1
}
}
fun is_disarium(num: Int): Boolean {
val n = num.toString()
var sum = 0
for (i in 1..n.length) {
sum += power (n[i-1] - '0', i)
}
return sum == num
}
fun main() {
var i = 0
var count = 0
while (count < 19) {
if (is_disarium(i)) {
print("$i ")
count++
}
i++
}
println("")
}
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Lua
Like most other solutions, this stops at 19. Computation time aside, the 20th Disarium number is greater than 2^53, above which double-precision floating-point format (which is Lua's in-built number type) has insufficient precision to distinguish between one integer and the next.
function isDisarium (x)
local str, sum, digit = tostring(x), 0
for pos = 1, #str do
digit = tonumber(str:sub(pos, pos))
sum = sum + (digit ^ pos)
end
return sum == x
end
local count, n = 0, 0
while count < 19 do
if isDisarium(n) then
count = count + 1
io.write(n .. " ")
end
n = n + 1
end
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
MAD
NORMAL MODE IS INTEGER
VECTOR VALUES FMT = $ I7*$
AMOUNT = 19
THROUGH TEST, FOR CAND=0, 1, AMOUNT.E.0
WHENEVER DISARI.(CAND)
PRINT FORMAT FMT,CAND
AMOUNT = AMOUNT-1
END OF CONDITIONAL
TEST CONTINUE
INTERNAL FUNCTION(N)
ENTRY TO LENGTH.
L = 0
THROUGH COUNT, FOR NN=N, 0, NN.E.0
L = L+1
COUNT NN = NN/10
FUNCTION RETURN L
END OF FUNCTION
INTERNAL FUNCTION(BASE,EXP)
ENTRY TO RAISE.
R = 1
THROUGH MUL, FOR E=EXP, -1, E.E.0
MUL R = R*BASE
FUNCTION RETURN R
END OF FUNCTION
INTERNAL FUNCTION(N)
ENTRY TO DISARI.
L = LENGTH.(N)
POWSUM = 0
THROUGH DGTLP, FOR NN=N, 0, NN.E.0
NX = NN/10
DG = NN-NX*10
POWSUM = POWSUM+RAISE.(DG,L)
L = L-1
DGTLP NN = NX
FUNCTION RETURN POWSUM.E.N
END OF FUNCTION
END OF PROGRAM- Output:
0
1
2
3
4
5
6
7
8
9
89
135
175
518
598
1306
1676
2427
2646798
Mathematica /Wolfram Language
ClearAll[DisariumQ]
DisariumQ[n_Integer] := Module[{digs},
digs = IntegerDigits[n];
digs = digs^Range[Length[digs]];
Total[digs] == n
]
i = 0;
Reap[Do[
If[DisariumQ[n],
i++;
Sow[n]
];
If[i == 19, Break[]]
,
{n, 0, \[Infinity]}
]][[2, 1]]
- Output:
{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798}
Maxima
/* Function that returns a list of digits given a nonnegative integer */
decompose(num) := block([digits, remainder],
digits: [],
while num > 0 do
(remainder: mod(num, 10),
digits: cons(remainder, digits),
num: floor(num/10)),
digits
)$
disariump(n):=block(
decompose(n),
makelist(%%[i]^i,i,length(%%)),
apply("+",%%),
if n=%% then true)$
disarium_count(len):=block([i:0,count:0,result:[]],
while count<len do (if disariump(i) then (result:endcons(i,result),count:count+1),i:i+1),
result)$
/*Test cases */
disarium_count(18);
- Output:
[0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427]
MiniScript
isDisarium = function(n)
num = n
sum = 0
if num == 0 then return true
for i in range(ceil(log(n)), 1)
sum += (n % 10) ^ i
n = floor(n / 10)
end for
return num == sum
end function
foundCnt = 0
cnt = 0
while foundCnt < 19
if isDisarium(cnt) then
foundCnt += 1
print cnt
end if
cnt +=1
end while
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Miranda
main :: [sys_message]
main = [Stdout (show (take 18 disaria)), Stdout "\n"]
disaria :: [num]
disaria = filter disarium [0..]
disarium :: num->bool
disarium n = n = sum (zipWith (^) (digits n) [1..])
digits :: num->[num]
digits 0 = [0]
digits n = reverse (digits' n)
where digits' 0 = []
digits' n = (n mod 10) : digits' (n div 10)
zipWith :: (* -> ** -> ***) -> [*] -> [**] -> [***]
zipWith f x y = map f' (zip2 x y)
where f' (x,y) = f x y- Output:
[0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427]
Modula-2
MODULE DisariumNumbers;
FROM InOut IMPORT WriteLn, WriteCard;
CONST Max = 2500;
VAR n: CARDINAL;
PROCEDURE cpow(base, power: CARDINAL): CARDINAL;
VAR i, result: CARDINAL;
BEGIN
result := 1;
FOR i := 1 TO power DO
result := result * base
END;
RETURN result
END cpow;
PROCEDURE length(n: CARDINAL): CARDINAL;
VAR len: CARDINAL;
BEGIN
len := 1;
WHILE n > 10 DO
INC(len);
n := n DIV 10
END;
RETURN len
END length;
PROCEDURE digitpowersum(n: CARDINAL): CARDINAL;
VAR powsum, exp: CARDINAL;
BEGIN
powsum := 0;
FOR exp := length(n) TO 1 BY -1 DO
powsum := powsum + cpow(n MOD 10, exp);
n := n DIV 10
END;
RETURN powsum
END digitpowersum;
PROCEDURE disarium(n: CARDINAL): BOOLEAN;
BEGIN
RETURN digitpowersum(n) = n
END disarium;
BEGIN
FOR n := 0 TO Max DO
IF disarium(n) THEN
WriteCard(n, 5);
WriteLn
END
END
END DisariumNumbers.
- Output:
0
1
2
3
4
5
6
7
8
9
89
135
175
518
598
1306
1676
2427
Nim
import strutils
import math
proc is_disarium(num: int): bool =
let n = intToStr(num)
var sum = 0
for i in 0..len(n)-1:
sum += int((int(n[i])-48) ^ (i+1))
return sum == num
var i = 0
var count = 0
while count < 19:
if is_disarium(i):
stdout.write i, " "
count += 1
i += 1
echo ""
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
OCaml
(* speed-optimized exponentiation; doesn't support exponents < 2 *)
let rec pow b n =
if n land 1 = 0
then if n = 2 then b * b else pow (b * b) (n lsr 1)
else if n = 3 then b * b * b else b * pow (b * b) (n lsr 1)
let is_disarium n =
let rec aux x f =
if x < 10
then f 2 x
else aux (x / 10) (fun l y -> f (succ l) (y + pow (x mod 10) l))
in
n = aux n Fun.(const id)
let () =
Seq.(ints 0 |> filter is_disarium |> take 19 |> iter (Printf.printf " %u%!"))
|> print_newline
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Odin
package disarium
import "core:fmt"
import "core:math"
/* main block start */
main :: proc() {
fmt.print("\nThe first 18 Disarium numbers are:")
count, i: int
for count < 19 {
if is_disarium(i) {
fmt.print(" ", i)
count += 1
}
i += 1
}
fmt.println("")
} /* main block end */
/* proc definitions */
power :: proc(base, exponent: int) -> int {
result := 1
for _ in 1 ..= exponent {
result *= base
}
return result
}
is_disarium :: proc(num: int) -> bool {
n := num
sum := 0
len := n <= 9 ? 1 : cast(int)math.floor_f64(math.log10_f64(auto_cast n) + 1)
for n > 0 {
sum += power(n % 10, len)
n /= 10
len -= 1
}
return num == sum
}
- Output:
The first 18 Disarium numbers are: 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Pascal
Free Pascal
simply adding one by one and keep track of sums.
program disarium;
//compile with fpc -O3 -Xs
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
{$IFDEF FPC}
{$Mode Delphi}
uses
sysutils;
{$ELSE}
uses
system.SysUtils;
{$ENDIF}
const
MAX_BASE = 16;
cDigits : array[0..MAX_BASE-1] of char =
('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
MAX_DIGIT_CNT = 31;
type
tDgt_cnt= 0..MAX_DIGIT_CNT-1;
tdgtPows = array[tDgt_cnt,0..MAX_BASE] of Uint64;
tdgtMaxSumPot = array[tDgt_cnt] of Uint64;
tmyDigits = record
dgtPot : array[tDgt_cnt] of Uint64;
dgtSumPot : array[tDgt_cnt] of Uint64;
dgtNumber : UInt64;
digit : array[0..31] of byte;
dgtMaxLen : tDgt_cnt;
end;
const
UPPER_LIMIT = 100*1000*1002;
var
{$Align 32}
dgtPows :tdgtPows;
procedure InitMyPots(var mp :tdgtPows;base:int32);
var
pot,dgt:Uint32;
p : Uint64;
begin
fillchar(mp,SizeOf(mp),#0);
For dgt := 0 to BASE do
begin
p := dgt;
For pot in tDgt_cnt do
begin
mp[pot,dgt] := p;
p := p*dgt;
end;
end;
p := 0;
end;
procedure Out_Digits(var md:tmyDigits);
var
i : Int32;
Begin
with md do
begin
write('dgtNumber ',dgtNumber,' = ',dgtSumPot[0],' in Base ');
For i := dgtMaxLen-1 downto 0 do
write(cDigits[digit[i]]);
writeln;
end;
end;
procedure IncByOne(var md:tmyDigits;Base: Int32);inline;
var
PotSum : Uint64;
potBase: nativeInt;
dg,pot,idx : Int32;
Begin
with md do
begin
//first digit seperate
pot := dgtMaxLen-1;
dg := digit[0]+1;
if dg < BASE then
begin
inc(dgtNumber);
digit[0]:= dg;
dgtPot[0] := dgtPows[pot,dg];
dgtSumPot[0] := dgtSumPot[1] + dgtPot[0];
EXIT;
end;
dec(dgtNumber,Base-1);
digit[0]:= 0;
dgtPot[0]:= 0;
dgtSumPot[0] := dgtSumPot[1];
potbase := Base;
idx := 1;
dec(pot);
while pot >= 0 do
Begin
dg := digit[idx]+1;
if dg < BASE then
begin
inc(dgtNumber,potbase);
digit[idx]:= dg;
dgtPot[idx]:= dgtPows[pot,dg];
PotSum := dgtSumPot[idx+1];
//update sum
while idx>=0 do
begin
inc(PotSum,dgtPot[idx]);
dgtSumPot[idx] := PotSum;
dec(idx);
end;
EXIT;
end;
dec(dgtNumber,(dg-1)*PotBase);
potbase *= Base;
digit[idx]:= 0;
dgtPot[idx] := 0;
dec(pot);
inc(idx);
end;
For pot := idx downto 0 do
Begin
dgtPot[idx] :=0;
dgtSumPot[pot] := 1;
end;
digit[idx] := 1;
dgtPot[idx] :=1;
dgtMaxLen := idx+1;
dgtNumber := potbase;
end;
end;
procedure OneRun(var s: tmyDigits;base:UInt32;Limit:Int64);
var
i : int64;
cnt : Int32;
begin
Writeln('Base = ',base);
InitMyPots(dgtPows,base);
fillchar(s,SizeOf(s),#0);
s.dgtMaxLen := 1;
i := 0;
cnt := 0;
repeat
if s.dgtSumPot[0] = s.dgtNumber then
Begin
Out_Digits(s);
inc(cnt);
end;
IncByOne(s,base);
inc(i);
until (i>=Limit);
writeln ( i,' increments and found ',cnt);
end;
var
{$Align 32}
s : tmyDigits;
T0: TDateTime;
base: nativeInt;
Begin
base := 10;
T0 := time;
OneRun(s,base,2646799);
T0 := (time-T0)*86400;
writeln(T0:8:3,' s');
writeln;
base := 11;
T0 := time;
OneRun(s,base,100173172);
T0 := (time-T0)*86400;
writeln(T0:8:3,' s');
writeln;
{$IFDEF WINDOWS}
readln;
{$ENDIF}
end.
- @TIO.RUN:
Base = 10 dgtNumber 0 = 0 in Base 0 dgtNumber 1 = 1 in Base 1 dgtNumber 2 = 2 in Base 2 dgtNumber 3 = 3 in Base 3 dgtNumber 4 = 4 in Base 4 dgtNumber 5 = 5 in Base 5 dgtNumber 6 = 6 in Base 6 dgtNumber 7 = 7 in Base 7 dgtNumber 8 = 8 in Base 8 dgtNumber 9 = 9 in Base 9 dgtNumber 89 = 89 in Base 89 dgtNumber 135 = 135 in Base 135 dgtNumber 175 = 175 in Base 175 dgtNumber 518 = 518 in Base 518 dgtNumber 598 = 598 in Base 598 dgtNumber 1306 = 1306 in Base 1306 dgtNumber 1676 = 1676 in Base 1676 dgtNumber 2427 = 2427 in Base 2427 dgtNumber 2646798 = 2646798 in Base 2646798 2646799 increments and found 19 0.008 s Base = 11 dgtNumber 0 = 0 in Base 0 dgtNumber 1 = 1 in Base 1 dgtNumber 2 = 2 in Base 2 dgtNumber 3 = 3 in Base 3 dgtNumber 4 = 4 in Base 4 dgtNumber 5 = 5 in Base 5 dgtNumber 6 = 6 in Base 6 dgtNumber 7 = 7 in Base 7 dgtNumber 8 = 8 in Base 8 dgtNumber 9 = 9 in Base 9 dgtNumber 10 = 10 in Base A dgtNumber 27 = 27 in Base 25 dgtNumber 39 = 39 in Base 36 dgtNumber 109 = 109 in Base 9A dgtNumber 126 = 126 in Base 105 dgtNumber 525 = 525 in Base 438 dgtNumber 580 = 580 in Base 488 dgtNumber 735 = 735 in Base 609 dgtNumber 1033 = 1033 in Base 85A dgtNumber 1044 = 1044 in Base 86A dgtNumber 2746 = 2746 in Base 2077 dgtNumber 59178 = 59178 in Base 40509 dgtNumber 63501 = 63501 in Base 43789 dgtNumber 100173171 = 100173171 in Base 515AA64A 100173172 increments and found 24 0.294 s
PascalABC.NET
##
function disariums: sequence of integer;
begin
var n := 0;
while true do
begin
var sum := 0.0;
foreach var x in n.ToString.ToCharArray index i do
sum := sum + power((x.todigit), i + 1);
if sum = n then yield (n);
n += 1;
end;
end;
disariums.Take(19).Println;
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Perl
use strict;
use warnings;
my ($n,@D) = (0, 0);
while (++$n) {
my($m,$sum);
map { $sum += $_ ** ++$m } split '', $n;
push @D, $n if $n == $sum;
last if 19 == @D;
}
print "@D\n";
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Phix
with javascript_semantics constant limit = 19 integer count = 0, n = 0 printf(1,"The first 19 Disarium numbers are:\n") while count<limit do atom dsum = 0 string digits = sprintf("%d",n) for i=1 to length(digits) do dsum += power(digits[i]-'0',i) end for if dsum=n then printf(1," %d",n) count += 1 end if n += 1 end while
- Output:
The first 19 Disarium numbers are: 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
stretch
with javascript_semantics -- translation of https://github.com/rgxgr/Disarium-Numbers/blob/master/Disarium.c constant DMAX = iff(machine_bits()=64?20:7) // Pre-calculated exponential & power serials sequence exps = repeat(repeat(0,11),1+DMAX), pows = repeat(repeat(0,11),1+DMAX) exps[1..2] = {{0,0,0,0,0,0,0,0,0,0,1},{0,1,2,3,4,5,6,7,8,9,10}} pows[1..2] = {{0,0,0,0,0,0,0,0,0,0,0},{0,1,2,3,4,5,6,7,8,9, 9}} for i=2 to DMAX do for j=1 to 10 do exps[i+1][j] = exps[i][j]*10 pows[i+1][j] = pows[i][j]*(j-1) end for exps[i+1][11] = exps[i][11]*10 pows[i+1][11] = pows[i][11] + pows[i+1][10] end for // Digits of candidate and values of known low bits sequence digits = repeat(0,1+DMAX), // Digits form expl = repeat(0,1+DMAX), // Number form powl = repeat(0,1+DMAX) // Powers form printf(1,"") -- (exclude console setup from timings [if pw.exe]) atom expn, powr, minn, maxx, t0 = time(), t1 = t0+1, count = 0 for digit=2 to DMAX+1 do printf(1,"Searching %d digits (started at %s):\n", {digit-1,elapsed(time()-t0)}); integer level = 2 digits[1] = 0 while true do // Check limits derived from already known low bit values // to find the most possible candidates while 1<level and level<digit do // Reset path to try next if checking in level is done integer dl = digits[level]+1 if dl>10 then digits[level] = 0; level -= 1 digits[level] += 1 else // Update known low bit values expl[level] = expl[level-1] + exps[level][dl] powl[level] = powl[level-1] + pows[digit-level+2][dl] // Max possible value powr = powl[level] + pows[digit-level+1][11] atom ed2 = exps[digit][2] if powr<ed2 then // Try next since upper limit is invalidly low digits[level] += 1 else atom el11 = exps[level][11], el = expl[level] maxx = remainder(powr,el11) powr -= maxx if maxx<el then powr -= el11 end if maxx = powr + el if maxx<ed2 then // Try next since upper limit is invalidly low digits[level] += 1 else // Min possible value expn = el + ed2 powr = powl[level] + 1 if expn>maxx or maxx<powr then // Try next since upper limit is invalidly low digits[level] += 1 else if powr>expn then minn = remainder(powr,el11) powr -= minn if minn>el then powr += el11 end if minn = powr + el else minn = expn end if // Check limits existence if maxx<minn then digits[level] +=1 // Try next number since current limits invalid else level +=1 // Go for further level checking since limits available end if end if end if end if end if if time()>t1 and platform()!=JS then progress("working:%v... (%s)",{digits,elapsed(time()-t0)}) t1 = time()+1 end if end while // All checking is done, escape from the main check loop if level<2 then exit end if // Final check last bit of the most possible candidates // Update known low bit values integer dlx = digits[level]+1 expl[level] = expl[level-1] + exps[level][dlx]; powl[level] = powl[level-1] + pows[digit+1-level][dlx]; // Loop to check all last bit of candidates while digits[level]<10 do // Print out new disarium number if expl[level] == powl[level] then if platform()!=JS then progress("") end if integer ld = max(trim_tail(digits,0,true),2) printf(1,"%s\n",{reverse(join(apply(digits[2..ld],sprint),""))}) count += 1 end if // Go to followed last bit candidate digits[level] += 1 expl[level] += exps[level][2] powl[level] += 1 end while // Reset to try next path digits[level] = 0; level -= 1 digits[level] += 1 end while if platform()!=JS then progress("") end if end for printf(1,"%d disarium numbers found (%s)\n",{count,elapsed(time()-t0)})
- Output:
Searching 1 digits (started at 0s): 0 1 2 3 4 5 6 7 8 9 Searching 2 digits (started at 0s): 89 Searching 3 digits (started at 0s): 135 175 518 598 Searching 4 digits (started at 0s): 1306 1676 2427 Searching 5 digits (started at 0.0s): Searching 6 digits (started at 0.0s): Searching 7 digits (started at 0.0s): 2646798 Searching 8 digits (started at 0.0s): Searching 9 digits (started at 0.0s): Searching 10 digits (started at 0.0s): Searching 11 digits (started at 0.1s): Searching 12 digits (started at 0.1s): Searching 13 digits (started at 0.3s): Searching 14 digits (started at 0.8s): Searching 15 digits (started at 2.5s): Searching 16 digits (started at 6.9s): Searching 17 digits (started at 23.2s): Searching 18 digits (started at 1 minute and 8s): Searching 19 digits (started at 3 minutes and 35s): Searching 20 digits (started at 10 minutes and 8s): 12157692622039623539 20 disarium numbers found (2 hours and 7s)
Takes about 48min to find the 20 digit number, then trundles away for over another hour. I think that technically it should also scan for 21 and 22 digit numbers to be absolutely sure there aren't any, but that certainly exceeds my patience.
Picat
Iterative approach
main =>
Limit = 19,
D = [],
N = 0,
printf("The first %d Disarium numbers are:\n",Limit),
while (D.len < Limit)
if disarium_number(N) then
D := D ++ [N]
end,
N := N + 1,
if N mod 10_000_000 == 0 then
println(test=N)
end
end,
println(D).
disarium_number(N) =>
Sum = 0,
Digits = N.to_string.len,
X = N,
while (X != 0, Sum <= N)
Sum := Sum + (X mod 10) ** Digits,
Digits := Digits - 1,
X := X div 10
end,
Sum == N.- Output:
The first 19 Disarium numbers are: [0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427,2646798] 2.905s
Constraint modelling
A faster approach is to use constraint modeling. It finds the first 19 Disarium numbers in 0.591s (vs 2.905s for the iterative approach).
Note that the domain of Picat's constraint variables is -2**56..2**56 (about 10**17) which means that this approach cannot be used to handle numbers of length 20.
The cp solver and sat solvers takes about the same time for finding the 7-digits number 2646798, but the sat solver is much faster for checking longer numbers; it took almost 9 minutes to prove that there are no Disarium numbers of length 8..17.
import sat.
% import cp.
main =>
D = [],
Limit = 19,
Base = 10,
foreach(Len in 1..20, D.len < Limit)
Nums = disarium_number_cp(Len,Base),
if Nums.len > 0 then
foreach(Num in Nums)
B = to_radix_string(Num,Base),
D := D ++ [B]
end
end
end,
printf("The first %d Disarius numbers in base %d:\n",D.len, Base),
println(D[1..Limit]),
nl.
% Find all Disarium of a certain length
disarium_number_cp(Len,Base) = findall(N,disarium_number_cp(Len,Base,N)).sort.
% Find a Disarium number of a certain length
disarium_number_cp(Len,Base,N) =>
X = new_list(Len),
X :: 0..Base-1,
N :: Base**(Len-1)-1..Base**Len-1,
N #= sum([X[I]**I : I in 1..Len]),
to_num(X,Base,N), % convert X <=> N
solve($[],X++[N]).
% Converts a number Num to/from a list of integer List given a base Base
to_num(List, Base, Num) =>
Len = length(List),
Num #= sum([List[I]*Base**(Len-I) : I in 1..Len]).- Output:
The first 19 Disarius numbers in base 10: [0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427,2646798] 0.591s
Finding the first 23 Disarium numbers in base 11 is easier:
The first 23 Disarius numbers in base 11: [0,1,2,3,4,5,6,7,8,9,A,25,36,9A,105,438,488,609,85A,86A,2077,40509,43789] 0.015s
(And finding the first 36 Disarium numbers in base 36 is even easier: 0..Z.)
PicoLisp
(de disarium (N)
(let S 0
(for (I . N) (mapcar format (chop N))
(inc 'S (** N I)) )
(= N S) ) )
(let (N 0 C 0)
(until (= C 19)
(and
(disarium N)
(printsp N)
(inc 'C) )
(inc 'N) )
(prinl) )
Python
#!/usr/bin/python
def isDisarium(n):
digitos = len(str(n))
suma = 0
x = n
while x != 0:
suma += (x % 10) ** digitos
digitos -= 1
x //= 10
if suma == n:
return True
else:
return False
if __name__ == '__main__':
limite = 19
cont = 0
n = 0
print("The first",limite,"Disarium numbers are:")
while cont < limite:
if isDisarium(n):
print(n, end = " ")
cont += 1
n += 1
- Output:
The first 19 Disarium numbers are: 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
PL/M
Based on...
... but as the original PL/M compiler only supports 8 and 16-bit unsigned integers, this stops after trying up to 9999 or finding 18 Disarium numbers. Also, PL/M only supports 1-dimensional arrays.
... under CP/M (or an emulator)
100H: /* FIND SOME DISARIUM NUMBERS - NUMBERS WHOSE DIGIT POSITION-POWER */
/* SUMS ARE EQUAL TO THE NUMBER, E.G. 135 = 1^1 + 3^2 + 5^3 */
/* CP/M BDOS SYSTEM CALL, IGNORE THE RETURN VALUE */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
/* TABLE OF POWERS UP TO THE FOURTH POWER - AS WE ARE ONLY FINDING THE */
/* DISARIUM NUMBERS UP TO 9999 */
DECLARE POWER( 40 /* ( 1 : 4, 0 : 9 ) */ ) ADDRESS;
DECLARE MAX$DISARIUM LITERALLY '9999';
DECLARE ( N, D, POWER$OF$TEN, COUNT, LENGTH, V, P, DPS, NSUB, NPREV )
ADDRESS;
/* COMPUTE THE NTH POWERS OF 0-9 */
DO D = 0 TO 9; POWER( D ) = D; END;
NSUB = 10;
NPREV = 0;
DO N = 2 TO 4;
POWER( NSUB ) = 0;
DO D = 1 TO 9;
POWER( NSUB + D ) = POWER( NPREV + D ) * D;
END;
NPREV = NSUB;
NSUB = NSUB + 10;
END;
/* PRINT THE DISARIUM NUMBERS UPTO 9999 OR THE 18TH, WHICHEVER IS SOONER */
POWER$OF$TEN = 10;
LENGTH = 1;
COUNT, N = 0;
DO WHILE( N < MAX$DISARIUM AND COUNT < 18 );
IF N = POWER$OF$TEN THEN DO;
/* THE NUMBER OF DIGITS JUST INCREASED */
POWER$OF$TEN = POWER$OF$TEN * 10;
LENGTH = LENGTH + 1;
END;
/* FORM THE DIGIT POWER SUM */
V = N;
P = LENGTH * 10;
DPS = 0;
DO D = 1 TO LENGTH;
P = P - 10;
DPS = DPS + POWER( P + ( V MOD 10 ) );
V = V / 10;
END;
IF DPS = N THEN DO;
/* N IS DISARIUM */
COUNT = COUNT + 1;
CALL PR$CHAR( ' ' );
CALL PR$NUMBER( N );
END;
N = N + 1;
END;
EOF- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
Quackery
[ [ [] swap
[ 10 /mod
rot join swap
dup 0 = until ]
drop ] ] is digits ( n --> [ )
[ 0 over digits
witheach
[ i^ 1+ ** + ] = ] is disarium ( n --> b )
[ temp put [] 0
[ dup disarium if
[ dup dip join ]
1+
over size
temp share = until ]
drop ] is disariums ( n --> [ )
19 disariums echo- Output:
[ 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798 ]
Raku
Not an efficient algorithm. First 18 in less than 1/4 second. 19th in around 45 seconds. Pretty much unusable for the 20th.
my $disarium = (^∞).hyper.map: { $_ if $_ == sum .polymod(10 xx *).reverse Z** 1..* };
put $disarium[^18];
put $disarium[18];
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Refal
$ENTRY Go {
= <FindDisarium 19 0>;
};
Digits {
0 = ;
s.N, <Divmod s.N 10>: (s.R) s.D = <Digits s.R> s.D;
};
Pow {
s.N 0 = 1;
s.N s.P = <* s.N <Pow s.N <- s.P 1>>>;
};
PowSum {
() e.P = 0;
(s.I e.X) e.P = <+ <Pow s.I e.P> <PowSum (e.X) <+ e.P 1>>>;
e.X = <PowSum (e.X) 1>;
};
Disarium {
e.N, <PowSum <Digits e.N>>: e.N = True;
e.N = False;
};
FindDisarium {
0 s.N = ;
s.I s.N, <Disarium s.N>: {
True = <Prout s.N> <FindDisarium <- s.I 1> <+ s.N 1>>;
False = <FindDisarium s.I <+ s.N 1>>;
};
};- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
RPL
≪ DUP →STR → digits
≪ 0
1 digits SIZE FOR j
digits j DUP SUB STR→ j ^ +
NEXT
==
≫ ≫ 'DSRM?' STO
≪ → max
≪ { } 0
WHILE OVER SIZE max < REPEAT
IF DUP DSRM? THEN SWAP OVER + SWAP END
1 +
END DROP
≫ ≫ 'DSRMN' STO
18 DSRMN
- Output:
{ 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 }
Ruby
disariums = Enumerator.new do |y|
(0..).each do |n|
i = 0
y << n if n.digits.reverse.sum{|d| d ** (i+=1) } == n
end
end
puts disariums.take(19).to_a.join(" ")
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Rust
fn power(n: i32, exp: i32) -> i32 {
let mut result = 1;
for _i in 0..exp {
result *= n;
}
return result;
}
fn is_disarium(num: i32) -> bool {
let mut n = num;
let mut sum = 0;
let mut i = 1;
let len = num.to_string().len();
while n > 0 {
sum += power(n % 10, len as i32 - i + 1);
n /= 10;
i += 1
}
return sum == num;
}
fn main() {
let mut i = 0;
let mut count = 0;
while count <= 18 {
if is_disarium(i) {
print!("{} ", i);
count += 1;
}
i += 1;
}
println!("{}", " ")
}
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Ring
i = 0
count = 0
while count < 19
if is_disarium(i)
see "" + i + " "
count++
ok
i++
end
see nl
func pow (base, exp)
result = 1
for i = 0 to exp - 1
result *= base
next
return result
func is_disarium (num)
n = "" + num
sum = 0
for i = 1 to len(n)
sum += pow (n[i] % 10, i)
next
return sum = num- Output:
$ ring ./disarium.ring 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Scala
object Disarium extends App {
def power(base: Int, exp: Int): Int = {
var result = 1
for (i <- 1 to exp) {
result *= base
}
return result
}
def is_disarium(num: Int): Boolean = {
val digits = num.toString.split("")
var sum = 0
for (i <- 0 to (digits.size - 1)) {
sum += power(digits(i).toInt, i + 1)
}
return num == sum
}
var i = 0
var count = 0
while (count < 19) {
if (is_disarium(i)) {
count += 1
printf("%d ", i)
}
i += 1
}
println("")
}
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
SETL
program disarium_numbers;
loop for n in [0..2700000] | disarium n do
print(n);
end loop;
op disarium(n);
k := n;
digits := [[k mod 10, k div:= 10](1) : until k=0];
p := #digits+1;
powsum := +/[d ** (p -:= 1) : d in digits];
return powsum = n;
end op;
end program;- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Sidef
func is_disarium(n) {
n.digits.flip.sum_kv{|k,d| d**(k+1) } == n
}
say 18.by(is_disarium)
- Output:
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427]
Tcl
proc is_disarium {num} {
set n num
set sum 0
set i 1
set ch 1
foreach char [split $num {}] {
scan $char %d ch
set sum [ expr ($sum + $ch ** $i)]
incr i
}
return [ expr $num == $sum ? 1 : 0]
}
set i 0
set count 0
while { $count < 19 } {
if [ is_disarium $i ] {
puts -nonewline "${i} "
incr count
}
incr i
}
puts ""
- Output:
$ time tclsh ./disarium.tcl 0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798 real 1m59,638s user 1m56,328s sys 0m0,234s }
V (Vlang)
Recommend to build first `v -prod disarium.v` and then run `./disarium`
import strconv
const dmax = 20 // maximum digits
const limit = 20 // maximum number of disariums to find
fn main() {
// Pre-calculated exponential and power serials
mut exp1 := [][]u64{len: 1+dmax, init: []u64{len: 11}}
mut pow1 := [][]u64{len: 1+dmax, init: []u64{len: 11}}
for i := u64(1); i <= 10; i++ {
exp1[1][i] = i
}
for i := u64(1); i <= 9; i++ {
pow1[1][i] = i
}
pow1[1][10] = 9
for i := 1; i < dmax; i++ {
for j := 0; j <= 9; j++ {
exp1[i+1][j] = exp1[i][j] * 10
pow1[i+1][j] = pow1[i][j] * u64(j)
}
exp1[i+1][10] = exp1[i][10] * 10
pow1[i+1][10] = pow1[i][10] + pow1[i+1][9]
}
// Digits of candidate and values of known low bits
mut digits := []int{len: 1+dmax} // Digits form
mut exp2 := []u64{len: 1+dmax} // Number form
mut pow2 := []u64{len: 1+dmax} // pow2ers form
mut exp, mut pow, mut min, mut max := u64(0),u64(0),u64(0),u64(0)
start := 1
final := dmax
mut count := 0
for digit := start; digit <= final; digit++ {
println("# of digits: $digit")
mut level := 1
digits[0] = 0
for {
// Check limits derived from already known low bit values
// to find the most possible candidates
for 0 < level && level < digit {
// Reset path to try next if checking in level is done
if digits[level] > 9 {
digits[level] = 0
level--
digits[level]++
continue
}
// Update known low bit values
exp2[level] = exp2[level-1] + exp1[level][digits[level]]
pow2[level] = pow2[level-1] + pow1[digit+1-level][digits[level]]
// Max possible value
pow = pow2[level] + pow1[digit-level][10]
if pow < exp1[digit][1] { // Try next since upper limit is invalidly low
digits[level]++
continue
}
max = pow % exp1[level][10]
pow -= max
if max < exp2[level] {
pow -= exp1[level][10]
}
max = pow + exp2[level]
if max < exp1[digit][1] { // Try next since upper limit is invalidly low
digits[level]++
continue
}
// Min possible value
exp = exp2[level] + exp1[digit][1]
pow = pow2[level] + 1
if exp > max || max < pow { // Try next since upper limit is invalidly low
digits[level]++
continue
}
if pow > exp {
min = pow % exp1[level][10]
pow -= min
if min > exp2[level] {
pow += exp1[level][10]
}
min = pow + exp2[level]
} else {
min = exp
}
// Check limits existence
if max < min {
digits[level]++ // Try next number since current limits invalid
} else {
level++ // Go for further level checking since limits available
}
}
// All checking is done, escape from the main check loop
if level < 1 {
break
}
// Finally check last bit of the most possible candidates
// Update known low bit values
exp2[level] = exp2[level-1] + exp1[level][digits[level]]
pow2[level] = pow2[level-1] + pow1[digit+1-level][digits[level]]
// Loop to check all last bits of candidates
for digits[level] < 10 {
// Print out new Disarium number
if exp2[level] == pow2[level] {
mut s := ""
for i := dmax; i > 0; i-- {
s += "${digits[i]}"
}
n, _ := strconv.common_parse_uint2(s, 10, 64)
println(n)
count++
if count == limit {
println("\nFound the first $limit Disarium numbers.")
return
}
}
// Go to followed last bit candidate
digits[level]++
exp2[level] += exp1[level][1]
pow2[level]++
}
// Reset to try next path
digits[level] = 0
level--
digits[level]++
}
println('')
}
}- Output:
# of digits: 1 0 1 2 3 4 5 6 7 8 9 # of digits: 2 89 # of digits: 3 135 175 518 598 # of digits: 4 1306 1676 2427 # of digits: 5 # of digits: 6 # of digits: 7 2646798 # of digits: 8 # of digits: 9 # of digits: 10 # of digits: 11 # of digits: 12 # of digits: 13 # of digits: 14 # of digits: 15 # of digits: 16 # of digits: 17 # of digits: 18 # of digits: 19 # of digits: 20 12157692622039623539 Found the first 20 Disarium numbers.
VTL-2
Finds the first 18 Disarium numbers - computes a table of digit powers up to the fourth power.
1000 N=1
1010 D=0
1020 :N*10+D)=D
1030 D=D+1
1040 #=D<10*1020
1050 N=2
1060 :N*10)=0
1070 D=1
1080 :N*10+D)=:N-1*10+D)*D
1090 D=D+1
1100 #=D<10*1080
1120 N=N+1
1130 #=N<5*1060
2000 C=0
2010 T=10
2020 L=1
2030 N=0
2040 #=N=T=0*2070
2050 T=T*10
2060 L=L+1
2070 V=N
2080 P=L
2090 S=0
2100 V=V/10
2110 S=S+:P*10+%
2120 P=P-1
2130 #=V>1*(S-1<N)*2100
2140 #=S=N=0*2180
2150 C=C+1
2160 $=32
2170 ?=N
2180 N=N+1
2190 #=C<18*2040- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
Wren
Version 1 (Brute force)
This version finds the first 19 Disarium numbers in 3.35 seconds though, clearly, finding the 20th is out of the question with this approach.
As a possible optimization, I tried caching all possible digit powers but there was no perceptible difference in running time for numbers up to 7 digits long.
import "./math" for Int
var limit = 19
var count = 0
var disarium = []
var n = 0
while (count < limit) {
var sum = 0
var digits = Int.digits(n)
for (i in 0...digits.count) sum = sum + digits[i].pow(i+1)
if (sum == n) {
disarium.add(n)
count = count + 1
}
n = n + 1
}
System.print("The first 19 Disarium numbers are:")
System.print(disarium)
- Output:
The first 19 Disarium numbers are: [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798]
Version 2 (Much faster)
This is a translation of the C code referred to in the Phix entry and finds the first 19 Disarium numbers in 0.012 seconds.
Efficient though this method is, unfortunately finding the 20th is still out of reasonable reach for Wren. If we let this run until 15 digit numbers have been examined (the most that 53 bit integer math can accurately manage), then the time taken rises to 19 seconds - roughly 3 times slower than Phix.
However, we need 64 bit integer arithmetic to get up to 20 digits and this requires the use of Wren-long which (as it's written entirely in Wren, not C) needs about 7 times longer (2 minutes 16 seconds) to even reach 15 digits. Using BigInt or GMP would be even slower.
So, if the Phix example requires 48 minutes to find the 20th number, it would probably take Wren the best part of a day to do the same which is far longer than I have patience for.
var DMAX = 7 // maxmimum digits
var LIMIT = 19 // maximum number of Disariums to find
// Pre-calculated exponential and power serials
var EXP = List.filled(1 + DMAX, null)
var POW = List.filled(1 + DMAX, null)
EXP[0] = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1]
EXP[1] = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
POW[0] = List.filled(11, 0)
POW[1] = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 9]
for (i in 2..DMAX) {
EXP[i] = List.filled(11, 0)
POW[i] = List.filled(11, 0)
}
for (i in 1...DMAX) {
for (j in 0..9) {
EXP[i+1][j] = EXP[i][j] * 10
POW[i+1][j] = POW[i][j] * j
}
EXP[i+1][10] = EXP[i][10] * 10
POW[i+1][10] = POW[i][10] + POW[i+1][9]
}
// Digits of candidate and values of known low bits
var DIGITS = List.filled(1 + DMAX, 0) // Digits form
var Exp = List.filled(1 + DMAX, 0) // Number form
var Pow = List.filled(1 + DMAX, 0) // Powers form
var exp
var pow
var min
var max
var start = 1
var final = DMAX
var count = 0
for (digit in start..final) {
System.print("# of digits: %(digit)")
var level = 1
DIGITS[0] = 0
while (true) {
// Check limits derived from already known low bit values
// to find the most possible candidates
while (0 < level && level < digit) {
// Reset path to try next if checking in level is done
if (DIGITS[level] > 9) {
DIGITS[level] = 0
level = level - 1
DIGITS[level] = DIGITS[level] + 1
continue
}
// Update known low bit values
Exp[level] = Exp[level - 1] + EXP[level][DIGITS[level]]
Pow[level] = Pow[level - 1] + POW[digit + 1 - level][DIGITS[level]]
// Max possible value
pow = Pow[level] + POW[digit - level][10]
if (pow < EXP[digit][1]) { // Try next since upper limit is invalidly low
DIGITS[level] = DIGITS[level] + 1
continue
}
max = pow % EXP[level][10]
pow = pow - max
if (max < Exp[level]) pow = pow - EXP[level][10]
max = pow + Exp[level]
if (max < EXP[digit][1]) { // Try next since upper limit is invalidly low
DIGITS[level] = DIGITS[level] + 1
continue
}
// Min possible value
exp = Exp[level] + EXP[digit][1]
pow = Pow[level] + 1
if (exp > max || max < pow) { // Try next since upper limit is invalidly low
DIGITS[level] = DIGITS[level] + 1
continue
}
if (pow > exp ) {
min = pow % EXP[level][10]
pow = pow - min
if (min > Exp[level]) {
pow = pow + EXP[level][10]
}
min = pow + Exp[level]
} else {
min = exp
}
// Check limits existence
if (max < min) {
DIGITS[level] = DIGITS[level] + 1 // Try next number since current limits invalid
} else {
level= level + 1 // Go for further level checking since limits available
}
}
// All checking is done, escape from the main check loop
if (level < 1) break
// Finally check last bit of the most possible candidates
// Update known low bit values
Exp[level] = Exp[level - 1] + EXP[level][DIGITS[level]]
Pow[level] = Pow[level - 1] + POW[digit + 1 - level][DIGITS[level]]
// Loop to check all last bits of candidates
while (DIGITS[level] < 10) {
// Print out new Disarium number
if (Exp[level] == Pow[level]) {
var s = ""
for (i in DMAX...0) s = s + DIGITS[i].toString
System.print(Num.fromString(s))
count = count + 1
if (count == LIMIT) {
System.print("\nFound the first %(LIMIT) Disarium numbers.")
return
}
}
// Go to followed last bit candidate
DIGITS[level] = DIGITS[level] + 1
Exp[level] = Exp[level] + EXP[level][1]
Pow[level] = Pow[level] + 1
}
// Reset to try next path
DIGITS[level] = 0
level = level - 1
DIGITS[level] = DIGITS[level] + 1
}
System.print()
}
- Output:
# of digits: 1 0 1 2 3 4 5 6 7 8 9 # of digits: 2 89 # of digits: 3 135 175 518 598 # of digits: 4 1306 1676 2427 # of digits: 5 # of digits: 6 # of digits: 7 2646798 Found the first 19 Disarium numbers. real 0m0.012s user 0m0.008s sys 0m0.004s
Version 3 (Embedded)
An initial outing for the above module which aims to speed up 64 bit arithmetic in Wren by wrapping the corresponding C99 fixed size types.
Early indications are that this is at least 4 times faster than Wren-long as it can search up to 15 digits in about 29 seconds which in turn is about 4 times slower than the Phix entry.
This suggested that the 20th Disarium number would be found in around 3.5 hours so I thought I'd have a go. However, after taking consistently 4 times longer than Phix to search each digit length up to 19, I was pleasantly surprised when the 20th number popped up after only 81 minutes!
I haven't bothered to search all 20 digits numbers up to the unsigned 64 limit as this would take far longer and, of course, be fruitless in any case.
import "./i64" for U64
var DMAX = 20 // maxmimum digits
var LIMIT = 20 // maximum number of disariums to find
// Pre-calculated exponential and power serials
var EXP = List.filled(1 + DMAX, null)
var POW = List.filled(1 + DMAX, null)
EXP[0] = List.filled(11, null)
EXP[1] = List.filled(11, null)
POW[0] = List.filled(11, null)
POW[1] = List.filled(11, null)
for (i in 0..9) EXP[0][i] = U64.zero
EXP[0][10] = U64.one
for (i in 0..10) EXP[1][i] = U64.from(i)
for (i in 0..10) POW[0][i] = U64.zero
for (i in 0..9) POW[1][i] = U64.from(i)
POW[1][10] = U64.from(9)
for (i in 2..DMAX) {
EXP[i] = List.filled(11, null)
POW[i] = List.filled(11, null)
for (j in 0..10) {
EXP[i][j] = U64.zero
POW[i][j] = U64.zero
}
}
for (i in 1...DMAX) {
for (j in 0..9) {
EXP[i+1][j] = EXP[i][j] * 10
POW[i+1][j] = POW[i][j] * j
}
EXP[i+1][10] = EXP[i][10] * 10
POW[i+1][10] = POW[i][10] + POW[i+1][9]
}
// Digits of candidate and values of known low bits
var DIGITS = List.filled(1 + DMAX, 0) // Digits form
var Exp = List.filled(1 + DMAX, null) // Number form
var Pow = List.filled(1 + DMAX, null) // Powers form
for (i in 0..DMAX) {
Exp[i] = U64.zero
Pow[i] = U64.zero
}
var exp = U64.new()
var pow = U64.new()
var min = U64.new()
var max = U64.new()
var start = 1
var final = DMAX
var count = 0
for (digit in start..final) {
System.print("# of digits: %(digit)")
var level = 1
DIGITS[0] = 0
while (true) {
// Check limits derived from already known low bit values
// to find the most possible candidates
while (0 < level && level < digit) {
// Reset path to try next if checking in level is done
if (DIGITS[level] > 9) {
DIGITS[level] = 0
level = level - 1
DIGITS[level] = DIGITS[level] + 1
continue
}
// Update known low bit values
Exp[level].add(Exp[level - 1], EXP[level][DIGITS[level]])
Pow[level].add(Pow[level - 1], POW[digit + 1 - level][DIGITS[level]])
// Max possible value
pow.add(Pow[level], POW[digit - level][10])
if (pow < EXP[digit][1]) { // Try next since upper limit is invalidly low
DIGITS[level] = DIGITS[level] + 1
continue
}
max.rem(pow, EXP[level][10])
pow.sub(max)
if (max < Exp[level]) pow.sub(EXP[level][10])
max.add(pow, Exp[level])
if (max < EXP[digit][1]) { // Try next since upper limit is invalidly low
DIGITS[level] = DIGITS[level] + 1
continue
}
// Min possible value
exp.add(Exp[level], EXP[digit][1])
pow.add(Pow[level], 1)
if (exp > max || max < pow) { // Try next since upper limit is invalidly low
DIGITS[level] = DIGITS[level] + 1
continue
}
if (pow > exp ) {
min.rem(pow, EXP[level][10])
pow.sub(min)
if (min > Exp[level]) {
pow.add(EXP[level][10])
}
min.add(pow, Exp[level])
} else {
min.set(exp)
}
// Check limits existence
if (max < min) {
DIGITS[level] = DIGITS[level] + 1 // Try next number since current limits invalid
} else {
level = level + 1 // Go for further level checking since limits available
}
}
// All checking is done, escape from the main check loop
if (level < 1) break
// Final check last bit of the most possible candidates
// Update known low bit values
Exp[level].add(Exp[level - 1], EXP[level][DIGITS[level]])
Pow[level].add(Pow[level - 1], POW[digit + 1 - level][DIGITS[level]])
// Loop to check all last bit of candidates
while (DIGITS[level] < 10) {
// Print out new disarium number
if (Exp[level] == Pow[level]) {
var s = ""
for (i in DMAX...0) s = s + DIGITS[i].toString
s = s.trimStart("0")
if (s == "") s = "0"
System.print(s)
count = count + 1
if (count == LIMIT) {
if (LIMIT < 20) {
System.print("\nFound the first %(LIMIT) Disarium numbers.")
} else {
System.print("\nFound all 20 Disarium numbers.")
}
return
}
}
// Go to followed last bit candidate
DIGITS[level] = DIGITS[level] + 1
Exp[level].add(Exp[level], EXP[level][1])
Pow[level].inc
}
// Reset to try next path
DIGITS[level] = 0
level = level - 1
DIGITS[level] = DIGITS[level] + 1
}
System.print()
}
- Output:
# of digits: 1 0 1 2 3 4 5 6 7 8 9 # of digits: 2 89 # of digits: 3 135 175 518 598 # of digits: 4 1306 1676 2427 # of digits: 5 # of digits: 6 # of digits: 7 2646798 # of digits: 8 # of digits: 9 # of digits: 10 # of digits: 11 # of digits: 12 # of digits: 13 # of digits: 14 # of digits: 15 # of digits: 16 # of digits: 17 # of digits: 18 # of digits: 19 # of digits: 20 12157692622039623539 Found all 20 Disarium numbers. real 81m16.365s user 81m16.181s sys 0m0.016s
XPL0
1.35 seconds on Pi4.
func Disarium(N); \Return 'true' if N is a Disarium number
int N, N0, D(10), A(10), I, J, Sum;
[N0:= N;
for J:= 0 to 10-1 do A(J):= 1;
I:= 0;
repeat N:= N/10;
D(I):= rem(0);
I:= I+1;
for J:= 0 to I-1 do
A(J):= A(J) * D(J);
until N = 0;
Sum:= 0;
for J:= 0 to I-1 do
Sum:= Sum + A(J);
return Sum = N0;
];
int Cnt, N;
[Cnt:= 0; N:= 0;
loop [if Disarium(N) then
[IntOut(0, N); ChOut(0, ^ );
Cnt:= Cnt+1;
if Cnt >= 19 then quit;
];
N:= N+1;
];
]- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798