Narcissistic Number

Author

Eric W. Weisstein
January 6, 2006

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/NarcissisticNumber.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/NarcissisticNumber.html.

©2006 Wolfram Research, Inc. except for portions noted otherwise

Code

NarcissisticSum[n_Integer,b_:10]:=Module[{d=IntegerDigits[n,b]},
Plus@@(d^Length[d])
]
NarcissisticQ[n_Integer,b_:10]:=n==NarcissisticSum[n,b]

NarcissisticNumbers={1,2,3,4,5,6,7,8,9,153,370,371,407,1634,8208,9474,54748,92727,93084,
548834,1741725,4210818,9800817,9926315,24678050,24678051,88593477,
146511208,472335975,534494836,912985153,4679307774,32164049650,
32164049651,40028394225,42678290603,44708635679,49388550606,
82693916578,94204591914,28116440335967,4338281769391370,
4338281769391371,21897142587612075,35641594208964132,35875699062250035,
1517841543307505039,3289582984443187032,4498128791164624869,
4929273885928088826,63105425988599693916,128468643043731391252,
449177399146038697307,21887696841122916288858,27879694893054074471405,
27907865009977052567814,28361281321319229463398,
35452590104031691935943,174088005938065293023722,
188451485447897896036875,239313664430041569350093,
1550475334214501539088894,1553242162893771850669378,
3706907995955475988644380,3706907995955475988644381,
4422095118095899619457938,121204998563613372405438066,
121270696006801314328439376,128851796696487777842012787,
174650464499531377631639254,177265453171792792366489765,
14607640612971980372614873089,19008174136254279995012734740,
19008174136254279995012734741,23866716435523975980390369295,
1145037275765491025924292050346,1927890457142960697580636236639,
2309092682616190307509695338915,17333509997782249308725103962772,
186709961001538790100634132976990,186709961001538790100634132976991,
1122763285329372541592822900204593,12639369517103790328947807201478392,
12679937780272278566303885594196922,
1219167219625434121569735803609966019,
12815792078366059955099770545296129367,
115132219018763992565095597973971522400,
115132219018763992565095597973971522401};

Sums

NarcissisticSum/@Range[20]

Enumeration

Select[Range[10^6],NarcissisticQ]//Timing

And@@NarcissisticQ/@NarcissisticNumbers

Length[NarcissisticNumbers]

Last[NarcissisticNumbers]

Table

TableForm[DeleteCases[Table[{n,Select[NarcissisticNumbers,Length[IntegerDigits[#]]==n&]},{n,39}],_?(Last[#]==={}&)],TableDepth->2]

Inequality

What is the general form of this inequality?

Base 3

f1[n_?InexactNumberQ] := With[{b=3},n (b-1)^n-b^(n-1)]
f2[t_] := N[f1[SetPrecision[t, Infinity]],$MachinePrecision + 1]

Plot[f2[n],{n,0,1},PlotStyle->Red]

With[{b=3},FindRoot[n (b-1)^n-b^(n-1),{n,0,20},WorkingPrecision->10]]

Base 5

With[{b=5},FindRoot[n (b-1)^n-b^(n-1),{n,10,80},WorkingPrecision->10]]

Base 10

f1[n_?InexactNumberQ] := n 9^n-10^(n-1)
f2[t_] := N[f1[SetPrecision[t, Infinity]],$MachinePrecision + 1]

Plot[f2[n],{n,50,62},PlotStyle->Red]

FindRoot[n 9^n-10^(n-1),{n,60,80},WorkingPrecision->10]

Base 12

With[{b=12},FindRoot[n (b-1)^n-b^(n-1),{n,10,200},WorkingPrecision->10]]

Other Bases

Select[Range[10^6],NarcissisticQ[#,2]&]//Timing

Select[Range[10^6],NarcissisticQ[#,3]&]//Timing

Select[Range[10^6],NarcissisticQ[#,4]&]//Timing

Select[Range[10^6],NarcissisticQ[#,5]&]//Timing

Select[Range[10^6],NarcissisticQ[#,6]&]//Timing

Select[Range[10^6],NarcissisticQ[#,7]&]//Timing

Select[Range[10^5],NarcissisticQ[#,8]&]//Timing

Select[Range[10^5],NarcissisticQ[#,9]&]//Timing