Narcissistic decimal number: Difference between revisions

m
→‎{{header|Wren}}: Changed to Wren S/H
m (→‎{{header|Wren}}: Changed to Wren S/H)
 
(11 intermediate revisions by 6 users not shown)
Line 727:
 
=={{header|BASIC}}==
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<syntaxhighlight lang="bbcbasic"> WHILE N% < 25
L%=LENSTR$I%
M%=0
J%=I%
WHILE J%
M%+=(J% MOD 10) ^ L%
J%/=10
ENDWHILE
IF I% == M% N%+=1 : PRINT N%, I%
I%+=1
ENDWHILE</syntaxhighlight>
 
==={{header|Chipmunk Basic}}===
{{trans|Go}}
Line 761 ⟶ 775:
0 1 2 3 4 5 6 7 8 9 153 370 371 407 1634 8208 9474 54748 92727 93084 548834 1741725 4210818 9800817 9926315
</pre>
 
==={{header|Craft Basic}}===
<syntaxhighlight lang="basic">dim p[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
 
let l = 10
let n = 25
 
do
 
if c < n then
 
if x >= l then
 
for i = 0 to 9
 
let p[i] = p[i] * i
 
next i
 
let l = l * 10
 
endif
 
let s = 0
let y = x
 
do
 
if y > 0 then
 
let t = y % 10
let s = s + p[t]
let y = int(y / 10)
 
endif
 
wait
 
loop y > 0
 
if s = x then
 
print x
let c = c + 1
 
endif
 
let x = x + 1
 
endif
 
loop c < n
 
end</syntaxhighlight>
 
==={{header|FreeBASIC}}===
Line 1,198 ⟶ 1,266:
9800817 4210818
1741725</pre>
 
=={{header|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"
 
let pow(x,y) = valof
$( let r = 1
for i = 1 to y do
r := r * x
resultis r
$)
 
let narcissist(n) = valof
$( let digits = vec 10
let number = n
let len = 0
let i = ? and powsum = 0
while n > 0 do
$( digits!len := n rem 10
n := n / 10
len := len + 1
$)
i := len
while i > 0 do
$( i := i - 1
powsum := powsum + pow(digits!i, len)
$)
resultis powsum = number
$)
 
let start() be
$( let n = 0
for i = 1 to 25
$( until narcissist(n) do n := n+1
writef("%I9*N", n)
n := n+1
$)
$)</syntaxhighlight>
{{out}}
<pre> 0
1
2
3
4
5
6
7
8
9
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315</pre>
 
=={{header|Befunge}}==
Line 1,944 ⟶ 2,075:
NIL
</pre>
 
=={{header|Cowgol}}==
<syntaxhighlight lang="cowgol">include "cowgol.coh";
 
sub pow(n: uint32, p: uint8): (r: uint32) is
r := 1;
while p>0 loop
r := r * n;
p := p - 1;
end loop;
end sub;
 
sub narcissist(n: uint32): (r: uint8) is
var digits: uint8[10];
var len: uint8 := 0;
var number := n;
 
while n>0 loop
digits[len] := (n % 10) as uint8;
n := n / 10;
len := len + 1;
end loop;
 
var i := len;
var powsum: uint32 := 0;
while i>0 loop
i := i - 1;
powsum := powsum + pow(digits[i] as uint32, len);
end loop;
 
r := 0;
if powsum == number then
r := 1;
end if;
end sub;
 
var seen: uint8 := 0;
var n: uint32 := 0;
while seen < 25 loop
if narcissist(n) != 0 then
print_i32(n);
print_nl();
seen := seen + 1;
end if;
n := n + 1;
end loop;</syntaxhighlight>
{{out}}
<pre>0
1
2
3
4
5
6
7
8
9
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315</pre>
 
=={{header|D}}==
Line 2,132 ⟶ 2,335:
 
 
=={{header|Draco}}==
<syntaxhighlight lang="draco">proc nonrec pow(byte n, p) ulong:
ulong r;
r := 0L1;
while p > 0 do
r := r * make(n, ulong);
p := p - 1
od;
r
corp
 
proc nonrec narcissist(ulong n) bool:
[10]byte digits;
byte len, i;
ulong number, powsum;
number := n;
len := 0;
while n>0 do
digits[len] := n % 10;
n := n / 10;
len := len+1
od;
i := len;
powsum := 0;
while i>0 do
i := i-1;
powsum := powsum + pow(digits[i], len)
od;
powsum = number
corp
 
proc nonrec main() void:
byte i;
ulong n;
n := 0L0;
for i from 1 upto 25 do
while not narcissist(n) do n := n+1 od;
writeln(n);
n := n+1
od
corp</syntaxhighlight>
{{out}}
<pre>0
1
2
3
4
5
6
7
8
9
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315</pre>
=={{header|EasyLang}}==
<syntaxhighlight lang="easylang">
Line 2,450 ⟶ 2,720:
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Narcissistic_decimal_number}}
 
'''Solution'''
 
The following functions retrieves whether a given number in a given base is narcissistic or not:
 
[[File:Fōrmulæ - Narcissistic number 01.png]]
 
'''Test case'''
 
[[File:Fōrmulæ - Narcissistic number 02.png]]
 
[[File:Fōrmulæ - Narcissistic number 03.png]]
 
'''Generating the first 25 narcissistic decimal numbers'''
 
[[File:Fōrmulæ - Narcissistic number 04.png]]
 
[[File:Fōrmulæ - Narcissistic number 05.png]]
 
[[File:Fōrmulæ - Narcissistic number 06.png]]
 
=={{header|Go}}==
Line 3,185 ⟶ 3,475:
0 1 2 3 4 5 6 7 8 9 153 370 371 407 1634 8208 9474 54748 92727 93084 548834 1741725 4210818 9800817 9926315
</pre>
 
=={{header|MAD}}==
<syntaxhighlight lang="mad"> NORMAL MODE IS INTEGER
DIMENSION DIGIT(15)
 
INTERNAL FUNCTION(A,B)
ENTRY TO POWER.
R=1
BB=B
STEP WHENEVER BB.E.0, FUNCTION RETURN R
R=R*A
BB=BB-1
TRANSFER TO STEP
END OF FUNCTION
 
INTERNAL FUNCTION(NUM)
ENTRY TO NARCIS.
N=NUM
L=0
GETDGT WHENEVER N.G.0
NN=N/10
DIGIT(L)=N-NN*10
N=NN
L=L+1
TRANSFER TO GETDGT
END OF CONDITIONAL
I=L
SUM=0
POWSUM WHENEVER I.G.0
I=I-1
D=DIGIT(I)
SUM=SUM+POWER.(D,L)
TRANSFER TO POWSUM
END OF CONDITIONAL
FUNCTION RETURN SUM.E.NUM
END OF FUNCTION
 
CAND=0
THROUGH SEARCH, FOR SEEN=0,1,SEEN.GE.25
NEXT THROUGH NEXT, FOR CAND=CAND,1,NARCIS.(CAND)
PRINT FORMAT FMT,CAND
SEARCH CAND=CAND+1
 
VECTOR VALUES FMT=$I10*$
END OF PROGRAM</syntaxhighlight>
{{out}}
<pre> 0
1
2
3
4
5
6
7
8
9
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315</pre>
 
=={{header|Maple}}==
Line 4,059 ⟶ 4,420:
29 narcissistic: 146511208 199768 00:50:22.777
30 narcissistic: 472335975 1221384 01:10:44.161 </pre>
 
=={{header|PL/M}}==
PL/M-80 only supports 16-bit integers, so this prints only the first 18 narcissistic decimal numbers.
 
<syntaxhighlight lang="plm">100H:
BDOS: PROCEDURE (FN,AR); DECLARE FN BYTE, AR ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; GO TO 0; END EXIT;
PR$CHAR: PROCEDURE (CR); DECLARE CR BYTE; CALL BDOS(2,CR); END PR$CHAR;
PR$STR: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PR$STR;
 
DIGITS: PROCEDURE (N,BUF) BYTE;
DECLARE (N, BUF) ADDRESS;
DECLARE (DIGIT BASED BUF, TEMP, I, LEN) BYTE;
I = 5;
STEP:
DIGIT(I := I-1) = N MOD 10;
IF (N := N/10) > 0 THEN GO TO STEP;
LEN = 0;
DO WHILE I<5;
DIGIT(LEN) = DIGIT(I);
LEN = LEN+1;
I = I+1;
END;
RETURN LEN;
END DIGITS;
 
PR$NUM: PROCEDURE (N);
DECLARE N ADDRESS, DS (5) BYTE, I BYTE;
DO I = 0 TO DIGITS(N,.DS) - 1;
CALL PR$CHAR('0' + DS(I));
END;
CALL PR$STR(.(13,10,'$'));
END PR$NUM;
 
POWER: PROCEDURE (N,P) ADDRESS;
DECLARE (N, P, R) ADDRESS;
R = 1;
DO WHILE P > 0;
R = R * N;
P = P - 1;
END;
RETURN R;
END POWER;
 
NARCISSIST: PROCEDURE (N) ADDRESS;
DECLARE (LEN, I) BYTE, DS (5) BYTE;
DECLARE (N, POWSUM) ADDRESS;
LEN = DIGITS(N, .DS);
POWSUM = 0;
DO I = 0 TO LEN-1;
POWSUM = POWSUM + POWER(DS(I), LEN);
END;
RETURN POWSUM = N;
END NARCISSIST;
 
DECLARE CAND ADDRESS;
DO CAND = 0 TO 65534;
IF NARCISSIST(CAND) THEN CALL PR$NUM(CAND);
END;
 
CALL EXIT;
EOF</syntaxhighlight>
{{out}}
<pre>0
1
2
3
4
5
6
7
8
9
153
370
371
407
1634
8208
9474
54748</pre>
 
=={{header|PowerShell}}==
Line 4,101 ⟶ 4,543:
548834 1741725 4210818 9800817 9926315
</pre>
 
=={{header|Prolog}}==
works with swi-prolog
Line 4,129 ⟶ 4,572:
; Min is 0
),
Max is 10^Exp - 1,
combi(Exp, DigList, Comb),
powSum(Comb, Exp, 0, PSum),
Line 4,135 ⟶ 4,578:
digits(PSum, DList),
sort(0, @=<, DList, DSort), % hold equal digits
( DSort = Comb;
( PSum =:= 0, Comb = [0] -> % special case because
PSum =:= 0, % special case because
true % DList in digits(0, DList) is [] and not [0]
Comb = [0] % DList in digits(0, DList) is [] and not [0]
; DSort = Comb
).
Line 4,954 ⟶ 5,397:
digs = self.digits
m = digs.size
digs.mapsum{|d| d**m}.sum == self
end
end
Line 5,058 ⟶ 5,501:
Output:
<pre>0 1 2 3 4 5 6 7 8 9 153 370 371 407 1634 8208 9474 54748 92727 93084 548834 1741725 4210818 9800817 9926315</pre>
 
=={{header|SETL}}==
<syntaxhighlight lang="setl">program narcissists;
n := 0;
loop until seen = 25 do
if narcissist n then
print(n);
seen +:= 1;
end if;
n +:= 1;
end loop;
 
op narcissist(n);
k := n;
digits := [[k mod 10, k div:= 10](1) : until k=0];
return n = +/[d ** #digits : d in digits];
end op;
end program;</syntaxhighlight>
{{out}}
<pre>0
1
2
3
4
5
6
7
8
9
153
370
371
407
1634
8208
9474
54748
92727
93084
548834
1741725
4210818
9800817
9926315</pre>
 
=={{header|Sidef}}==
Line 5,178 ⟶ 5,665:
=={{header|Wren}}==
{{trans|Go}}
<syntaxhighlight lang="ecmascriptwren">var narc = Fn.new { |n|
var power = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
var limit = 10
9,476

edits