Rosetta Code

Narcissistic decimal number: Difference between revisions

Page Discussion

Narcissistic decimal number (view source)

Revision as of 23:06, 22 October 2022

34 bytes added ,  1 year ago
Dialects of BASIC moved to the BASIC section.
m (syntax highlighting fixup automation)
(Dialects of BASIC moved to the BASIC section.)
Line 726:
</pre>
 
=={{header|BefungeBASIC}}==
==={{header|FreeBASIC}}===
====Simple Version====
<syntaxhighlight lang="freebasic">' normal version: 14-03-2017
' compile with: fbc -s console
' can go up to 18 digits (ulongint is 64bit), above 18 overflow will occur
Dim As Integer n, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, a, b
Dim As Integer d()
Dim As ULongInt d2pow(0 To 9) = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}
Dim As ULongInt x
Dim As String str_x
For n = 1 To 7
For n9 = n To 0 Step -1
For n8 = n-n9 To 0 Step -1
For n7 = n-n9-n8 To 0 Step -1
For n6 = n-n9-n8-n7 To 0 Step -1
For n5 = n-n9-n8-n7-n6 To 0 Step -1
For n4 = n-n9-n8-n7-n6-n5 To 0 Step -1
For n3 = n-n9-n8-n7-n6-n5-n4 To 0 Step -1
For n2 = n-n9-n8-n7-n6-n5-n4-n3 To 0 Step -1
For n1 = n-n9-n8-n7-n6-n5-n4-n3-n2 To 0 Step -1
n0 = n-n9-n8-n7-n6-n5-n4-n3-n2-n1
x = n1 + n2*d2pow(2) + n3*d2pow(3) + n4*d2pow(4) + n5*d2pow(5)_
+ n6*d2pow(6) + n7*d2pow(7) + n8*d2pow(8) + n9*d2pow(9)
str_x = Str(x)
If Len(str_x) = n Then
ReDim d(10)
For a = 0 To n-1
d(Str_x[a]- Asc("0")) += 1
Next a
If n0 = d(0) AndAlso n1 = d(1) AndAlso n2 = d(2) AndAlso n3 = d(3)_
AndAlso n4 = d(4) AndAlso n5 = d(5) AndAlso n6 = d(6)_
AndAlso n7 = d(7) AndAlso n8 = d(8) AndAlso n9 = d(9) Then
Print x
End If
End If
Next n1
Next n2
Next n3
Next n4
Next n5
Next n6
Next n7
Next n8
Next n9
For a As Integer = 2 To 9
d2pow(a) = d2pow(a) * a
Next a
Next n
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</syntaxhighlight>
{{out}}
<pre>9
8
7
6
5
4
3
2
1
0
407
371
370
153
9474
8208
1634
93084
92727
54748
548834
9926315
9800817
4210818
1741725</pre>
 
====GMP Version====
<pre>It takes about 35 min. to find all 88 numbers (39 digits).
To go all the way it takes about 2 hours.</pre>
<syntaxhighlight lang="freebasic">' gmp version: 17-06-2015
' uses gmp
' compile with: fbc -s console
 
#Include Once "gmp.bi"
' change the number after max for the maximum n-digits you want (2 to 61)
#Define max 61
 
Dim As Integer n, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9
Dim As Integer i, j
Dim As UInteger d()
Dim As ZString Ptr gmp_str
gmp_str = Allocate(100)
 
' create gmp integer array,
Dim d2pow(9, max) As Mpz_ptr
' initialize array and set start value,
For i = 0 To 9
For j = 0 To max
d2pow(i, j) = Allocate(Len(__mpz_struct)) : Mpz_init(d2pow(i, j))
Next j
Next i
 
' gmp integers for to hold intermediate result
Dim As Mpz_ptr x1 = Allocate(Len(__mpz_struct)) : Mpz_init(x1)
Dim As Mpz_ptr x2 = Allocate(Len(__mpz_struct)) : Mpz_init(x2)
Dim As Mpz_ptr x3 = Allocate(Len(__mpz_struct)) : Mpz_init(x3)
Dim As Mpz_ptr x4 = Allocate(Len(__mpz_struct)) : Mpz_init(x4)
Dim As Mpz_ptr x5 = Allocate(Len(__mpz_struct)) : Mpz_init(x5)
Dim As Mpz_ptr x6 = Allocate(Len(__mpz_struct)) : Mpz_init(x6)
Dim As Mpz_ptr x7 = Allocate(Len(__mpz_struct)) : Mpz_init(x7)
Dim As Mpz_ptr x8 = Allocate(Len(__mpz_struct)) : Mpz_init(x8)
 
For n = 1 To max
 
For i = 1 To 9
'Mpz_set_ui(d2pow(i,0), 0)
Mpz_ui_pow_ui(d2pow(i,1), i, n)
For j = 2 To n
Mpz_mul_ui(d2pow(i, j), d2pow(i, 1), j)
Next j
Next i
 
For n9 = n To 0 Step -1
For n8 = n-n9 To 0 Step -1
Mpz_add(x8, d2pow(9, n9), d2pow(8, n8))
For n7 = n-n9-n8 To 0 Step -1
Mpz_add(x7, x8, d2pow(7, n7))
For n6 = n-n9-n8-n7 To 0 Step -1
Mpz_add(x6, x7, d2pow(6, n6))
For n5 = n-n9-n8-n7-n6 To 0 Step -1
Mpz_add(x5, x6, d2pow(5, n5))
For n4 = n-n9-n8-n7-n6-n5 To 0 Step -1
Mpz_add(x4, x5, d2pow(4, n4))
For n3 = n-n9-n8-n7-n6-n5-n4 To 0 Step -1
Mpz_add(x3, x4, d2pow(3, n3))
For n2 = n-n9-n8-n7-n6-n5-n4-n3 To 0 Step -1
Mpz_add(x2, x3, d2pow(2, n2))
For n1 = n-n9-n8-n7-n6-n5-n4-n3-n2 To 0 Step -1
Mpz_add_ui(x1, x2, n1)
n0 = n-n9-n8-n7-n6-n5-n4-n3-n2-n1
 
Mpz_get_str(gmp_str, 10, x1)
 
If Len(*gmp_str) = n Then
ReDim d(10)
 
For i = 0 To n-1
d(gmp_str[i] - Asc("0")) += 1
Next i
 
If n9 = d(9) AndAlso n8 = d(8) AndAlso n7 = d(7) AndAlso n6 = d(6)_
AndAlso n5 = d(5) AndAlso n4 = d(4) AndAlso n3 = d(3)_
AndAlso n2 = d(2) AndAlso n1 = d(1) AndAlso n0 = d(0) Then
Print *gmp_str
End If
ElseIf Len(*gmp_str) < n Then
' all for next loops have a negative step value
' if len(str_x) becomes smaller then n it's time to try the next n value
' GoTo label1 ' old school BASIC
' prefered FreeBASIC style
Exit For, For, For, For, For, For, For, For, For
' leave n1, n2, n3, n4, n5, n6, n7, n8, n9 loop
' and continue's after next n9
End If
 
Next n1
Next n2
Next n3
Next n4
Next n5
Next n6
Next n7
Next n8
Next n9
' label1:
Next n
 
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</syntaxhighlight>
{{out}}
Left side: program output, right side: sorted on length, value
<pre style="height:35ex;overflow:scroll">9 0
8 1
7 2
6 3
5 4
4 5
3 6
2 7
1 8
0 9
407 153
371 370
370 371
153 407
9474 1634
8208 8208
1634 9474
93084 54748
92727 92727
54748 93084
548834 548834
9926315 1741725
9800817 4210818
4210818 9800817
1741725 9926315
88593477 24678050
24678051 24678051
24678050 88593477
912985153 146511208
534494836 472335975
472335975 534494836
146511208 912985153
4679307774 4679307774
94204591914 32164049650
82693916578 32164049651
49388550606 40028394225
44708635679 42678290603
42678290603 44708635679
40028394225 49388550606
32164049651 82693916578
32164049650 94204591914
28116440335967 28116440335967
4338281769391371 4338281769391370
4338281769391370 4338281769391371
35875699062250035 21897142587612075
35641594208964132 35641594208964132
21897142587612075 35875699062250035
4929273885928088826 1517841543307505039
4498128791164624869 3289582984443187032
3289582984443187032 4498128791164624869
1517841543307505039 4929273885928088826
63105425988599693916 63105425988599693916
449177399146038697307 128468643043731391252
128468643043731391252 449177399146038697307
35452590104031691935943 21887696841122916288858
28361281321319229463398 27879694893054074471405
27907865009977052567814 27907865009977052567814
27879694893054074471405 28361281321319229463398
21887696841122916288858 35452590104031691935943
239313664430041569350093 174088005938065293023722
188451485447897896036875 188451485447897896036875
174088005938065293023722 239313664430041569350093
4422095118095899619457938 1550475334214501539088894
3706907995955475988644381 1553242162893771850669378
3706907995955475988644380 3706907995955475988644380
1553242162893771850669378 3706907995955475988644381
1550475334214501539088894 4422095118095899619457938
177265453171792792366489765 121204998563613372405438066
174650464499531377631639254 121270696006801314328439376
128851796696487777842012787 128851796696487777842012787
121270696006801314328439376 174650464499531377631639254
121204998563613372405438066 177265453171792792366489765
23866716435523975980390369295 14607640612971980372614873089
19008174136254279995012734741 19008174136254279995012734740
19008174136254279995012734740 19008174136254279995012734741
14607640612971980372614873089 23866716435523975980390369295
2309092682616190307509695338915 1145037275765491025924292050346
1927890457142960697580636236639 1927890457142960697580636236639
1145037275765491025924292050346 2309092682616190307509695338915
17333509997782249308725103962772 17333509997782249308725103962772
186709961001538790100634132976991 186709961001538790100634132976990
186709961001538790100634132976990 186709961001538790100634132976991
1122763285329372541592822900204593 1122763285329372541592822900204593
12679937780272278566303885594196922 12639369517103790328947807201478392
12639369517103790328947807201478392 12679937780272278566303885594196922
1219167219625434121569735803609966019 1219167219625434121569735803609966019
12815792078366059955099770545296129367 12815792078366059955099770545296129367
115132219018763992565095597973971522401 115132219018763992565095597973971522400
115132219018763992565095597973971522400 115132219018763992565095597973971522401</pre>
 
==={{header|GW-BASIC}}===
{{trans|FreeBASIC}}
Maximum for N (double) is14 digits, there are no 15 digits numbers
<syntaxhighlight lang="qbasic">1 DEFINT A-W : DEFDBL X-Z : DIM D(9) : DIM X2(9) : KEY OFF : CLS
2 FOR A = 0 TO 9 : X2(A) = A : NEXT A
3 FOR N = 1 TO 7
4 FOR N9 = N TO 0 STEP -1
5 FOR N8 = N-N9 TO 0 STEP -1
6 FOR N7 = N-N9-N8 TO 0 STEP -1
7 FOR N6 = N-N9-N8-N7 TO 0 STEP -1
8 FOR N5 = N-N9-N8-N7-N6 TO 0 STEP -1
9 FOR N4 = N-N9-N8-N7-N6-N5 TO 0 STEP -1
10 FOR N3 = N-N9-N8-N7-N6-N5-N4 TO 0 STEP -1
11 FOR N2 = N-N9-N8-N7-N6-N5-N4-N3 TO 0 STEP -1
12 FOR N1 = N-N9-N8-N7-N6-N5-N4-N3-N2 TO 0 STEP -1
13 N0 = N-N9-N8-N7-N6-N5-N4-N3-N2-N1
14 X = N1 + N2*X2(2) + N3*X2(3) + N4*X2(4) + N5*X2(5) + N6*X2(6) + N7*X2(7) + N8*X2(8) + N9*X2(9)
15 S$ = MID$(STR$(X),2)
16 IF LEN(S$) < N THEN GOTO 25
17 IF LEN(S$) <> N THEN GOTO 24
18 FOR A = 0 TO 9 : D(A) = 0 : NEXT A
19 FOR A = 0 TO N-1
20 B = ASC(MID$(S$,A+1,1))-48
21 D(B) = D(B) + 1
22 NEXT A
23 IF N0 = D(0) AND N1 = D(1) AND N2 = D(2) AND N3 = D(3) AND N4 = D(4) AND N5 = D(5) AND N6 = D(6) AND N7 = D(7) AND N8 = D(8) AND N9 = D(9) THEN PRINT X,
24 NEXT N1 : NEXT N2 : NEXT N3 : NEXT N4 : NEXT N5 : NEXT N6 : NEXT N7 : NEXT N8 : NEXT N9
25 FOR A = 2 TO 9
26 X2(A) = X2(A) * A
27 NEXT A
28 NEXT N
29 PRINT
30 PRINT "done"
31 END</syntaxhighlight>
{{out}}
<pre> 9 8 7 6 5
4 3 2 1 0
407 371 370 153 9474
8208 1634 93084 92727 54748
548834 9926315 9800817 4210818 1741725</pre>
 
==={{header|VBA}}===
{{trans|Phix}}<syntaxhighlight lang="vb">Private Function narcissistic(n As Long) As Boolean
Dim d As String: d = CStr(n)
Dim l As Integer: l = Len(d)
Dim sumn As Long: sumn = 0
For i = 1 To l
sumn = sumn + (Mid(d, i, 1) - "0") ^ l
Next i
narcissistic = sumn = n
End Function
 
Public Sub main()
Dim s(24) As String
Dim n As Long: n = 0
Dim found As Integer: found = 0
Do While found < 25
If narcissistic(n) Then
s(found) = CStr(n)
found = found + 1
End If
n = n + 1
Loop
Debug.Print Join(s, ", ")
End Sub</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|VBScript}}===
<syntaxhighlight lang="vb">Function Narcissist(n)
i = 0
j = 0
Do Until j = n
sum = 0
For k = 1 To Len(i)
sum = sum + CInt(Mid(i,k,1)) ^ Len(i)
Next
If i = sum Then
Narcissist = Narcissist & i & ", "
j = j + 1
End If
i = i + 1
Loop
End Function
 
WScript.StdOut.Write Narcissist(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>
 
==={{header|ZX Spectrum Basic}}===
Array index starts at 1. Only 1 character long variable names are allowed for For-Next loops. 8 Digits or higher numbers are displayed as floating point numbers. Needs about 2 hours (3.5Mhz)
<syntaxhighlight lang="zxbasic"> 1 DIM K(10): DIM M(10)
2 FOR Y=0 TO 9: LET M(Y+1)=Y: NEXT Y
3 FOR N=1 TO 7
4 FOR J=N TO 0 STEP -1
5 FOR I=N-J TO 0 STEP -1
6 FOR H=N-J-I TO 0 STEP -1
7 FOR G=N-J-I-H TO 0 STEP -1
8 FOR F=N-J-I-H-G TO 0 STEP -1
9 FOR E=N-J-I-H-G-F TO 0 STEP -1
10 FOR D=N-J-I-H-G-F-E TO 0 STEP -1
11 FOR C=N-J-I-H-G-F-E-D TO 0 STEP -1
12 FOR B=N-J-I-H-G-F-E-D-C TO 0 STEP -1
13 LET A=N-J-I-H-G-F-E-D-C-B
14 LET X=B+C*M(3)+D*M(4)+E*M(5)+F*M(6)+G*M(7)+H*M(8)+I*M(9)+J*M(10)
15 LET S$=STR$ (X)
16 IF LEN (S$)<N THEN GO TO 34
17 IF LEN (S$)<>N THEN GO TO 33
18 FOR Y=1 TO 10: LET K(Y)=0: NEXT Y
19 FOR Y=1 TO N
20 LET Z= CODE (S$(Y))-47
21 LET K(Z)=K(Z)+1
22 NEXT Y
23 IF A<>K(1) THEN GO TO 33
24 IF B<>K(2) THEN GO TO 33
25 IF C<>K(3) THEN GO TO 33
26 IF D<>K(4) THEN GO TO 33
27 IF E<>K(5) THEN GO TO 33
28 IF F<>K(6) THEN GO TO 33
29 IF G<>K(7) THEN GO TO 33
30 IF H<>K(8) THEN GO TO 33
31 IF I<>K(9) THEN GO TO 33
32 IF J=K(10) THEN PRINT X,
33 NEXT B: NEXT C: NEXT D: NEXT E: NEXT F: NEXT G: NEXT H: NEXT I: NEXT J
34 FOR Y=2 TO 9
35 LET M(Y+1)=M(Y+1)*Y
36 NEXT Y
37 NEXT N
38 PRINT
39 PRINT "DONE"</syntaxhighlight>
{{out}}
<pre>9 8
7 6
5 4
3 2
1 0
9 8
7 6
5 4
3 2
1 0
407 371
370 153
9474 8208
1634 93084
92727 54748
548834 9926315
9800817 4210818
1741725</pre>
 
=={{header|Befunge}}==
This can take several minutes to complete in most interpreters, so it's probably best to use a compiler if you want to see the full sequence.
 
Line 1,840 ⟶ 2,277:
ok
</pre>
 
=={{header|FreeBASIC}}==
===Simple Version===
<syntaxhighlight lang="freebasic">' normal version: 14-03-2017
' compile with: fbc -s console
' can go up to 18 digits (ulongint is 64bit), above 18 overflow will occur
Dim As Integer n, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9, a, b
Dim As Integer d()
Dim As ULongInt d2pow(0 To 9) = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}
Dim As ULongInt x
Dim As String str_x
For n = 1 To 7
For n9 = n To 0 Step -1
For n8 = n-n9 To 0 Step -1
For n7 = n-n9-n8 To 0 Step -1
For n6 = n-n9-n8-n7 To 0 Step -1
For n5 = n-n9-n8-n7-n6 To 0 Step -1
For n4 = n-n9-n8-n7-n6-n5 To 0 Step -1
For n3 = n-n9-n8-n7-n6-n5-n4 To 0 Step -1
For n2 = n-n9-n8-n7-n6-n5-n4-n3 To 0 Step -1
For n1 = n-n9-n8-n7-n6-n5-n4-n3-n2 To 0 Step -1
n0 = n-n9-n8-n7-n6-n5-n4-n3-n2-n1
x = n1 + n2*d2pow(2) + n3*d2pow(3) + n4*d2pow(4) + n5*d2pow(5)_
+ n6*d2pow(6) + n7*d2pow(7) + n8*d2pow(8) + n9*d2pow(9)
str_x = Str(x)
If Len(str_x) = n Then
ReDim d(10)
For a = 0 To n-1
d(Str_x[a]- Asc("0")) += 1
Next a
If n0 = d(0) AndAlso n1 = d(1) AndAlso n2 = d(2) AndAlso n3 = d(3)_
AndAlso n4 = d(4) AndAlso n5 = d(5) AndAlso n6 = d(6)_
AndAlso n7 = d(7) AndAlso n8 = d(8) AndAlso n9 = d(9) Then
Print x
End If
End If
Next n1
Next n2
Next n3
Next n4
Next n5
Next n6
Next n7
Next n8
Next n9
For a As Integer = 2 To 9
d2pow(a) = d2pow(a) * a
Next a
Next n
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</syntaxhighlight>
{{out}}
<pre>9
8
7
6
5
4
3
2
1
0
407
371
370
153
9474
8208
1634
93084
92727
54748
548834
9926315
9800817
4210818
1741725</pre>
 
===GMP Version===
<pre>It takes about 35 min. to find all 88 numbers (39 digits).
To go all the way it takes about 2 hours.</pre>
<syntaxhighlight lang="freebasic">' gmp version: 17-06-2015
' uses gmp
' compile with: fbc -s console
 
#Include Once "gmp.bi"
' change the number after max for the maximum n-digits you want (2 to 61)
#Define max 61
 
Dim As Integer n, n0, n1, n2, n3, n4, n5, n6, n7, n8, n9
Dim As Integer i, j
Dim As UInteger d()
Dim As ZString Ptr gmp_str
gmp_str = Allocate(100)
 
' create gmp integer array,
Dim d2pow(9, max) As Mpz_ptr
' initialize array and set start value,
For i = 0 To 9
For j = 0 To max
d2pow(i, j) = Allocate(Len(__mpz_struct)) : Mpz_init(d2pow(i, j))
Next j
Next i
 
' gmp integers for to hold intermediate result
Dim As Mpz_ptr x1 = Allocate(Len(__mpz_struct)) : Mpz_init(x1)
Dim As Mpz_ptr x2 = Allocate(Len(__mpz_struct)) : Mpz_init(x2)
Dim As Mpz_ptr x3 = Allocate(Len(__mpz_struct)) : Mpz_init(x3)
Dim As Mpz_ptr x4 = Allocate(Len(__mpz_struct)) : Mpz_init(x4)
Dim As Mpz_ptr x5 = Allocate(Len(__mpz_struct)) : Mpz_init(x5)
Dim As Mpz_ptr x6 = Allocate(Len(__mpz_struct)) : Mpz_init(x6)
Dim As Mpz_ptr x7 = Allocate(Len(__mpz_struct)) : Mpz_init(x7)
Dim As Mpz_ptr x8 = Allocate(Len(__mpz_struct)) : Mpz_init(x8)
 
For n = 1 To max
 
For i = 1 To 9
'Mpz_set_ui(d2pow(i,0), 0)
Mpz_ui_pow_ui(d2pow(i,1), i, n)
For j = 2 To n
Mpz_mul_ui(d2pow(i, j), d2pow(i, 1), j)
Next j
Next i
 
For n9 = n To 0 Step -1
For n8 = n-n9 To 0 Step -1
Mpz_add(x8, d2pow(9, n9), d2pow(8, n8))
For n7 = n-n9-n8 To 0 Step -1
Mpz_add(x7, x8, d2pow(7, n7))
For n6 = n-n9-n8-n7 To 0 Step -1
Mpz_add(x6, x7, d2pow(6, n6))
For n5 = n-n9-n8-n7-n6 To 0 Step -1
Mpz_add(x5, x6, d2pow(5, n5))
For n4 = n-n9-n8-n7-n6-n5 To 0 Step -1
Mpz_add(x4, x5, d2pow(4, n4))
For n3 = n-n9-n8-n7-n6-n5-n4 To 0 Step -1
Mpz_add(x3, x4, d2pow(3, n3))
For n2 = n-n9-n8-n7-n6-n5-n4-n3 To 0 Step -1
Mpz_add(x2, x3, d2pow(2, n2))
For n1 = n-n9-n8-n7-n6-n5-n4-n3-n2 To 0 Step -1
Mpz_add_ui(x1, x2, n1)
n0 = n-n9-n8-n7-n6-n5-n4-n3-n2-n1
 
Mpz_get_str(gmp_str, 10, x1)
 
If Len(*gmp_str) = n Then
ReDim d(10)
 
For i = 0 To n-1
d(gmp_str[i] - Asc("0")) += 1
Next i
 
If n9 = d(9) AndAlso n8 = d(8) AndAlso n7 = d(7) AndAlso n6 = d(6)_
AndAlso n5 = d(5) AndAlso n4 = d(4) AndAlso n3 = d(3)_
AndAlso n2 = d(2) AndAlso n1 = d(1) AndAlso n0 = d(0) Then
Print *gmp_str
End If
ElseIf Len(*gmp_str) < n Then
' all for next loops have a negative step value
' if len(str_x) becomes smaller then n it's time to try the next n value
' GoTo label1 ' old school BASIC
' prefered FreeBASIC style
Exit For, For, For, For, For, For, For, For, For
' leave n1, n2, n3, n4, n5, n6, n7, n8, n9 loop
' and continue's after next n9
End If
 
Next n1
Next n2
Next n3
Next n4
Next n5
Next n6
Next n7
Next n8
Next n9
' label1:
Next n
 
' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</syntaxhighlight>
{{out}}
Left side: program output, right side: sorted on length, value
<pre style="height:35ex;overflow:scroll">9 0
8 1
7 2
6 3
5 4
4 5
3 6
2 7
1 8
0 9
407 153
371 370
370 371
153 407
9474 1634
8208 8208
1634 9474
93084 54748
92727 92727
54748 93084
548834 548834
9926315 1741725
9800817 4210818
4210818 9800817
1741725 9926315
88593477 24678050
24678051 24678051
24678050 88593477
912985153 146511208
534494836 472335975
472335975 534494836
146511208 912985153
4679307774 4679307774
94204591914 32164049650
82693916578 32164049651
49388550606 40028394225
44708635679 42678290603
42678290603 44708635679
40028394225 49388550606
32164049651 82693916578
32164049650 94204591914
28116440335967 28116440335967
4338281769391371 4338281769391370
4338281769391370 4338281769391371
35875699062250035 21897142587612075
35641594208964132 35641594208964132
21897142587612075 35875699062250035
4929273885928088826 1517841543307505039
4498128791164624869 3289582984443187032
3289582984443187032 4498128791164624869
1517841543307505039 4929273885928088826
63105425988599693916 63105425988599693916
449177399146038697307 128468643043731391252
128468643043731391252 449177399146038697307
35452590104031691935943 21887696841122916288858
28361281321319229463398 27879694893054074471405
27907865009977052567814 27907865009977052567814
27879694893054074471405 28361281321319229463398
21887696841122916288858 35452590104031691935943
239313664430041569350093 174088005938065293023722
188451485447897896036875 188451485447897896036875
174088005938065293023722 239313664430041569350093
4422095118095899619457938 1550475334214501539088894
3706907995955475988644381 1553242162893771850669378
3706907995955475988644380 3706907995955475988644380
1553242162893771850669378 3706907995955475988644381
1550475334214501539088894 4422095118095899619457938
177265453171792792366489765 121204998563613372405438066
174650464499531377631639254 121270696006801314328439376
128851796696487777842012787 128851796696487777842012787
121270696006801314328439376 174650464499531377631639254
121204998563613372405438066 177265453171792792366489765
23866716435523975980390369295 14607640612971980372614873089
19008174136254279995012734741 19008174136254279995012734740
19008174136254279995012734740 19008174136254279995012734741
14607640612971980372614873089 23866716435523975980390369295
2309092682616190307509695338915 1145037275765491025924292050346
1927890457142960697580636236639 1927890457142960697580636236639
1145037275765491025924292050346 2309092682616190307509695338915
17333509997782249308725103962772 17333509997782249308725103962772
186709961001538790100634132976991 186709961001538790100634132976990
186709961001538790100634132976990 186709961001538790100634132976991
1122763285329372541592822900204593 1122763285329372541592822900204593
12679937780272278566303885594196922 12639369517103790328947807201478392
12639369517103790328947807201478392 12679937780272278566303885594196922
1219167219625434121569735803609966019 1219167219625434121569735803609966019
12815792078366059955099770545296129367 12815792078366059955099770545296129367
115132219018763992565095597973971522401 115132219018763992565095597973971522400
115132219018763992565095597973971522400 115132219018763992565095597973971522401</pre>
 
=={{header|FunL}}==
Line 2,200 ⟶ 2,349:
[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|GW-BASIC}}==
{{trans|FreeBASIC}}
Maximum for N (double) is14 digits, there are no 15 digits numbers
<syntaxhighlight lang="qbasic">1 DEFINT A-W : DEFDBL X-Z : DIM D(9) : DIM X2(9) : KEY OFF : CLS
2 FOR A = 0 TO 9 : X2(A) = A : NEXT A
3 FOR N = 1 TO 7
4 FOR N9 = N TO 0 STEP -1
5 FOR N8 = N-N9 TO 0 STEP -1
6 FOR N7 = N-N9-N8 TO 0 STEP -1
7 FOR N6 = N-N9-N8-N7 TO 0 STEP -1
8 FOR N5 = N-N9-N8-N7-N6 TO 0 STEP -1
9 FOR N4 = N-N9-N8-N7-N6-N5 TO 0 STEP -1
10 FOR N3 = N-N9-N8-N7-N6-N5-N4 TO 0 STEP -1
11 FOR N2 = N-N9-N8-N7-N6-N5-N4-N3 TO 0 STEP -1
12 FOR N1 = N-N9-N8-N7-N6-N5-N4-N3-N2 TO 0 STEP -1
13 N0 = N-N9-N8-N7-N6-N5-N4-N3-N2-N1
14 X = N1 + N2*X2(2) + N3*X2(3) + N4*X2(4) + N5*X2(5) + N6*X2(6) + N7*X2(7) + N8*X2(8) + N9*X2(9)
15 S$ = MID$(STR$(X),2)
16 IF LEN(S$) < N THEN GOTO 25
17 IF LEN(S$) <> N THEN GOTO 24
18 FOR A = 0 TO 9 : D(A) = 0 : NEXT A
19 FOR A = 0 TO N-1
20 B = ASC(MID$(S$,A+1,1))-48
21 D(B) = D(B) + 1
22 NEXT A
23 IF N0 = D(0) AND N1 = D(1) AND N2 = D(2) AND N3 = D(3) AND N4 = D(4) AND N5 = D(5) AND N6 = D(6) AND N7 = D(7) AND N8 = D(8) AND N9 = D(9) THEN PRINT X,
24 NEXT N1 : NEXT N2 : NEXT N3 : NEXT N4 : NEXT N5 : NEXT N6 : NEXT N7 : NEXT N8 : NEXT N9
25 FOR A = 2 TO 9
26 X2(A) = X2(A) * A
27 NEXT A
28 NEXT N
29 PRINT
30 PRINT "done"
31 END</syntaxhighlight>
{{out}}
<pre> 9 8 7 6 5
4 3 2 1 0
407 371 370 153 9474
8208 1634 93084 92727 54748
548834 9926315 9800817 4210818 1741725</pre>
 
=={{header|Haskell}}==
Line 4,804 ⟶ 4,912:
<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
elapsed: 436.639</pre>
 
=={{header|VBA}}==
{{trans|Phix}}<syntaxhighlight lang="vb">Private Function narcissistic(n As Long) As Boolean
Dim d As String: d = CStr(n)
Dim l As Integer: l = Len(d)
Dim sumn As Long: sumn = 0
For i = 1 To l
sumn = sumn + (Mid(d, i, 1) - "0") ^ l
Next i
narcissistic = sumn = n
End Function
 
Public Sub main()
Dim s(24) As String
Dim n As Long: n = 0
Dim found As Integer: found = 0
Do While found < 25
If narcissistic(n) Then
s(found) = CStr(n)
found = found + 1
End If
n = n + 1
Loop
Debug.Print Join(s, ", ")
End Sub</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|VBScript}}==
<syntaxhighlight lang="vb">Function Narcissist(n)
i = 0
j = 0
Do Until j = n
sum = 0
For k = 1 To Len(i)
sum = sum + CInt(Mid(i,k,1)) ^ Len(i)
Next
If i = sum Then
Narcissist = Narcissist & i & ", "
j = j + 1
End If
i = i + 1
Loop
End Function
 
WScript.StdOut.Write Narcissist(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>
 
=={{header|Wren}}==
Line 4,940 ⟶ 5,001:
L(548834,1741725,4210818,9800817,9926315)
</pre>
 
=={{header|ZX Spectrum Basic}}==
Array index starts at 1. Only 1 character long variable names are allowed for For-Next loops. 8 Digits or higher numbers are displayed as floating point numbers. Needs about 2 hours (3.5Mhz)
<syntaxhighlight lang="zxbasic"> 1 DIM K(10): DIM M(10)
2 FOR Y=0 TO 9: LET M(Y+1)=Y: NEXT Y
3 FOR N=1 TO 7
4 FOR J=N TO 0 STEP -1
5 FOR I=N-J TO 0 STEP -1
6 FOR H=N-J-I TO 0 STEP -1
7 FOR G=N-J-I-H TO 0 STEP -1
8 FOR F=N-J-I-H-G TO 0 STEP -1
9 FOR E=N-J-I-H-G-F TO 0 STEP -1
10 FOR D=N-J-I-H-G-F-E TO 0 STEP -1
11 FOR C=N-J-I-H-G-F-E-D TO 0 STEP -1
12 FOR B=N-J-I-H-G-F-E-D-C TO 0 STEP -1
13 LET A=N-J-I-H-G-F-E-D-C-B
14 LET X=B+C*M(3)+D*M(4)+E*M(5)+F*M(6)+G*M(7)+H*M(8)+I*M(9)+J*M(10)
15 LET S$=STR$ (X)
16 IF LEN (S$)<N THEN GO TO 34
17 IF LEN (S$)<>N THEN GO TO 33
18 FOR Y=1 TO 10: LET K(Y)=0: NEXT Y
19 FOR Y=1 TO N
20 LET Z= CODE (S$(Y))-47
21 LET K(Z)=K(Z)+1
22 NEXT Y
23 IF A<>K(1) THEN GO TO 33
24 IF B<>K(2) THEN GO TO 33
25 IF C<>K(3) THEN GO TO 33
26 IF D<>K(4) THEN GO TO 33
27 IF E<>K(5) THEN GO TO 33
28 IF F<>K(6) THEN GO TO 33
29 IF G<>K(7) THEN GO TO 33
30 IF H<>K(8) THEN GO TO 33
31 IF I<>K(9) THEN GO TO 33
32 IF J=K(10) THEN PRINT X,
33 NEXT B: NEXT C: NEXT D: NEXT E: NEXT F: NEXT G: NEXT H: NEXT I: NEXT J
34 FOR Y=2 TO 9
35 LET M(Y+1)=M(Y+1)*Y
36 NEXT Y
37 NEXT N
38 PRINT
39 PRINT "DONE"</syntaxhighlight>
{{out}}
<pre>9 8
7 6
5 4
3 2
1 0
9 8
7 6
5 4
3 2
1 0
407 371
370 153
9474 8208
1634 93084
92727 54748
548834 9926315
9800817 4210818
1741725</pre>
Christophoro S
511

edits

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