Narcissistic decimal number
You are encouraged to solve this task according to the task description, using any language you may know.
A Narcissistic decimal number is a non-negative integer, , that is equal to the sum of the -th powers of each of the digits in the decimal representation of , where is the number of digits in the decimal representation of .
Narcissistic (decimal) numbers are sometimes called Armstrong numbers, named after Michael F. Armstrong.
- An example
-
- if is 153
- then , (the number of decimal digits) is 3
- we have 13 + 53 + 33 = 1 + 125 + 27 = 153
- and so 153 is a narcissistic decimal number
- Task
Generate and show here the first 25 narcissistic decimal numbers.
Note: , the first in the series.
Ada
<lang Ada>with Ada.Text_IO;
procedure Narcissistic is
function Is_Narcissistic(N: Natural) return Boolean is
Decimals: Natural := 1;
M: Natural := N;
Sum: Natural := 0;
begin
while M >= 10 loop
M := M / 10; Decimals := Decimals + 1;
end loop;
M := N;
while M >= 1 loop
Sum := Sum + (M mod 10) ** Decimals; M := M/10;
end loop;
return Sum=N;
end Is_Narcissistic;
Count, Current: Natural := 0;
begin
while Count < 25 loop
if Is_Narcissistic(Current) then
Ada.Text_IO.Put(Integer'Image(Current)); Count := Count + 1;
end if;
Current := Current + 1;
end loop;
end Narcissistic;</lang>
- Output:
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
Agena
Tested with Agena 2.9.5 Win32 <lang agena>scope
# print the first 25 narcissistic numbers
local power := reg( 0, 1, 1, 1, 1, 1, 1, 1, 1, 1 ); local count := 0; local maxCount := 25; local candidate := 0; local prevDigits := 0; local digits := 1;
for d9 from 0 to 2 while count < maxCount do
if d9 > 0 and digits < 9 then digits := 9 fi;
for d8 from 0 to 9 while count < maxCount do
if d8 > 0 and digits < 8 then digits := 8 fi;
for d7 from 0 to 9 while count < maxCount do
if d7 > 0 and digits < 7 then digits := 7 fi;
for d6 from 0 to 9 while count < maxCount do
if d6 > 0 and digits < 6 then digits := 6 fi;
for d5 from 0 to 9 while count < maxCount do
if d5 > 0 and digits < 5 then digits := 5 fi;
for d4 from 0 to 9 while count < maxCount do
if d4 > 0 and digits < 4 then digits := 4 fi;
for d3 from 0 to 9 while count < maxCount do
if d3 > 0 and digits < 3 then digits := 3 fi;
for d2 from 0 to 9 while count < maxCount do
if d2 > 0 and digits < 2 then digits := 2 fi;
for d1 from 0 to 9 do
if prevDigits <> digits then
# number of digits has increased - increase the powers
prevDigits := digits;
for i from 2 to 9 do mul power[ i + 1 ], i od;
fi;
# sum the digits'th powers of the digits of candidate
local sum := power[ d1 + 1 ] + power[ d2 + 1 ] + power[ d3 + 1 ]
+ power[ d4 + 1 ] + power[ d5 + 1 ] + power[ d6 + 1 ]
+ power[ d7 + 1 ] + power[ d8 + 1 ] + power[ d9 + 1 ]
;
if candidate = sum
then
# found another narcissistic decimal number
io.write( " ", candidate );
inc count, 1
fi;
inc candidate, 1
od; # d1
od; # d2
od; # d3
od; # d4
od; # d5
od; # d6
od; # d7
od; # d8
od; # d9
io.writeline()
epocs</lang>
- Output:
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
ALGOL 68
<lang algol68># find some narcissistic decimal numbers #
- returns TRUE if n is narcissitic, FALSE otherwise; n should be >= 0 #
PROC is narcissistic = ( INT n )BOOL:
BEGIN
# count the number of digits in n #
INT digits := 0;
INT number := n;
WHILE digits +:= 1;
number OVERAB 10;
number > 0
DO SKIP OD;
# sum the digits'th powers of the digits of n #
INT sum := 0;
number := n;
TO digits DO
sum +:= ( number MOD 10 ) ^ digits;
number OVERAB 10
OD;
# n is narcissistic if n = sum #
n = sum
END # is narcissistic # ;
- print the first 25 narcissistic numbers #
INT count := 0; FOR n FROM 0 WHILE count < 25 DO
IF is narcissistic( n ) THEN
# found another narcissistic number #
print( ( " ", whole( n, 0 ) ) );
count +:= 1
FI
OD; print( ( newline ) )</lang>
- Output:
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
AppleScript
AppleScript is out of its depth here, even with an algorithm which restricts the search space (see the JavaScript and Haskell discussions).
I have set the test here only to look for solutions with up to 5 digits (first 20 narcissistic decimal numbers). Even this takes over 5 seconds, and extending the search to 6 digits is rewarded with a result only after several minutes. Some patience would be required for the full 7 digit search that finds the 25th number.
(For comparison, equivalent code in JavaScript returns all 25 numbers in about 150 milliseconds) <lang AppleScript>-- NARCISSI
-- powerSum :: Int -> [Int] -> Int on powerSum(e, ns)
script
on lambda(a, x)
a + x ^ e
end lambda
end script
foldl(result, 0, ns) as integer
end powerSum
-- narcissiOfLength :: Int -> [Int] script narcissiOfLength
on lambda(n)
script isDaffodil
on lambda(sortedDigits)
sortedDigits = quickSort(digitList(powerSum(n, sortedDigits)))
end lambda
end script
map(curry(powerSum)'s lambda(n), filter(isDaffodil, digitGroups(n)))
end lambda
end script
-- digitGroups :: Int -> Int on digitGroups(nDigits)
script prependDesc
on lambda(xxs)
script prepend
on lambda(y)
{y} & xxs
end lambda
end script
map(prepend, enumFromTo(0, item 1 of xxs))
end lambda
end script
script pure
on lambda(x)
{x}
end lambda
end script
script possibleDigits
on sortedCombinations(n, xs)
if n > 0 then
if xs ≠ {} then
sortedCombinations(n - 1, concatMap(prependDesc, xs))
else
sortedCombinations(n - 1, map(pure, enumFromTo(0, 9)))
end if
else
xs
end if
end sortedCombinations
end script
possibleDigits's sortedCombinations(nDigits, {})
end digitGroups
-- digitList :: Int -> [Int] on digitList(n)
if n > 0 then
{n mod 10} & digitList(n div 10)
else
{}
end if
end digitList
-- TEST -------------------------------------------------------------------
on run
{0} & concatMap(narcissiOfLength, enumFromTo(1, 5))
end run
-- GENERIC FUNCTIONS ------------------------------------------------------
-- concatMap :: (a -> [b]) -> [a] -> [b] on concatMap(f, xs)
set lst to {}
set lng to length of xs
tell mReturn(f)
repeat with i from 1 to lng
set lst to (lst & lambda(contents of item i of xs, i, xs))
end repeat
end tell
return lst
end concatMap
-- curry :: (Script|Handler) -> Script on curry(f)
script
on lambda(a)
script
on lambda(b)
lambda(a, b) of mReturn(f)
end lambda
end script
end lambda
end script
end curry
-- enumFromTo :: Int -> Int -> [Int] on enumFromTo(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo
-- filter :: (a -> Bool) -> [a] -> [a] on filter(f, xs)
tell mReturn(f)
set lst to {}
set lng to length of xs
repeat with i from 1 to lng
set v to item i of xs
if lambda(v, i, xs) then set end of lst to v
end repeat
return lst
end tell
end filter
-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to lambda(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- map :: (a -> b) -> [a] -> [b] on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to lambda(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)
if class of f is script then
f
else
script
property lambda : f
end script
end if
end mReturn
-- partition :: predicate -> List -> (Matches, nonMatches) -- partition :: (a -> Bool) -> [a] -> ([a], [a]) on partition(f, xs)
tell mReturn(f)
set lst to {{}, {}}
repeat with x in xs
set v to contents of x
set end of item ((lambda(v) as integer) + 1) of lst to v
end repeat
end tell
{item 2 of lst, item 1 of lst}
end partition
-- pure :: a -> [a] on pure(x)
{x}
end pure
-- quickSort :: (Ord a) => [a] -> [a] on quickSort(xs)
if length of xs > 1 then
set h to item 1 of xs
-- lessOrEqual :: a -> Bool
script lessOrEqual
on lambda(x)
x ≤ h
end lambda
end script
set {less, more} to partition(lessOrEqual, rest of xs)
quickSort(less) & h & quickSort(more)
else
xs
end if
end quickSort
-- sum :: Num a => [a] -> a on sum(xs)
script add
on lambda(a, b)
a + b
end lambda
end script
foldl(add, 0, xs)
end sum</lang>
- Output:
(Even the first 20 numbers take a good 5 or 6 seconds to return) <lang AppleScript>{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 153, 370, 371, 407, 1634, 8208, 9474, 54748, 92727, 93084}</lang>
AutoHotkey
<lang AutoHotkey>
- NoEnv ; Do not try to use environment variables
SetBatchLines, -1 ; Execute as quickly as you can
StartCount := A_TickCount Narc := Narc(25) Elapsed := A_TickCount - StartCount
MsgBox, Finished in %Elapsed%ms`n%Narc% return
Narc(m) { Found := 0, Lower := 0 Progress, B2 Loop { Max := 10 ** Digits:=A_Index Loop, 10 Index := A_Index-1, Powers%Index% := Index**Digits While Lower < Max { Sum := 0 Loop, Parse, Lower Sum += Powers%A_LoopField% Loop, 10 {
if (Lower + (Index := A_Index-1) == Sum + Powers%Index%) { Out .= Lower+Index . (Mod(++Found,5) ? ", " : "`n") Progress, % Found/M*100 if (Found >= m) { Progress, Off return Out } } } Lower += 10 } } } </lang>
- Output:
Finished in 17690ms 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
This is a derivative of the python example, but modified for speed reasons.
Instead of summing all the powers of all the numbers at once, we sum the powers for this multiple of 10, then check each number 0 through 9 at once before summing the next multiple of 10. This way, we don't have to calculate the sum of 174172_ for every number 1741720 through 1741729.
AWK
<lang AWK>
- syntax: GAWK -f NARCISSISTIC_DECIMAL_NUMBER.AWK
BEGIN {
for (n=0;;n++) {
leng = length(n)
sum = 0
for (i=1; i<=leng; i++) {
c = substr(n,i,1)
sum += c ^ leng
}
if (n == sum) {
printf("%d ",n)
if (++count == 25) { break }
}
}
exit(0)
} </lang>
output:
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
C
For a much longer but faster solution, see Narcissistic decimal number/C.
The following prints the first 25 numbers, though not in order... <lang c>#include <stdio.h>
- include <gmp.h>
- define MAX_LEN 81
mpz_t power[10]; mpz_t dsum[MAX_LEN + 1]; int cnt[10], len;
void check_perm(void) { char s[MAX_LEN + 1]; int i, c, out[10] = { 0 };
mpz_get_str(s, 10, dsum[0]); for (i = 0; s[i]; i++) { c = s[i]-'0'; if (++out[c] > cnt[c]) return; }
if (i == len) gmp_printf(" %Zd", dsum[0]); }
void narc_(int pos, int d) { if (!pos) { check_perm(); return; }
do { mpz_add(dsum[pos-1], dsum[pos], power[d]); ++cnt[d]; narc_(pos - 1, d); --cnt[d]; } while (d--); }
void narc(int n) { int i; len = n; for (i = 0; i < 10; i++) mpz_ui_pow_ui(power[i], i, n);
mpz_init_set_ui(dsum[n], 0);
printf("length %d:", n); narc_(n, 9); putchar('\n'); }
int main(void) { int i;
for (i = 0; i <= 10; i++) mpz_init(power[i]); for (i = 1; i <= MAX_LEN; i++) narc(i);
return 0; }</lang>
- Output:
length 1: 9 8 7 6 5 4 3 2 1 0 length 2: length 3: 407 371 370 153 length 4: 9474 8208 1634 length 5: 93084 92727 54748 length 6: 548834 length 7: 9926315 9800817 4210818 1741725 length 8: 88593477 24678051 24678050 length 9: 912985153 534494836 472335975 146511208 length 10: 4679307774 length 11: 94204591914 82693916578 49388550606 44708635679 42678290603 40028394225 32164049651 32164049650 length 12: length 13: length 14: 28116440335967 length 15: length 16: 4338281769391371 4338281769391370 length 17: 35875699062250035 35641594208964132 21897142587612075 length 18: ^C
C++
<lang cpp>
- include <iostream>
- include <vector>
using namespace std; typedef unsigned int uint;
class NarcissisticDecs { public:
void makeList( int mx )
{
uint st = 0, tl; int pwr = 0, len;
while( narc.size() < mx )
{ len = getDigs( st ); if( pwr != len ) { pwr = len; fillPower( pwr ); }
tl = 0;
for( int i = 1; i < 10; i++ ) tl += static_cast<uint>( powr[i] * digs[i] );
if( tl == st ) narc.push_back( st ); st++; }
}
void display()
{
for( vector<uint>::iterator i = narc.begin(); i != narc.end(); i++ ) cout << *i << " "; cout << "\n\n";
}
private:
int getDigs( uint st )
{
memset( digs, 0, 10 * sizeof( int ) ); int r = 0; while( st ) { digs[st % 10]++; st /= 10; r++; }
return r; }
void fillPower( int z )
{
for( int i = 1; i < 10; i++ ) powr[i] = pow( static_cast<float>( i ), z );
}
vector<uint> narc; uint powr[10]; int digs[10];
};
int main( int argc, char* argv[] ) {
NarcissisticDecs n; n.makeList( 25 ); n.display(); return system( "pause" );
} </lang>
- Output:
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
C#
<lang csharp> using System;
namespace Narcissistic {
class Narcissistic
{
public bool isNarcissistic(int z)
{
if (z < 0) return false;
string n = z.ToString();
int t = 0, l = n.Length;
foreach (char c in n)
t += Convert.ToInt32(Math.Pow(Convert.ToDouble(c - 48), l));
return t == z;
}
}
class Program
{
static void Main(string[] args)
{
Narcissistic n = new Narcissistic();
int c = 0, x = 0;
while (c < 25)
{
if (n.isNarcissistic(x))
{
if (c % 5 == 0) Console.WriteLine();
Console.Write("{0,7} ", x);
c++;
}
x++;
}
Console.WriteLine("\n\nPress any key to continue...");
Console.ReadKey();
}
}
} </lang>
- Output:
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
or
<lang csharp> //Narcissistic numbers: Nigel Galloway: February 17th., 2015 using System; using System.Collections.Generic; using System.Linq;
namespace RC {
public static class NumberEx {
public static IEnumerable<int> Digits(this int n) {
List<int> digits = new List<int>();
while (n > 0) {
digits.Add(n % 10);
n /= 10;
}
return digits.AsEnumerable();
}
}
class Program {
static void Main(string[] args) {
foreach (int N in Enumerable.Range(0, Int32.MaxValue).Where(k => {
var digits = k.Digits();
return digits.Sum(x => Math.Pow(x, digits.Count())) == k;
}).Take(25)) {
System.Console.WriteLine(N);
}
}
}
} </lang>
- Output:
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
Common Lisp
<lang lisp> (defun integer-to-list (n)
(map 'list #'digit-char-p (prin1-to-string n)))
(defun narcissisticp (n)
(let* ((lst (integer-to-list n))
(e (length lst)))
(= n
(reduce #'+ (mapcar (lambda (x) (expt x e)) lst)))))
(defun start ()
(loop for c from 0
while (< narcissistic 25)
counting (narcissisticp c) into narcissistic
do (if (narcissisticp c) (print c))))
</lang>
- Output:
CL-USER> (start) 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 NIL
D
Simple Version
<lang d>void main() {
import std.stdio, std.algorithm, std.conv, std.range;
immutable isNarcissistic = (in uint n) pure @safe =>
n.text.map!(d => (d - '0') ^^ n.text.length).sum == n;
writefln("%(%(%d %)\n%)",
uint.max.iota.filter!isNarcissistic.take(25).chunks(5));
}</lang>
- Output:
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
Fast Version
<lang d>import std.stdio, std.algorithm, std.range, std.array;
uint[] narcissists(in uint m) pure nothrow @safe {
typeof(return) result;
foreach (immutable uint digits; 0 .. 10) {
const digitPowers = 10.iota.map!(i => i ^^ digits).array;
foreach (immutable uint n; 10 ^^ (digits - 1) .. 10 ^^ digits) {
uint digitPSum, div = n;
while (div) {
digitPSum += digitPowers[div % 10];
div /= 10;
}
if (n == digitPSum) {
result ~= n;
if (result.length >= m)
return result;
}
}
}
assert(0);
}
void main() {
writefln("%(%(%d %)\n%)", 25.narcissists.chunks(5));
}</lang> With LDC2 compiler prints the same output in less than 0.3 seconds.
Faster Version
<lang d>import std.stdio, std.bigint, std.conv;
struct Narcissistics(TNum, uint maxLen) {
TNum[10] power; TNum[maxLen + 1] dsum; uint[10] count; uint len;
void checkPerm() const {
uint[10] mout;
immutable s = dsum[0].text;
foreach (immutable d; s) {
immutable c = d - '0';
if (++mout[c] > count[c])
return;
}
if (s.length == len)
writef(" %d", dsum[0]);
}
void narc2(in uint pos, uint d) {
if (!pos) {
checkPerm;
return;
}
do {
dsum[pos - 1] = dsum[pos] + power[d];
count[d]++;
narc2(pos - 1, d);
count[d]--;
} while (d--);
}
void show(in uint n) {
len = n;
foreach (immutable i, ref p; power)
p = TNum(i) ^^ n;
dsum[n] = 0;
writef("length %d:", n);
narc2(n, 9);
writeln;
}
}
void main() {
enum maxLength = 16;
Narcissistics!(ulong, maxLength) narc;
//Narcissistics!(BigInt, maxLength) narc; // For larger numbers.
foreach (immutable i; 1 .. maxLength + 1)
narc.show(i);
}</lang>
- Output:
length 1: 9 8 7 6 5 4 3 2 1 0 length 2: length 3: 407 371 370 153 length 4: 9474 8208 1634 length 5: 93084 92727 54748 length 6: 548834 length 7: 9926315 9800817 4210818 1741725 length 8: 88593477 24678051 24678050 length 9: 912985153 534494836 472335975 146511208 length 10: 4679307774 length 11: 94204591914 82693916578 49388550606 44708635679 42678290603 40028394225 32164049651 32164049650 length 12: length 13: length 14: 28116440335967 length 15: length 16: 4338281769391371 4338281769391370
With LDC2 compiler and maxLength=16 the run-time is about 0.64 seconds.
Elixir
<lang elixir>defmodule RC do
def narcissistic(m) do
Enum.reduce(1..10, [0], fn digits,acc ->
digitPowers = List.to_tuple(for i <- 0..9, do: power(i, digits))
Enum.reduce(power(10, digits-1) .. power(10, digits)-1, acc, fn n,result ->
sum = divsum(n, digitPowers, 0)
if n == sum do
if length(result) == m-1, do: throw Enum.reverse(result, [n])
[n | result]
else
result
end
end)
end)
end
defp divsum(0, _, sum), do: sum
defp divsum(n, digitPowers, sum) do
divsum(div(n,10), digitPowers, sum+elem(digitPowers,rem(n,10)))
end
defp power(n, m), do: power(n, m, 1)
defp power(_, 0, pow), do: pow
defp power(n, m, pow), do: power(n, m-1, pow*n)
end
try do
RC.narcissistic(25)
catch
x -> IO.inspect x
end</lang>
- Output:
[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]
ERRE
<lang ERRE>PROGRAM NARCISISTIC
!$DOUBLE
BEGIN
N=0
LOOP
LENG=LEN(MID$(STR$(N),2))
SUM=0
FOR I=1 TO LENG DO
C$=MID$(STR$(N),2)
C=VAL(MID$(C$,I,1))
SUM+=C^LENG
END FOR
IF N=SUM THEN
PRINT(N;)
COUNT=COUNT+1
EXIT IF COUNT=25
END IF
N=N+1
END LOOP
END PROGRAM</lang> Output
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
F#
<lang fsharp> //Naïve solution of Narcissitic number: Nigel Galloway - Febryary 18th., 2015 open System let rec _Digits (n,g) = if n < 10 then n::g else _Digits(n/10,n%10::g)
seq{0 .. Int32.MaxValue} |> Seq.filter (fun n ->
let d = _Digits (n, []) d |> List.fold (fun a l -> a + int ((float l) ** (float (List.length d)))) 0 = n) |> Seq.take(25) |> Seq.iter (printfn "%A")
</lang>
- Output:
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
FreeBASIC
Simple Version
<lang FreeBASIC>' normal version: 17-06-2015 ' compile with: fbc -s console ' can go up to 19 digits (ulongint is 64bit), above 19 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*d2pow(1) + 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</lang>
- Output:
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
GMP Version
It takes about 35 min. to find all 88 numbers (39 digits). To go all the way it takes about 2 hours.
<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</lang>
FunL
<lang funl>def narcissistic( start ) =
power = 1 powers = array( 0..9 )
def narc( n ) = num = n.toString() m = num.length()
if power != m
power = m
powers( 0..9 ) = [i^m | i <- 0..9]
if n == sum( powers(int(d)) | d <- num )
n # narc( n + 1 )
else
narc( n + 1 )
narc( start )
println( narcissistic(0).take(25) )</lang>
- Output:
[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]
Go
Nothing fancy as it runs in a fraction of a second as-is. <lang go>package main
import "fmt"
func narc(n int) []int { power := [...]int{0, 1, 2, 3, 4, 5, 6, 7, 8, 9} limit := 10 result := make([]int, 0, n) for x := 0; len(result) < n; x++ { if x >= limit { for i := range power { power[i] *= i // i^m } limit *= 10 } sum := 0 for xx := x; xx > 0; xx /= 10 { sum += power[xx%10] } if sum == x { result = append(result, x) } } return result }
func main() { fmt.Println(narc(25)) }</lang>
- Output:
[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]
Haskell
Exhaustive search (integer series)
<lang Haskell>import Data.Char (digitToInt)
isNarcissistic :: Int -> Bool isNarcissistic n = (sum ((^ digitCount) <$> digits) ==) n
where digits = digitToInt <$> show n digitCount = length digits
main :: IO () main = mapM_ print $ take 25 (filter isNarcissistic [0 ..])</lang>
Reduced search (unordered digit combinations)
As summing the nth power of the digits is unaffected by digit order, we can reduce the search space by filtering digit combinations of given length and arbitrary order, rather than filtering a full integer sequence.
In this way we can find the 25th narcissistic number after (sum $ (length . digitGroups) <$> [1..7]) == 19447 tests – an improvement on the exhaustive trawl through 9926315 integers.
<lang haskell>import Data.List (sort, unfoldr) import Data.Tuple (swap)
narcissiOfLength :: Int -> [Int] narcissiOfLength n =
let isDaffodil n ds = (sort . digitList . powerSum n) ds == ds in powerSum n <$> filter (isDaffodil n) (digitGroups n)
powerSum :: Int -> [Int] -> Int powerSum n = foldr ((+) . (^ n)) 0
digitList :: Int -> [Int] digitList =
unfoldr
(\x ->
if x > 0
then Just (swap (quotRem x 10))
else Nothing)
digitGroups :: Int -> Int digitGroups nDigits = sortedDigits nDigits []
where
digits = [0 .. 9]
prependHeadMinus = ((<$>) . flip (:)) <*> (enumFromTo 0 . head)
sortedDigits n xs =
if n > 0
then sortedDigits
(n - 1)
(if null xs
then pure <$> digits
else foldMap prependHeadMinus xs)
else xs
main :: IO () main = print $ 0 : concat (narcissiOfLength <$> [1 .. 7])</lang>
- Output:
[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]
Icon and Unicon
The following is a quick, dirty, and slow solution that works in both languages: <lang unicon>procedure main(A)
limit := integer(A[1]) | 25 every write(isNarcissitic(seq(0))\limit)
end
procedure isNarcissitic(n)
sn := string(n) m := *sn every (sum := 0) +:= (!sn)^m return sum = n
end</lang>
Sample run:
->ndn 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 ->
J
<lang j>getDigits=: "."0@": NB. get digits from number isNarc=: (= +/@(] ^ #)@getDigits)"0 NB. test numbers for Narcissism</lang> Example Usage <lang j> (#~ isNarc) i.1e7 NB. display Narcissistic numbers 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</lang>
Java
<lang java5>public class Narc{ public static boolean isNarc(long x){ if(x < 0) return false;
String xStr = Long.toString(x); int m = xStr.length(); long sum = 0;
for(char c : xStr.toCharArray()){ sum += Math.pow(Character.digit(c, 10), m); } return sum == x; }
public static void main(String[] args){ for(long x = 0, count = 0; count < 25; x++){ if(isNarc(x)){ System.out.print(x + " "); count++; } } } }</lang>
- Output:
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
The statics and the System.exit(0) stem from having first developed a version that is not limited by the amount of narcisstic numbers that are to be calculated. I then read that this is a criterion and thus the implementation is an afterthought and looks awkwardish... but still... works! <lang java5> import java.util.stream.IntStream; public class NarcissisticNumbers {
static int numbersToCalculate = 25;
static int numbersCalculated = 0;
public static void main(String[] args) {
IntStream.iterate(0, n -> n + 1).limit(Integer.MAX_VALUE).boxed().forEach(i -> {
int length = i.toString().length();
int addedDigits = 0;
for (int count = 0; count < length; count++) {
int value = Integer.parseInt(String.valueOf(i.toString().charAt(count)));
addedDigits += Math.pow(value, length);
}
if (i == addedDigits) {
numbersCalculated++;
System.out.print(addedDigits + " ");
}
if (numbersCalculated == numbersToCalculate) {
System.exit(0);
}
});
}
}</lang>
- Output:
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
JavaScript
ES5
<lang javascript>function isNarc(x) {
var str = x.toString(),
i,
sum = 0,
l = str.length;
if (x < 0) {
return false;
} else {
for (i = 0; i < l; i++) {
sum += Math.pow(str.charAt(i), l);
}
}
return sum == x;
} function main(){
var n = [];
for (var x = 0, count = 0; count < 25; x++){
if (isNarc(x)){
n.push(x);
count++;
}
}
return n.join(' ');
}</lang>
- Output:
"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"
ES6
Exhaustive search (integer series)
<lang JavaScript>(() => {
'use strict';
// digits :: Int -> [Int]
const digits = n => n.toString()
.split()
.map(x => parseInt(x, 10));
// pow :: Int -> Int -> Int
const pow = Math.pow;
// isNarc :: Int -> Bool
const isNarc = n => {
const
ds = digits(n),
len = ds.length;
return ds.reduce((a, x) =>
a + pow(x, len), 0) === n;
};
// until :: (a -> Bool) -> (a -> a) -> a -> a
const until = (p, f, x) => {
let v = x;
while (!p(v)) v = f(v);
return v;
};
return until(
x => x.narc.length > 24,
x => ({
n: x.n + 1,
narc: (isNarc(x.n) ? x.narc.concat(x.n) : x.narc)
}), {
n: 0,
narc: []
}
)
.narc
})();</lang>
- Output:
<lang JavaScript>[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]</lang>
Reduced search (unordered digit combinations)
As summing the nth power of the digits is unaffected by digit order, we can reduce the search space by filtering digit combinations of given length and arbitrary order, rather than filtering a full integer sequence.
In this way we can find the 25th narcissistic number after sum(map(compose(length, digitGroups), enumFromTo(1, 7))) === 19447 tests – an improvement on the exhaustive trawl through 9926315 integers. <lang JavaScript>(() => {
'use strict';
// GENERIC FUNCTIONS
// arrayEq :: [a] -> [a] -> Bool
const arrayEq = (xs, ys) => {
const lngX = xs.length;
return (lngX !== ys.length) ? false : (
lngX > 0 ? (
(() => {
let i = lngX;
while (i--)
if (xs[i] !== ys[i]) return false;
return true;
})()
) : true
);
};
// concat :: a -> [a] | [String] -> String const concat = xs => { if (xs.length > 0) { const unit = typeof xs[0] === 'string' ? : []; return unit.concat.apply(unit, xs); } else return []; };
// concatMap :: (a -> [b]) -> [a] -> [b] const concatMap = (f, xs) => [].concat.apply([], xs.map(f));
// cons :: a -> [a] -> [a] const cons = (x, xs) => [x].concat(xs);
// curry :: Function -> Function
const curry = (f, ...args) => {
const go = xs => xs.length >= f.length ? (f.apply(null, xs)) :
function () {
return go(xs.concat([].slice.apply(arguments)));
};
return go([].slice.call(args, 1));
};
// enumFromTo :: Int -> Int -> [Int]
const enumFromTo = (m, n) =>
Array.from({
length: Math.floor(n - m) + 1
}, (_, i) => m + i);
// filter :: (a -> Bool) -> [a] -> [a] const filter = (f, xs) => xs.filter(f);
// head :: [a] -> a const head = xs => xs.length ? xs[0] : undefined;
// isNull :: [a] -> Bool const isNull = xs => (xs instanceof Array) ? xs.length < 1 : undefined;
// map :: (a -> b) -> [a] -> [b] const map = curry((f, xs) => xs.map(f));
// pure :: a -> [a] const pure = x => [x];
// show :: a -> String const show = JSON.stringify;
// sort :: Ord a => [a] -> [a] const sort = xs => xs.sort();
// NARCISSI
// narcissiOfLength :: Int -> [Int]
const narcissiOfLength = n => {
const isDaffodil = sortedDigits =>
arrayEq(sortedDigits, sort(digitList(powerSum(n, sortedDigits))));
return map(powerSum(n), filter(isDaffodil, digitGroups(n)));
};
// powerSum :: Int -> [Int] -> Int
const powerSum = curry((n, xs) =>
xs.reduce((a, x) => a + Math.pow(x, n), 0));
// Full list of sorted combinations of digits [0..9], with repetition.
// digitGroups :: Int -> Int const digitGroups = nDigits => { const digits = enumFromTo(0, 9), sortedCombinations = (n, xs) => (n > 0) ? ( sortedCombinations(n - 1, isNull(xs) ? ( map(pure, digits) ) : concatMap(xxs => map(y => cons(y, xxs), enumFromTo(0, head(xxs))), xs )) ) : xs; return sortedCombinations(nDigits, []); };
// digitList :: Int -> [Int]
const digitList = n =>
(n > 0) ? cons((n % 10), digitList(Math.floor(n / 10))) : [];
// TEST
// Narcissistic decimal numbers of digit length from 1 to 7:
return show(
concat(cons(0, map(narcissiOfLength, enumFromTo(1, 7))))
);
})();</lang>
- Output:
<lang JavaScript>[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]</lang>
jq
A function for checking whether a given non-negative integer is narcissistic could be implemented in jq as follows: <lang jq>def is_narcissistic:
def digits: tostring | explode[] | [.] | implode | tonumber; def pow(n): . as $x | reduce range(0;n) as $i (1; . * $x);
(tostring | length) as $len | . == reduce digits as $d (0; . + ($d | pow($len)) ) end;</lang>
In the following, this definition is modified to avoid recomputing (d ^ i). This is accomplished introducing the array [i, [0^i, 1^i, ..., 9^i]]. To update this array for increasing values of i, the function powers(j) is defined as follows: <lang jq># Input: [i, [0^i, 1^i, 2^i, ..., 9^i]]
- Output: [j, [0^j, 1^j, 2^j, ..., 9^j]]
- provided j is i or (i+1)
def powers(j):
if .[0] == j then . else .[0] += 1 | reduce range(0;10) as $k (.; .[1][$k] *= $k) end;</lang>
The function is_narcisstic can now be modified to use powers(j) as follows: <lang jq># Input: [n, [i, [0^i, 1^i, 2^i,...]]] where i is the number of digits in n. def is_narcissistic:
def digits: tostring | explode[] | [.] | implode | tonumber; .[1][1] as $powers | .[0] | if . < 0 then false else . == reduce digits as $d (0; . + $powers[$d] ) end;</lang>
The task <lang jq># If your jq has "while", then feel free to omit the following definition: def while(cond; update):
def _while: if cond then ., (update | _while) else empty end; _while;
- The first k narcissistic numbers, beginning with 0:
def narcissistic(k):
# State: [n, is_narcissistic, count, [len, [0^len, 1^len, ...]]]
# where len is the number of digits in n.
[0, true, 1, [1, [range(0;10)]]]
| while( .[2] <= k;
.[3] as $powers
| (.[0]+1) as $n
| ($n | tostring | length) as $len
| ($powers | powers($len)) as $powersprime | if [$n, $powersprime] | is_narcissistic then [$n, true, .[2] + 1, $powersprime] else [$n, false, .[2], $powersprime ] end )
| select(.[1]) | "\(.[2]): \(.[0])" ;
narcissistic(25)</lang>
- Output:
<lang sh>jq -r -n -f Narcissitic_decimal_number.jq 1: 0 2: 1 3: 2 4: 3 5: 4 6: 5 7: 6 8: 7 9: 8 10: 9 11: 153 12: 370 13: 371 14: 407 15: 1634 16: 8208 17: 9474 18: 54748 19: 92727 20: 93084 21: 548834 22: 1741725 23: 4210818 24: 9800817 25: 9926315</lang>
Julia
This easy to implement brute force technique is plenty fast enough to find the first few Narcissistic decimal numbers. <lang Julia> function isnarcissist{T<:Integer}(n::T, b::Int=10)
-1 < n || return false d = digits(n, b) m = length(d) n == mapreduce((x)->x^m, +, d)
end
goal = 25 ncnt = 0 println("Finding the first ", goal, " Narcissistic numbers:") for i in 0:typemax(1)
isnarcissist(i) || continue ncnt += 1 println(@sprintf " %2d %7d" ncnt i) ncnt < goal || break
end </lang>
- Output:
1 0
2 1
3 2
4 3
5 4
6 5
7 6
8 7
9 8
10 9
11 153
12 370
13 371
14 407
15 1634
16 8208
17 9474
18 54748
19 92727
20 93084
21 548834
22 1741725
23 4210818
24 9800817
25 9926315
Kotlin
<lang scala>// version 1.1.0
fun isNarcissistic(n: Int): Boolean {
if (n < 0) throw IllegalArgumentException("Argument must be non-negative")
var nn = n
val digits = mutableListOf<Int>()
val powers = IntArray(10) { 1 }
while (nn > 0) {
digits.add(nn % 10)
for (i in 1..9) powers[i] *= i // no need to calculate powers[0]
nn /= 10
}
val sum = digits.filter { it > 0 }.map { powers[it] }.sum()
return n == sum
}
fun main(args: Array<String>) {
println("The first 25 narcissistic (or Armstrong) numbers are:")
var i = 0
var count = 0
do {
if (isNarcissistic(i)) {
print("$i ")
count++
}
i++
}
while (count < 25)
}</lang>
- Output:
The first 25 narcissistic (or Armstrong) numbers are: 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
Lua
This is a simple/naive/slow method but it still spits out the requisite 25 in less than a minute using LuaJIT on a 2.5 GHz machine. <lang Lua>function isNarc (n)
local m, sum, digit = string.len(n), 0
for pos = 1, m do
digit = tonumber(string.sub(n, pos, pos))
sum = sum + digit^m
end
return sum == n
end
local n, count = 0, 0 repeat
if isNarc(n) then
io.write(n .. " ")
count = count + 1
end
n = n + 1
until count == 25</lang>
- Output:
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
Mathematica
<lang Mathematica>narc[1] = 0; narc[n_] :=
narc[n] = NestWhile[# + 1 &, narc[n - 1] + 1, Plus @@ (IntegerDigits[#]^IntegerLength[#]) != # &];
narc /@ Range[25]</lang>
- Output:
{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}
MATLAB
<lang MATLAB>function testNarcissism
x = 0;
c = 0;
while c < 25
if isNarcissistic(x)
fprintf('%d ', x)
c = c+1;
end
x = x+1;
end
fprintf('\n')
end
function tf = isNarcissistic(n)
dig = sprintf('%d', n) - '0';
tf = n == sum(dig.^length(dig));
end</lang>
- Output:
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
Oforth
<lang Oforth>: isNarcissistic(n) | i m |
n 0 while( n ) [ n 10 /mod ->n swap 1 + ] ->m 0 m loop: i [ swap m pow + ] == ;
- genNarcissistic(n)
| l |
ListBuffer new dup ->l 0 while(l size n <>) [ dup isNarcissistic ifTrue: [ dup l add ] 1 + ] drop ;
</lang>
- Output:
>genNarcissistic(25) . [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] ok
PARI/GP
Naive code, could be improved by splitting the digits in half and meeting in the middle. <lang parigp>isNarcissistic(n)=my(v=digits(n)); sum(i=1, #v, v[i]^#v)==n v=List();for(n=1,1e9,if(isNarcissistic(n),listput(v,n);if(#v>24, return(Vec(v)))))</lang>
- Output:
%1 = [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]
Pascal
A recursive version starting at the highest digit and recurses to digit 0. Bad runtime. One more digit-> 10x runtime runtime ~ 10^(count of Digits). <lang pascal> program NdN; //Narcissistic decimal number const
Base = 10; MaxDigits = 16;
type
tDigit = 0..Base-1; tcntDgt= 0..MaxDigits-1;
var
powDgt : array[tDigit] of NativeUint; PotdgtPos: array[tcntDgt] of NativeUint; UpperSum : array[tcntDgt] of NativeUint;
tmpSum, tmpN, actPot : NativeUint;
procedure InitPowDig; var
i,j : NativeUint;
Begin
j := 1; For i := 0 to High(tDigit) do Begin powDgt[i] := i; PotdgtPos[i] := j; j := j*Base; end; actPot := 0;
end;
procedure NextPowDig; var
i,j : NativeUint;
Begin
// Next power of digit = i ^ actPot,always 0 = 0 , 1 = 1 For i := 2 to High(tDigit) do powDgt[i] := powDgt[i]*i; // number of digits times 9 ^(max number of digits) j := powDgt[High(tDigit)]; For i := 0 to High(UpperSum) do UpperSum[i] := (i+1)*j; inc(actPot);
end; procedure OutPutNdN(n:NativeUint); Begin
write(n,' ');
end;
procedure NextDgtSum(dgtPos,i,sumPowDgt,n:NativeUint); begin
//unable to reach sum
IF (sumPowDgt+UpperSum[dgtPos]) < n then
EXIT;
repeat
tmpN := n+PotdgtPos[dgtPos]*i;
tmpSum := sumPowDgt+powDgt[i];
//unable to get smaller
if tmpSum > tmpN then
EXIT;
IF tmpSum = tmpN then
OutPutNdN(tmpSum);
IF dgtPos>0 then
NextDgtSum(dgtPos-1,0,tmpSum,tmpN);
inc(i);
until i >= Base;
end;
var
i : NativeUint;
Begin
InitPowDig;
For i := 1 to 9 do
Begin
write(' length ',actPot+1:2,': ');
//start with 1 in front, else you got i-times 0 in front
NextDgtSum(actPot,1,0,0);
writeln;
NextPowDig;
end;
end.</lang>
- output
time ./NdN length 1: 1 2 3 4 5 6 7 8 9 length 2: length 3: 153 370 370 371 407 length 4: 1634 8208 9474 length 5: 54748 92727 93084 length 6: 548834 length 7: 1741725 4210818 9800817 9926315 length 8: 24678050 24678050 24678051 88593477 length 9: 146511208 472335975 534494836 912985153 real 0m1.000s
Perl
Simple version using a naive predicate. About 15 seconds. <lang perl>sub is_narcissistic {
my $n = shift; my($k,$sum) = (length($n),0); $sum += $_**$k for split(//,$n); $n == $sum;
} my $i = 0; for (1..25) {
$i++ while !is_narcissistic($i); say $i++;
}</lang>
Perl 6
Here is a straightforward, naive implementation. It works but takes ages. <lang perl6>sub is-narcissistic(Int $n) { $n == [+] $n.comb »**» $n.chars }
for 0 .. * {
if .&is-narcissistic {
.say; last if ++state$ >= 25;
}
}</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 153 370 371 407 Ctrl-C
Here the program was interrupted but if you're patient enough you'll see all the 25 numbers.
Here's a faster version that precalculates the values for base 1000 digits: <lang perl6>sub kigits($n) {
my int $i = $n;
my int $b = 1000;
gather while $i {
take $i % $b;
$i = $i div $b;
}
}
constant narcissistic = 0, (1..*).map: -> $d {
my @t = 0..9 X** $d;
my @table = @t X+ @t X+ @t;
sub is-narcissistic(\n) { n == [+] @table[kigits(n)] }
gather take $_ if is-narcissistic($_) for 10**($d-1) ..^ 10**$d;
}
for narcissistic {
say ++state $n, "\t", $_; last if $n == 25;
}</lang>
- Output:
1 0 2 1 3 2 4 3 5 4 6 5 7 6 8 7 9 8 10 9 11 153 12 370 13 371 14 407 15 1634 16 8208 17 9474 18 54748 19 92727 20 93084 21 548834 22 1741725 23 4210818 24 9800817 25 9926315
PicoLisp
<lang PicoLisp>(let (C 25 N 0 L 1)
(loop
(when
(=
N
(sum ** (mapcar format (chop N)) (need L L)) )
(println N)
(dec 'C) )
(inc 'N)
(setq L (length N))
(T (=0 C) 'done) ) )
(bye)</lang>
PL/I
version 1
<lang pli> narn: Proc Options(main);
Dcl (j,k,l,nn,n,sum) Dec Fixed(15)init(0);
Dcl s Char(15) Var;
Dcl p(15) Pic'9' Based(addr(s));
Dcl (ms,msa,ela) Dec Fixed(15);
Dcl tim Char(12);
n=30;
ms=milliseconds();
Do j=0 By 1 Until(nn=n);
s=dec2str(j);
l=length(s);
sum=left(s,1)**l;
Do k=2 To l;
sum=sum+substr(s,k,1)**l;
If sum>j Then Leave;
End;
If sum=j Then Do
nn=nn+1;
msa=milliseconds();
ela=msa-ms;
/*Put Skip Data(ms,msa,ela);*/
ms=msa; /*yyyymmddhhmissmis*/
tim=translate('ij:kl:mn.opq',datetime(),'abcdefghijklmnopq');
Put Edit(nn,' narcissistic:',j,ela,tim)
(Skip,f(9),a,f(12),f(15),x(2),a(12));
End;
End;
dec2str: Proc(x) Returns(char(16) var);
Dcl x Dec Fixed(15);
Dcl ds Pic'(14)z9';
ds=x;
Return(trim(ds));
End;
milliseconds: Proc Returns(Dec Fixed(15));
Dcl c17 Char(17);
dcl 1 * Def C17,
2 * char(8),
2 hh Pic'99',
2 mm Pic'99',
2 ss Pic'99',
2 ms Pic'999';
Dcl result Dec Fixed(15);
c17=datetime();
result=(((hh*60+mm)*60)+ss)*1000+ms;
/*
Put Edit(translate('ij:kl:mn.opq',datetime(),'abcdefghijklmnopq'),
result)
(Skip,a(12),F(15));
*/
Return(result);
End
End;</lang>
- Output:
1 narcissistic: 0 0 16:10:17.586
2 narcissistic: 1 0 16:10:17.586
3 narcissistic: 2 0 16:10:17.586
4 narcissistic: 3 0 16:10:17.586
5 narcissistic: 4 0 16:10:17.586
6 narcissistic: 5 0 16:10:17.586
7 narcissistic: 6 0 16:10:17.586
8 narcissistic: 7 0 16:10:17.586
9 narcissistic: 8 0 16:10:17.586
10 narcissistic: 9 0 16:10:17.586
11 narcissistic: 153 0 16:10:17.586
12 narcissistic: 370 0 16:10:17.586
13 narcissistic: 371 0 16:10:17.586
14 narcissistic: 407 0 16:10:17.586
15 narcissistic: 1634 10 16:10:17.596
16 narcissistic: 8208 30 16:10:17.626
17 narcissistic: 9474 10 16:10:17.636
18 narcissistic: 54748 210 16:10:17.846
19 narcissistic: 92727 170 16:10:18.016
20 narcissistic: 93084 0 16:10:18.016
21 narcissistic: 548834 1630 16:10:19.646
22 narcissistic: 1741725 4633 16:10:24.279
23 narcissistic: 4210818 10515 16:10:34.794
24 narcissistic: 9800817 28578 16:11:03.372
25 narcissistic: 9926315 510 16:11:03.882
26 narcissistic: 24678050 73077 16:12:16.959
27 narcissistic: 24678051 0 16:12:16.959
28 narcissistic: 88593477 365838 16:18:22.797
29 narcissistic: 146511208 276228 16:22:59.025
30 narcissistic: 472335975 1682125 16:51:01.150
version 2
Precompiled powers <lang>*process source xref attributes or(!);
narn3: Proc Options(main);
Dcl (i,j,k,l,nn,n,sum) Dec Fixed(15)init(0);
Dcl s Char(15) Var;
dcl t Char(15);
Dcl p9(15) Pic'9' Based(addr(t));
Dcl (ms,msa,ela) Dec Fixed(15);
Dcl tim Char(12);
n=30;
Dcl power(0:9,1:9) Dec Fixed(15);
Do i=0 To 9;
Do j=1 To 9;
Power(i,j)=i**j;
End;
End;
ms=milliseconds();
Do j=0 By 1 Until(nn=n);
s=dec2str(j);
t=s;
l=length(s);
sum=power(p9(1),l);
Do k=2 To l;
sum=sum+power(p9(k),l);
If sum>j Then Leave;
End;
If sum=j Then Do;
nn=nn+1;
msa=milliseconds();
ela=msa-ms;
ms=msa; /*yyyymmddhhmissmis*/
tim=translate('ij:kl:mn.opq',datetime(),'abcdefghijklmnopq');
Put Edit(nn,' narcissistic:',j,ela,tim)
(Skip,f(9),a,f(12),f(15),x(2),a(12));
End;
End;
dec2str: Proc(x) Returns(char(15) var); Dcl x Dec Fixed(15); Dcl ds Pic'(14)z9'; ds=x; Return(trim(ds)); End;
milliseconds: Proc Returns(Dec Fixed(15));
Dcl c17 Char(17);
dcl 1 * Def C17,
2 * char(8),
2 hh Pic'99',
2 mm Pic'99',
2 ss Pic'99',
2 ms Pic'999';
Dcl result Dec Fixed(15);
c17=datetime();
result=(((hh*60+mm)*60)+ss)*1000+ms;
Return(result);
End;
End;</lang>
- Output:
1 narcissistic: 0 0 00:41:43.632
2 narcissistic: 1 0 00:41:43.632
3 narcissistic: 2 0 00:41:43.632
4 narcissistic: 3 0 00:41:43.632
5 narcissistic: 4 0 00:41:43.632
6 narcissistic: 5 0 00:41:43.632
7 narcissistic: 6 0 00:41:43.632
8 narcissistic: 7 0 00:41:43.632
9 narcissistic: 8 0 00:41:43.632
10 narcissistic: 9 0 00:41:43.632
11 narcissistic: 153 0 00:41:43.632
12 narcissistic: 370 0 00:41:43.632
13 narcissistic: 371 0 00:41:43.632
14 narcissistic: 407 0 00:41:43.632
15 narcissistic: 1634 0 00:41:43.632
16 narcissistic: 8208 20 00:41:43.652
17 narcissistic: 9474 10 00:41:43.662
18 narcissistic: 54748 130 00:41:43.792
19 narcissistic: 92727 120 00:41:43.912
20 narcissistic: 93084 0 00:41:43.912
21 narcissistic: 548834 1310 00:41:45.222
22 narcissistic: 1741725 3642 00:41:48.864
23 narcissistic: 4210818 7488 00:41:56.352
24 narcissistic: 9800817 22789 00:42:19.141
25 narcissistic: 9926315 550 00:42:19.691
26 narcissistic: 24678050 45358 00:43:05.049
27 narcissistic: 24678051 0 00:43:05.049
28 narcissistic: 88593477 237960 00:47:03.009
29 narcissistic: 146511208 199768 00:50:22.777
30 narcissistic: 472335975 1221384 01:10:44.161
PowerShell
<lang PowerShell> function Test-Narcissistic ([int]$Number) {
if ($Number -lt 0) {return $false}
$total = 0 $digits = $Number.ToString().ToCharArray()
foreach ($digit in $digits)
{
$total += [Math]::Pow([Char]::GetNumericValue($digit), $digits.Count)
}
$total -eq $Number
}
[int[]]$narcissisticNumbers = @()
[int]$i = 0
while ($narcissisticNumbers.Count -lt 25) {
if (Test-Narcissistic -Number $i)
{
$narcissisticNumbers += $i
}
$i++
}
$narcissisticNumbers | Format-Wide {"{0,7}" -f $_} -Column 5 -Force </lang>
- Output:
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
Python
This solution pre-computes the powers once.
<lang python>from __future__ import print_function from itertools import count, islice
def narcissists():
for digits in count(0):
digitpowers = [i**digits for i in range(10)]
for n in range(int(10**(digits-1)), 10**digits):
div, digitpsum = n, 0
while div:
div, mod = divmod(div, 10)
digitpsum += digitpowers[mod]
if n == digitpsum:
yield n
for i, n in enumerate(islice(narcissists(), 25), 1):
print(n, end=' ') if i % 5 == 0: print()
print()</lang>
- Output:
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
Faster Version
<lang python>try:
import psyco psyco.full()
except:
pass
class Narcissistics:
def __init__(self, max_len):
self.max_len = max_len
self.power = [0] * 10
self.dsum = [0] * (max_len + 1)
self.count = [0] * 10
self.len = 0
self.ord0 = ord('0')
def check_perm(self, out = [0] * 10):
for i in xrange(10):
out[i] = 0
s = str(self.dsum[0])
for d in s:
c = ord(d) - self.ord0
out[c] += 1
if out[c] > self.count[c]:
return
if len(s) == self.len:
print self.dsum[0],
def narc2(self, pos, d):
if not pos:
self.check_perm()
return
while True:
self.dsum[pos - 1] = self.dsum[pos] + self.power[d]
self.count[d] += 1
self.narc2(pos - 1, d)
self.count[d] -= 1
if d == 0:
break
d -= 1
def show(self, n):
self.len = n
for i in xrange(len(self.power)):
self.power[i] = i ** n
self.dsum[n] = 0
print "length %d:" % n,
self.narc2(n, 9)
print
def main():
narc = Narcissistics(14)
for i in xrange(1, narc.max_len + 1):
narc.show(i)
main()</lang>
- Output:
length 1: 9 8 7 6 5 4 3 2 1 0 length 2: length 3: 407 371 370 153 length 4: 9474 8208 1634 length 5: 93084 92727 54748 length 6: 548834 length 7: 9926315 9800817 4210818 1741725 length 8: 88593477 24678051 24678050 length 9: 912985153 534494836 472335975 146511208 length 10: 4679307774 length 11: 94204591914 82693916578 49388550606 44708635679 42678290603 40028394225 32164049651 32164049650 length 12: length 13: length 14: 28116440335967
Racket
<lang racket>;; OEIS: A005188 defines these as positive numbers, so I will follow that definition in the function
- definitions.
- 0
- assuming it is represented as the single digit 0 (and not an empty string, which is not the
- usual convention for 0 in decimal), is not
- sum(0^0), which is 1. 0^0 is a strange one,
- wolfram alpha calls returns 0^0 as indeterminate -- so I will defer to the brains behind OEIS
- on the definition here, rather than copy what I'm seeing in some of the results here
- lang racket
- Included for the serious efficientcy gains we get from fxvectors vs. general vectors.
- We also use fx+/fx- etc. As it stands, they do a check for fixnumness, for safety.
- We can link them in as "unsafe" operations (see the documentation on racket/fixnum);
- but we get a result from this program quickly enough for my tastes.
(require racket/fixnum)
- uses a precalculated (fx)vector of powers -- caller provided, please.
(define (sub-narcissitic? N powered-digits)
(let loop ((n N) (target N))
(cond
[(fx> 0 target) #f]
[(fx= 0 target) (fx= 0 n)]
[(fx= 0 n) #f]
[else (loop (fxquotient n 10)
(fx- target (fxvector-ref powered-digits (fxremainder n 10))))])))
- Can be used as standalone, since it doesn't require caller to care about things like order of
- magnitude etc. However, it *is* slow, since it regenerates the powered-digits vector every time.
(define (narcissitic? n) ; n is +ve
(define oom+1 (fx+ 1 (order-of-magnitude n))) (define powered-digits (for/fxvector ((i 10)) (expt i oom+1))) (sub-narcissitic? n powered-digits))
- next m primes > z
(define (next-narcissitics z m) ; naming convention following math/number-theory's next-primes
(let-values
([(i l)
(for*/fold ((i (fx+ 1 z)) (l empty))
((oom (in-naturals))
(dgts^oom (in-value (for/fxvector ((i 10)) (expt i (add1 oom)))))
(n (in-range (expt 10 oom) (expt 10 (add1 oom))))
#:when (sub-narcissitic? n dgts^oom)
; everyone else uses ^C to break...
; that's a bit of a manual process, don't you think?
#:final (= (fx+ 1 (length l)) m))
(values (+ i 1) (append l (list n))))])
l)) ; we only want the list
(module+ main
(next-narcissitics 0 25) ; here's another list... depending on whether you believe sloane or wolfram :-) (cons 0 (next-narcissitics 0 25)))
(module+ test
(require rackunit) ; example given at head of task (check-true (narcissitic? 153)) ; rip off the first 12 (and 0, since Armstrong numbers seem to be postivie) from ; http://oeis.org/A005188 for testing (check-equal? (for/list ((i (in-range 12)) (n (sequence-filter narcissitic? (in-naturals 1)))) n) '(1 2 3 4 5 6 7 8 9 153 370 371)) (check-equal? (next-narcissitics 0 12) '(1 2 3 4 5 6 7 8 9 153 370 371)))</lang>
- Output:
(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) (0 1 2 ... 9926315)
Faster Version
This version uses lists of digits, rather than numbers themselves. <lang racket>#lang racket (define (non-decrementing-digital-sequences L)
(define (inr d l)
(cond
[(<= l 0) '(())]
[(= d 9) (list (make-list l d))]
[else (append (map (curry cons d) (inr d (- l 1))) (inr (+ d 1) l))]))
(inr 0 L))
(define (integer->digits-list n)
(let inr ((n n) (l null)) (if (zero? n) l (inr (quotient n 10) (cons (modulo n 10) l)))))
(define (narcissitic-numbers-of-length L)
(define tail-digits (non-decrementing-digital-sequences (sub1 L)))
(define powers-v (for/fxvector #:length 10 ((i 10)) (expt i L)))
(define (powers-sum dgts) (for/sum ((d (in-list dgts))) (fxvector-ref powers-v d)))
(for*/list
((dgt1 (in-range 1 10))
(dgt... (in-list tail-digits))
(sum-dgt^l (in-value (powers-sum (cons dgt1 dgt...))))
(dgts-sum (in-value (integer->digits-list sum-dgt^l)))
#:when (= (car dgts-sum) dgt1)
; only now is it worth sorting the digits
#:when (equal? (sort (cdr dgts-sum) <) dgt...))
sum-dgt^l))
(define (narcissitic-numbers-of-length<= L)
(cons 0 ; special!
(apply append (for/list ((l (in-range 1 (+ L 1)))) (narcissitic-numbers-of-length l)))))
(module+ main
(define all-narcissitics<10000000 (narcissitic-numbers-of-length<= 7)) ; conveniently, this *is* the list of 25... but I'll be a bit pedantic anyway (take all-narcissitics<10000000 25))
(module+ test
(require rackunit)
(check-equal? (non-decrementing-digital-sequences 1) '((0) (1) (2) (3) (4) (5) (6) (7) (8) (9)))
(check-equal?
(non-decrementing-digital-sequences 2)
'((0 0) (0 1) (0 2) (0 3) (0 4) (0 5) (0 6) (0 7) (0 8) (0 9)
(1 1) (1 2) (1 3) (1 4) (1 5) (1 6) (1 7) (1 8) (1 9)
(2 2) (2 3) (2 4) (2 5) (2 6) (2 7) (2 8) (2 9)
(3 3) (3 4) (3 5) (3 6) (3 7) (3 8) (3 9)
(4 4) (4 5) (4 6) (4 7) (4 8) (4 9)
(5 5) (5 6) (5 7) (5 8) (5 9) (6 6) (6 7) (6 8) (6 9)
(7 7) (7 8) (7 9) (8 8) (8 9) (9 9)))
(check-equal? (integer->digits-list 0) null)
(check-equal? (integer->digits-list 7) '(7))
(check-equal? (integer->digits-list 10) '(1 0))
(check-equal? (narcissitic-numbers-of-length 1) '(1 2 3 4 5 6 7 8 9))
(check-equal? (narcissitic-numbers-of-length 2) '())
(check-equal? (narcissitic-numbers-of-length 3) '(153 370 371 407))
(check-equal? (narcissitic-numbers-of-length<= 1) '(0 1 2 3 4 5 6 7 8 9))
(check-equal? (narcissitic-numbers-of-length<= 3) '(0 1 2 3 4 5 6 7 8 9 153 370 371 407)))</lang>
- Output:
'(0 1 2 3 4 5 6 7 8 9 153 370 371 407 1634 8208 9474 54748 93084 92727 548834 1741725 4210818 9800817 9926315)
REXX
idiomatic
<lang rexx>/*REXX program generates and displays a number of narcissistic (Armstrong) numbers. */ numeric digits 39 /*be able to handle largest Armstrong #*/ parse arg N .; if N== | N=="," then N=25 /*obtain the number of narcissistic #'s*/ N=min(N, 89) /*there are only 89 narcissistic #s. */
- =0 /*number of narcissistic numbers so far*/
do j=0 until #==N; L=length(j) /*get length of the J decimal number.*/
$=left(j,1)**L /*1st digit in J raised to the L pow.*/
do k=2 for L-1 until $>j /*perform for each decimal digit in J.*/
$=$ + substr(j, k, 1) ** L /*add digit raised to power to the sum.*/
end /*k*/ /* [↑] calculate the rest of the sum. */
if $\==j then iterate /*does the sum equal to J? No, skip it*/
#=#+1 /*bump count of narcissistic numbers. */
say right(#, 9) ' narcissistic:' j /*display index and narcissistic number*/
end /*j*/ /* [↑] this list starts at 0 (zero).*/
/*stick a fork in it, we're all done. */</lang>
output when using the default input:
1 narcissistic: 0
2 narcissistic: 1
3 narcissistic: 2
4 narcissistic: 3
5 narcissistic: 4
6 narcissistic: 5
7 narcissistic: 6
8 narcissistic: 7
9 narcissistic: 8
10 narcissistic: 9
11 narcissistic: 153
12 narcissistic: 370
13 narcissistic: 371
14 narcissistic: 407
15 narcissistic: 1634
16 narcissistic: 8208
17 narcissistic: 9474
18 narcissistic: 54748
19 narcissistic: 92727
20 narcissistic: 93084
21 narcissistic: 548834
22 narcissistic: 1741725
23 narcissistic: 4210818
24 narcissistic: 9800817
25 narcissistic: 9926315
optimized
This REXX version is optimized to pre-compute all the ten (single) digits raised to all possible powers (there are only 39 possible widths/powers of narcissistic numbers). <lang rexx>/*REXX program generates and displays a number of narcissistic (Armstrong) numbers. */ numeric digits 39 /*be able to handle largest Armstrong #*/ parse arg N .; if N== | N=="," then N=25 /*obtain the number of narcissistic #'s*/ N=min(N, 89) /*there are only 89 narcissistic #s. */
do w=1 for 39 /*generate tables: digits ^ L power. */
do i=0 for 10; @.w.i=i**w /*build table of ten digits ^ L power. */
end /*i*/
end /*w*/ /* [↑] table is a fixed (limited) size*/
- =0 /*number of narcissistic numbers so far*/
do j=0 until #==N; L=length(j) /*get length of the J decimal number.*/
_=left(j, 1) /*select the first decimal digit to sum*/
$=@.L._ /*sum of the J dec. digits ^ L (so far)*/
do k=2 for L-1 until $>j /*perform for each decimal digit in J.*/
_=substr(j, k, 1) /*select the next decimal digit to sum.*/
$=$ + @.L._ /*add dec. digit raised to power to sum*/
end /*k*/ /* [↑] calculate the rest of the sum. */
if $\==j then iterate /*does the sum equal to J? No, skip it*/
#=#+1 /*bump count of narcissistic numbers. */
say right(#, 9) ' narcissistic:' j /*display index and narcissistic number*/
end /*j*/ /* [↑] this list starts at 0 (zero).*/
/*stick a fork in it, we're all done. */</lang>
output is the same as 1st REXX version.
optimized, unrolled
This REXX version is further optimized by unrolling part of the do loop that sums the digits.
The unrolling also necessitated the special handling of one- and two-digit narcissistic numbers. <lang rexx>/*REXX program generates and displays a number of narcissistic (Armstrong) numbers. */ numeric digits 39 /*be able to handle largest Armstrong #*/ parse arg N .; if N== | N=="," then N=25 /*obtain the number of narcissistic #'s*/ N=min(N, 89) /*there are only 89 narcissistic #s. */ @.=0 /*set default for the @ stemmed array. */
- =0 /*number of narcissistic numbers so far*/
do w=0 for 39+1; if w<10 then call tell w /*display the 1st 1─digit dec. numbers.*/
do i=1 for 9; @.w.i=i**w /*build table of ten digits ^ L power. */
end /*i*/
end /*w*/ /* [↑] table is a fixed (limited) size*/
/* [↓] skip the 2─digit dec. numbers. */
do j=100; L=length(j) /*get length of the J decimal number.*/
parse var j _1 2 _2 3 m -1 _R /*get 1st, 2nd, middle, last dec. digit*/
$=@.L._1 + @.L._2 + @.L._R /*sum of the J decimal digs^L (so far).*/
do k=3 for L-3 until $>j /*perform for other decimal digits in J*/
parse var m _ +1 m /*get next dec. dig in J, start at 3rd.*/
$=$ + @.L._ /*add dec. digit raised to pow to sum. */
end /*k*/ /* [↑] calculate the rest of the sum. */
if $==j then call tell j /*does the sum equal to J? Show the #*/
end /*j*/ /* [↑] the J loop list starts at 100*/
exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ tell: #=#+1 /*bump the counter for narcissistic #s.*/
say right(#,9) ' narcissistic:' arg(1) /*display index and narcissistic number*/
if #==N then exit /*stick a fork in it, we're all done. */
return /*return to invoker & keep on truckin'.*/</lang>
output is the same as 1st REXX version.
Ring
<lang ring> n = 0 count = 0 size = 15 while count != size
m = isNarc(n)
if m=1 see "" + n + " is narcisstic" + nl
count = count + 1 ok
n = n + 1
end
func isNarc n
m = len(string(n))
sum = 0
digit = 0
for pos = 1 to m
digit = number(substr(string(n), pos, 1))
sum = sum + pow(digit,m)
next
nr = (sum = n)
return nr
</lang>
Ruby
<lang ruby>class Integer
def narcissistic?
return false if self < 0
len = to_s.size
n = self
sum = 0
while n > 0
n, r = n.divmod(10)
sum += r ** len
end
sum == self
end
end
numbers = [] n = 0 while numbers.size < 25
numbers << n if n.narcissistic? n += 1
end
- or
- numbers = 0.step.lazy.select(&:narcissistic?).first(25) # Ruby ver 2.1
max = numbers.max.to_s.size g = numbers.group_by{|n| n.to_s.size} g.default = [] (1..max).each{|n| puts "length #{n} : #{g[n].join(", ")}"}</lang>
- Output:
length 1 : 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 length 2 : length 3 : 153, 370, 371, 407 length 4 : 1634, 8208, 9474 length 5 : 54748, 92727, 93084 length 6 : 548834 length 7 : 1741725, 4210818, 9800817, 9926315
Scala
<lang Scala>object NDN extends App {
val narc: Int => Int = n => (n.toString map (_.asDigit) map (math.pow(_, n.toString.size)) sum) toInt val isNarc: Int => Boolean = i => i == narc(i)
println((Iterator from 0 filter isNarc take 25 toList) mkString(" "))
}</lang>
Output:
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
Sidef
<lang ruby>func is_narcissistic(n) {
n.digits »**» n.len -> sum(0) == n
}
var count = 0 for i in (0..^Inf) {
if (is_narcissistic(i)) {
say "#{++count}\t#{i}"
break if (count == 25)
}
}</lang>
- Output:
1 0 2 1 3 2 4 3 5 4 6 5 7 6 8 7 9 8 10 9 11 153 12 370 13 371 14 407 15 1634 16 8208 17 9474 18 54748 19 92727 20 93084 21 548834 22 1741725 23 4210818 24 9800817 25 9926315
Tcl
<lang tcl>proc isNarcissistic {n} {
set m [string length $n]
for {set t 0; set N $n} {$N} {set N [expr {$N / 10}]} {
incr t [expr {($N%10) ** $m}]
}
return [expr {$n == $t}]
}
proc firstNarcissists {target} {
for {set n 0; set count 0} {$count < $target} {incr n} {
if {[isNarcissistic $n]} { incr count lappend narcissists $n }
} return $narcissists
}
puts [join [firstNarcissists 25] ","]</lang>
- Output:
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
UNIX Shell
<lang bash>function narcissistic {
integer n=$1 len=${#n} sum=0 i
for ((i=0; i<len; i++)); do
(( sum += pow(${n:i:1}, len) ))
done
(( sum == n ))
}
nums=() for ((n=0; ${#nums[@]} < 25; n++)); do
narcissistic $n && nums+=($n)
done echo "${nums[*]}" echo "elapsed: $SECONDS"</lang>
- Output:
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
VBScript
<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)</lang>
- Output:
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,
zkl
<lang zkl>fcn isNarcissistic(n){
ns,m := n.split(), ns.len() - 1;
ns.reduce('wrap(s,d){ z:=d; do(m){z*=d} s+z },0) == n
}</lang> Pre computing the first 15 powers of 0..9 for use as a look up table speeds things up quite a bit but performance is pretty underwhelming. <lang zkl>var [const] powers=(10).pump(List,'wrap(n){
(1).pump(15,List,'wrap(p){ n.toFloat().pow(p).toInt() }) });
fcn isNarcissistic2(n){
m:=(n.numDigits - 1);
n.split().reduce('wrap(s,d){ s + powers[d][m] },0) == n
}</lang> Now stick a filter on a infinite lazy sequence (ie iterator) to create an infinite sequence of narcissistic numbers (iterator.filter(n,f) --> n results of f(i).toBool()==True). <lang zkl>ns:=[0..].filter.fp1(isNarcissistic); ns(15).println(); ns(5).println(); ns(5).println();</lang>
- Output:
L(0,1,2,3,4,5,6,7,8,9,153,370,371,407,1634) L(8208,9474,54748,92727,93084) L(548834,1741725,4210818,9800817,9926315)
- Programming Tasks
- Solutions by Programming Task
- Ada
- Agena
- ALGOL 68
- AppleScript
- AutoHotkey
- AWK
- C
- C++
- C sharp
- Common Lisp
- D
- Elixir
- ERRE
- F Sharp
- FreeBASIC
- FunL
- Go
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Jq
- Julia
- Kotlin
- Lua
- Mathematica
- MATLAB
- Oforth
- PARI/GP
- Pascal
- Perl
- Perl 6
- PicoLisp
- PL/I
- PowerShell
- Python
- Racket
- REXX
- Ring
- Ruby
- Scala
- Sidef
- Tcl
- UNIX Shell
- VBScript
- Zkl