Rosetta Code

Narcissistic decimal number: Difference between revisions

Page Discussion

Narcissistic decimal number (view source)

Revision as of 09:29, 6 January 2024

9,195 bytes added ,  4 months ago
m
→‎{{header|Wren}}: Changed to Wren S/H
No edit summary
m (→‎{{header|Wren}}: Changed to Wren S/H)
 
(22 intermediate revisions by 9 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,131 ⟶ 2,334:
</pre>
 
 
=={{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">
while cnt < 25
s$ = n
ln = len s$
s = 0
for i to ln
s += pow number substr s$ i 1 ln
.
if s = n
print s
cnt += 1
.
n += 1
.
</syntaxhighlight>
 
=={{header|Elixir}}==
Line 2,171 ⟶ 2,458:
[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|EMal}}==
<syntaxhighlight lang="emal">
fun narcissistic = void by int count
for int i, n, sum = 0; i < count; ++n, sum = 0
text nText = text!n
for each text c in nText
sum += (int!c) ** nText.length
end
if sum == n
if (i % 5 == 0) do writeLine() end
write((text!n).padStart(8, " "))
++i
end
end
writeLine()
end
narcissistic(25)
</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>
 
Line 2,405 ⟶ 2,719:
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Narcissistic_decimal_number}}
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation &mdash;i.e. XML, JSON&mdash; they are intended for storage and transfer purposes more than visualization and edition.
 
'''Solution'''
Programs in Fōrmulæ are created/edited online in its [https://formulae.org website], However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.
 
The following functions retrieves whether a given number in a given base is narcissistic or not:
In '''[https://formulae.org/?example=Narcissistic_decimal_number this]''' page you can see the program(s) related to this task and their results.
 
[[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,145 ⟶ 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,019 ⟶ 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,060 ⟶ 4,542:
8208 9474 54748 92727 93084
548834 1741725 4210818 9800817 9926315
</pre>
 
=={{header|Prolog}}==
works with swi-prolog
<syntaxhighlight lang="prolog">
digits(0, []):-!.
digits(N, [D|DList]):-
divmod(N, 10, N1, D),
digits(N1, DList).
 
combi(0, _, []).
combi(N, [X|T], [X|Comb]):-
N > 0,
N1 is N - 1,
combi(N1, [X|T], Comb).
combi(N, [_|T], Comb):-
N > 0,
combi(N, T, Comb).
 
powSum([], _, Sum, Sum).
powSum([D|DList], Pow, Acc, Sum):-
Acc1 is Acc + D^Pow,
powSum(DList, Pow, Acc1, Sum).
 
armstrong(Exp, PSum):-
numlist(0, 9, DigList),
(Exp > 1 ->
Min is 10^(Exp - 1)
; Min is 0
),
Max is 10^Exp - 1,
combi(Exp, DigList, Comb),
powSum(Comb, Exp, 0, PSum),
between(Min, Max, PSum),
digits(PSum, DList),
sort(0, @=<, DList, DSort), % hold equal digits
( DSort = Comb;
PSum =:= 0, % special case because
Comb = [0] % DList in digits(0, DList) is [] and not [0]
).
do:-between(1, 7, Exp),
findall(ArmNum, armstrong(Exp, ArmNum), ATemp),
sort(ATemp, AList),
writef('%d -> %w\n', [Exp, AList]),
fail.
do.
</syntaxhighlight>
{{out}}
<pre>
?- time(do).
1 -> [0,1,2,3,4,5,6,7,8,9]
2 -> []
3 -> [153,370,371,407]
4 -> [1634,8208,9474]
5 -> [54748,92727,93084]
6 -> [548834]
7 -> [1741725,4210818,9800817,9926315]
% 666,266 inferences, 0.120 CPU in 0.120 seconds (100% CPU, 5557841 Lips)
true.
</pre>
 
Line 4,800 ⟶ 5,342:
</syntaxhighlight>
 
=={{header|RubyRPL}}==
We started the challenge on a genuine HP-28S, powered by a 4-bit CPU running at 2 MHz.
≪ DUP XPON 1 + → n m
Line 4,806 ⟶ 5,348:
10 MOD LAST / IP SWAP m ^ ROT + SWAP '''END'''
DROP n ==
≫ ≫ ‘'''<span style="color:blue">NAR6?</span>'''’ STO
≪ { 0 } 1 999 '''FOR''' n IF n '''<span style="color:blue">NAR6?'''</span> '''THEN''' n + '''END'''
≫ 'TASK' STOEVAL
It took 4 minutes and 20 seconds to get the first 14 numbers.
{{out}}
Line 4,820 ⟶ 5,362:
≪ { 999 } 0 CON
0 9 '''FOR''' h 0 9 '''FOR''' t 0 9 '''FOR''' u
'''IF''' h t u + + '''THEN''' h 100 * t 10 * u + + h m ^ t m ^ u m ^ + + PUT '''END NEXT NEXT NEXT'''
'''NEXT NEXT NEXT'POWM'''' STO
'<span style="color:green">POWM</span>' STO
≫ ≫ ''''INIT'''' STO
≫ ≫ '<span style="color:blue">INIT</span>' STO
≪ DUP XPON 1 + → n m
Line 4,828 ⟶ 5,371:
'''WHILE''' DUP '''REPEAT'''
1000 MOD LAST / IP
'''IF''' SWAP '''THEN''' LAST '''<span style="color:green">POWM'''</span> SWAP GET ROT + SWAP '''END'''
'''END''' DROP n ==
≫ ≫ ''''<span style="color:blue">NAR6?'''</span>' STO
≪ DUP <span style="color:blue">INIT</span> DUP ALOG SWAP 1 - ALOG
'''WHILE''' DUP2 > '''REPEAT'''
'''IF''' DUP '''<span style="color:blue">NAR6?</span> '''THEN''' ROT OVER + ROT ROT '''END'''
1 +
'''END''' DROP2 ≫ ''''RTASK'''' STO
≫ '<span style="color:blue">RTASK</span>' STO
{{in}}
<pre>
Line 4,853 ⟶ 5,397:
digs = self.digits
m = digs.size
digs.mapsum{|d| d**m}.sum == self
end
end
Line 4,957 ⟶ 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,077 ⟶ 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
PureFox
9,476

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/341318...352344"