Disarium numbers: Difference between revisions
(→{{header|ALGOL 68}}: Tweak) |
(Added Algol W) |
||
| Line 69: | Line 69: | ||
OD |
OD |
||
END</lang> |
END</lang> |
||
{{out}} |
|||
<pre> |
|||
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798 |
|||
</pre> |
|||
=={{header|ALGOL W}}== |
|||
{{Trans|ALGOL 68}} |
|||
<lang pascal>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.</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
Revision as of 20:21, 6 June 2022
You are encouraged to solve this task according to the task description, using any language you may know.
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.
- 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...
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). <lang algol68>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</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
ALGOL W
<lang pascal>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.</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Arturo
<lang rebol>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
]</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
AWK
<lang 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)
} </lang>
- 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
<lang freebasic>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</lang>
- Output:
Igual que la entrada de FreeBASIC.
FreeBASIC
<lang 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</lang>
- Output:
Igual que la entrada de Python.
Run BASIC
<lang freebasic>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</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
True BASIC
<lang qbasic>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</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
PureBasic
<lang 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()</lang>
- Output:
Igual que la entrada de FreeBASIC.
Yabasic
<lang 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</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
C++
<lang 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 ;
}</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427
Factor
<lang 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</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Go
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. <lang go>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()
}
}</lang>
- 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
<lang 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 ..]
</lang>
- Output:
[0,1,2,3,4,5,6,7,8,9,89,135,175,518,598,1306,1676,2427]
Julia
<lang 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)
</lang>
- 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)
Mathematica/Wolfram Language
<lang Mathematica>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</lang>
- Output:
{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427, 2646798}
Perl
<lang 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";</lang>
- 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
<lang Picat>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.</lang>
- 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.
<lang Picat>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]).</lang>
- 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.)
Python
<lang 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</lang>
- 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
Raku
Not an efficient algorithm. First 18 in less than 1/4 second. 19th in around 45 seconds. Pretty much unusable for the 20th. <lang perl6>my $disarium = (^∞).hyper.map: { $_ if $_ == sum .polymod(10 xx *).reverse Z** 1..* };
put $disarium[^18]; put $disarium[18];</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798
Sidef
<lang ruby>func is_disarium(n) {
n.digits.flip.sum_kv{|k,d| d**(k+1) } == n
}
say 18.by(is_disarium)</lang>
- Output:
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 89, 135, 175, 518, 598, 1306, 1676, 2427]
Vlang
Recommend to build first `v -prod disarium.v` and then run `./disarium`
<lang vlang>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()
}
}</lang>
- 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.
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. <lang ecmascript>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)</lang>
- 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. <lang ecmascript>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()
}</lang>
- 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. <lang ecmascript>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()
}</lang>
- 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. <lang XPL0>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;
];
]</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 89 135 175 518 598 1306 1676 2427 2646798