# Narcissistic loop lengths

A narcissistic number is a natural number which is equal to the sum of its digits when each digit is taken to the power of the number digits. For example $$\8208 = 8^4 + 2^4 + 0^4 + 8^4\$$, so is narcissistic.

We'll define a function $$\f(x)\$$ as the following, for a natural number $$\x = d_1d_2\dots d_n\$$, where $$\d_i\$$ is a single digit $$\0\$$ to $$\9\$$ (therefore $$\x\$$ has $$\n\$$ digits):

$$f(x) = \sum_{i=1}^nd_i^n$$

In this case, a number is narcissistic if $$\f(x) = x\$$.

However, when we apply $$\f(x)\$$ to a number repeatedly, we find an interesting pattern emerges. For any given $$\x\$$, the sequence either reaches a fixed point (i.e. a narcissistic number), or enters a fixed loop which repeats infinitely. For examples, take the three integers $$\x = 104, 127, 370\$$:

• $$\x = 104\$$: Repeated application of $$\f(x)\$$ leads to the following chain

$$104, 65, 61, 37, 58, 89, 145, 190, 730, 370, 370, ...$$

Here, the loop eventually reaches a fixed point, $$\370\$$.

• $$\x = 127\$$: Repeated application of $$\f(x)\$$ leads to

$$127, 352, 160, 217, 352, 160, 217, ...$$

Here, the triple $$\352, 160, 217\$$ repeats ad infinitum

• $$\x = 370\$$: $$\x\$$ here is already narcissistic, so the chain will just be an endless stream of $$\370\$$s.

These examples document the two possible outcomes for a given $$\x\$$. By treating a fixed point as a loop of length $$\1\$$, we now arrive at the task at hand:

Given a natural number $$\n > 0\$$, output the length of the loop that arises through repeated application of $$\f(n)\$$.

The above three examples return $$\1\$$, $$\3\$$ and $$\1\$$ respectively. You can assume that all $$\n\$$ eventually enter a loop, which appears to be the case for at least all $$\n < 10^4\$$. If there exists an $$\n\$$ for which this is false, your program may do anything short of summoning Cthulhu.

This is so the shortest code in bytes wins.

The vast majority of numbers return $$\1\$$. However, these two arrays contain all $$\n < 1000\$$ which don't, along with what their outputs should be:

[ 59,  95, 106, 115, 127, 136, 138, 147, 149, 151, 157, 159, 160, 163, 168, 169, 172, 174, 175, 177, 178, 179, 183, 186, 187, 189, 194, 195, 196, 197, 198, 199, 217, 228, 229, 235, 238, 244, 245, 253, 254, 255, 258, 259, 267, 268, 271, 276, 277, 279, 282, 283, 285, 286, 289, 292, 295, 297, 298, 299, 309, 316, 318, 325, 328, 335, 352, 353, 355, 357, 358, 361, 366, 367, 369, 375, 376, 381, 382, 385, 388, 389, 390, 396, 398, 405, 408, 417, 419, 424, 425, 442, 445, 447, 450, 452, 454, 456, 457, 459, 465, 466, 468, 469, 471, 474, 475, 477, 478, 479, 480, 486, 487, 488, 491, 495, 496, 497, 499, 504, 507, 508, 511, 517, 519, 523, 524, 525, 528, 529, 532, 533, 535, 537, 538, 540, 542, 544, 546, 547, 549, 552, 553, 555, 556, 558, 559, 564, 565, 567, 568, 570, 571, 573, 574, 576, 580, 582, 583, 585, 586, 589, 591, 592, 594, 595, 598, 601, 607, 609, 610, 613, 618, 619, 627, 628, 631, 636, 637, 639, 645, 646, 648, 649, 654, 655, 657, 658, 663, 664, 666, 669, 670, 672, 673, 675, 678, 679, 681, 682, 684, 685, 687, 689, 690, 691, 693, 694, 696, 697, 698, 699, 705, 706, 708, 712, 714, 715, 717, 718, 719, 721, 726, 727, 729, 735, 736, 741, 744, 745, 747, 748, 749, 750, 751, 753, 754, 756, 760, 762, 763, 765, 768, 769, 771, 772, 774, 777, 778, 779, 780, 781, 784, 786, 787, 788, 791, 792, 794, 796, 797, 799, 804, 805, 807, 813, 816, 817, 819, 822, 823, 825, 826, 829, 831, 832, 835, 838, 839, 840, 846, 847, 848, 850, 852, 853, 855, 856, 859, 861, 862, 864, 865, 867, 869, 870, 871, 874, 876, 877, 878, 883, 884, 887, 891, 892, 893, 895, 896, 900, 903, 906, 914, 915, 916, 917, 918, 919, 922, 925, 927, 928, 929, 930, 936, 938, 941, 945, 946, 947, 949, 951, 952, 954, 955, 958, 960, 961, 963, 964, 966, 967, 968, 969, 971, 972, 974, 976, 977, 979, 981, 982, 983, 985, 986, 991, 992, 994, 996, 997, 999]
[  3,   3,   3,   3,   3,   2,  10,  14,  10,   3,  10,  14,   3,   2,  14,  10,   3,  14,  10,   2,  10,   2,  10,  14,  10,  10,  10,  14,  10,   2,  10,  10,   3,  10,   3,   3,   3,   2,   2,   3,   2,  10,  10,  10,  14,  10,   3,  14,  10,  14,  10,   3,  10,  10,  10,   3,  10,  14,  10,  10,  14,   2,  10,   3,   3,   2,   3,   2,  10,  10,  10,   2,  10,  10,  14,  10,  10,  10,   3,  10,  14,   6,  14,  14,   6,  10,  14,  14,  10,   2,   2,   2,   3,  14,  10,   2,   3,  10,   3,  10,  10,  10,  14,  10,  14,  14,   3,  14,  10,  10,  14,  14,  10,  10,  10,  10,  10,  10,  10,  10,  14,  10,   3,  10,  14,   3,   2,  10,  10,  10,   3,   2,  10,  10,  10,  10,   2,   3,  10,   3,  10,  10,  10,  10,  10,  14,   3,  10,  10,  14,  10,  14,  10,  10,   3,  14,  10,  10,  10,  14,  10,  10,  14,  10,  10,   3,  10,   3,   3,  10,   3,   2,  14,  10,  14,  10,   2,  10,  10,  14,  10,  10,  14,  10,  10,  10,  14,  10,  10,  10,  14,  10,   3,  14,  10,  14,   2,  10,  14,  10,  14,  10,   2,   6,  10,  10,  14,  10,  10,  10,   6,   2,  14,   3,  14,   3,  14,  10,   2,  10,   2,   3,  14,  10,  14,  10,  10,  14,  14,   3,  14,  10,  10,  14,  10,  10,   3,  14,   3,  14,  10,  14,   2,  10,   2,  10,  14,   6,  14,  14,  14,  10,  10,   2,  14,  14,   2,  14,  10,  10,  14,   3,  14,  10,  14,  10,  14,  10,  10,  10,   3,  10,  10,  10,  10,   3,  10,  14,   6,  14,  14,  10,  10,  10,  10,  10,  14,  10,  10,  14,  10,  14,  10,   2,   6,  14,  10,  10,   2,  14,  14,  14,  10,  14,  10,  10,   6,  10,   6,  14,  14,  10,  10,  14,  10,   2,  10,  10,   3,  10,  14,  10,  10,  14,  14,   6,  10,  10,  10,  10,  10,  14,  10,  10,   3,  10,  10,  10,  14,  10,  10,  10,   6,   2,   2,  14,  10,  10,  14,   3,  10,  10,   6,  10,   6,  10,  10,  10,   2,   3,  2]


Furthermore, this is a program which takes an integer $$\n\$$ and, for each integer $$\1 \le i \le n\$$, generates it's output and the loop that arises.

This is a question over on Math.SE about whether the output ever exceeds $$\14\$$, and if each natural number will eventually go into a loop or not.

• Sandbox. Please don't hesitate to ask for any clarifications. Nov 6 '20 at 16:56
• VTC as unclear. Whether a program does or does not summon Cthulu is not an observable requirement. :) Nov 6 '20 at 21:50
• $25900620690429003568654$ has a length of $18$. Nov 6 '20 at 22:14
• @WheatWizard “You may not use any builtins that summon Cthulhu, but if those builtins exist in your language, you may deduct 10 bytes” Nov 7 '20 at 1:17
• @JanDorniak I’m going to have to say no to nasal demons, but I’m reasonable, so devils flying out of your ears is acceptable Nov 7 '20 at 23:00

l=length
k?x|elem x k=l$x:takeWhile(/=x)k|q<-show x=(x:k)?sum[read[k]^l q|k<-q] ([]?)  Try it online! This is frustratingly long for Haskell. We have one main function here. It keeps track of a list k of numbers we already visited, appending new numbers to the front. Once we reach a number x which is on our list we return one more than the largest prefix not containing x. k ? x | elem x k = length (x : takeWhile (/=x) k) | otherwise = (x : k) ? sum [ read [x] ^ length (show x) | k <- show x ]  # Python 3, 107 $$\\cdots\$$ 90 84 bytes Saved a byte thanks to Arnauld!!! f=lambda n,l=[]:n in l and-~l.index(n)or f(str(sum(int(d)**len(n)for d in n)),[n]+l)  Try it online! Expects input as a string. • You can save a byte with return~-len(l)-l.index(n). Nov 6 '20 at 20:37 • @Arnauld Nice one - thanks! :-) Nov 6 '20 at 20:43 # Jelly, 12 bytes I wonder if this is the same as caird's answer (it probably isn't, because the control flow here almost certainly can be simplified by anyone who actually knows Jelly, or perhaps even by a good lossless compression utility). This may also be wrong. D*L$S
ÇÐLÇƬL


Try it online!

• It's very similar to mine Nov 6 '20 at 17:45
• Could you add an explanation, please? Nov 6 '20 at 23:11
• If we had something vectorizable to replace L with, you could (probably?) take the € out of this 12-byter Nov 7 '20 at 0:15
• unfortunately, Ẉ (which I didn't actually know existed) seems to just be equivalent to L€ Nov 7 '20 at 0:26

# Raku, 6765 64 bytes

{{$_-1-.first(:k,.tail)}($_,{sum .comb X**.chars}...{%\{$_}++})}  Try it online! • $_, { ... } ... { ... } generates the sequence of numbers, starting with $_, the argument to the outer function. The first braces enclose the function that generates successive elements, and the second braces enclose the function that indicates when to stop. • sum .comb X** .chars produces the next number from the preceding one. The comb method with no arguments splits strings/numbers into their characters/digits. The chars method returns the number of characters/digits in a string/number. The list of digits is cross-exponentiated with the number of digits by the X** operator, then summed. • The ending condition uses an anonymous state hash variable %, which stores the number of times each element has been seen so far. The iteration stops when the current number has been seen for a second time. • That sequence is fed into an inner anonymous function, which is called immediately. (This is a bit shorter than storing the sequence into a variable.) Just like the outer function, this inner function accepts its argument in the $_ variable.
• .first(:k, .tail) finds the index (thanks to the :k adverb) of the first element of the sequence which is equal to the final element, returned by .tail.
• $_ - 1 - .first(...) is the length of the sequence, minus one, minus the first index of the single repeated element, giving the length of the final cycle. • 57 bytes – Jo King Nov 8 '20 at 1:17 # Wolfram Language (Mathematica), 78 73 bytes -5 thanks to J42161217. His answer is better, so check that out too. #[]//.a_@e___/;a!=e:>a~Tr[#^#2&@@RealDigits@a]~e/.a_@e__:>{e}~Position~a&  Try it online! • 73 bytes Nov 7 '20 at 2:06 # Husk, 12 bytes LUṠ-U¡λṁ^L¹d  Try it online! Found a better way to do it by removing the longest unique prefix from the infinite list, and taking the longest unique prefix of that. # Husk, 14 bytes ▼mLUmUṫ¡λṁ^L¹d  Try it online! Basically, we make an infinite list of infinite lists in order to find which one contains the required cycle. Then we take the length of the cycle. ## Explanation ▼mLUmUṫ¡λṁ^L¹d ¡λ apply the following to get an infinite list d take the digits ^L¹ the the power of their length ṁ sum them ṫ get the postfixes of the list mU get the logest unique prefix of each postfix U get the longest unique prefix of that mL Map each cycle to it's lenght ▼ take the minimum  # C (gcc), 202 ... 149 bytes f(l){long a[16]={},i,k=l,n;for(;i=k;a[n++&15]=k){for(l=0;k;k/=10)l++;for(;i;i/=10)k+=__builtin_powi(i%10,l);for(l=16;l--;)if(a[l]==k)return n-l&15;}}  Try it online! ## Explained f(l) { long a[16] = {}, // Circular buffer of recently seen values i, // Current value, will be initialized to l, // l will become number of digits in i, // and will later be used as a loop counter k = l, // Will become f(i) n; // Current index into the circular buffer for (; i = k; // Loop forever, let i = f(i) a[n++ & 15] = k) { // Store f(i) in the buffer for (l = 0; k; k /= 10) // Set length to zero, loop over all digits in k (which is equal to i) l++; // Increment l for each digit // k is zero after this loop for (; i; i /= 10) // Loop over all digits again k += __builtin_powi(i % 10, l); // Add pow(digit, length) to k for (l = 16; l--;) // Check all the values in the buffer if (a[l] == k) // If k matches a value in the buffer return n - l & 15; // Return the distance between k and the match in the buffer } }  # Wolfram Language (Mathematica), 70 59 bytes Gather@NestList[Tr[#^#2&@@RealDigits@#]&,#,#]~Count~{_,__}&  Try it online! -11 bytes from @att • 59 bytes – att Nov 7 '20 at 4:32 # Charcoal, 27 bytes ＮθＷ¬№υθ«⊞υθ≔ΣＸ↨θχＬθθ»Ｉ⊕⌕⮌υθ  Try it online! Link is to verbose version of code. Explanation: Ｎθ  Input n. Ｗ¬№υθ«  Repeat until a loop is detected. ⊞υθ  Save the previous value. ≔ΣＸ↨θχＬθθ  Compute the next value. »Ｉ⊕⌕⮌υθ  Output the number of terms in the loop. # JavaScript (ES7), 72 bytes Expects the input number as a string. n=>(g=i=>i-g[[...n].map(d=>t+=d**n.length,t=0)|t]||g(-~i,g[n=t+'']=i))  Try it online! ### Commented n => ( // n = input number as a string g = i => // g is a recursive function taking a counter i i - // subtract from i g[ // lookup in g: [...n].map(d => // for each digit d in n: t += // add to t: d ** n.length, // d raised to the power of the length of n t = 0 // starting with t = 0 ) | t // end of map(); yield t ] // end of lookup in g || // if the above result is NaN, g( // do a recursive call: -~i, // pass i + 1 g[n = t + ''] = i // copy t to n, coerced back to a string // and set this entry to i in g ) // end of recursive call ) // initial call to g with i zero'ish  # Brachylog, 27 bytes {tgjlᵗgᵗz^ᵐ+}ᵃ↖N{¬≠&}↔a↰₄bl  Try it online! {tgjlᵗgᵗz^ᵐ+}ᵃ↖N{¬≠&}↔a↰₄bl { }ᵃ↖N repeat the predicate N times and accumulate results tg last result as list [x] jlᵗgᵗ [x, [len(x)]] z^ᵐ each digit ^ length + sum {¬≠&} must have duplicates (not all are different) ↔a reverse and take prefixes (shortest first) ↰₄ that must have duplicates bl length - 1  # MATL, 19 bytes XIvIFYAtn^syy-]=Pf  Try it online! Or plot the sequence from 50 to 170 (it takes about 30 seconds). ### Explanation  % Do...while XI % Copy into clipboard I. This implicitly takes input the first time v % Concatenate stack contents vertically. This attaches the newly computed % term onto the sequence. The first time it does nothing I % Paste from clipboard I. This pushes the last computed term FYA % Convert number to vector of decimal digits tn^s % Duplicate, number of elements, element-wise power, sum. This computes a % new term to extend the sequence yy % Duplicate top two elements in the stack: sequence so far and new term - % Element-wise difference. This is truthy if all values are nonzero ] % End. A new iteration is run if top of the stack is truthy = % (The stack contains the computed sequence and a new term that has been % found to appears in that sequence) Element-wise equality comparison P % Reverse f % index of true value. Implicitly display  # Jelly, 11 bytes D*L$SƊƬ⁺€ṪL


Try it online!

D              Take the decimal digits
*             to the power of
L            the length of
$the list of decimal digits S and sum them. Ɗ For all that, Ƭ iterate until a loop is reached collecting all intermediate results, € then for each of the collected results ⁺ iterate again starting from there, Ṫ take the results from the last result, L and get the length of that.  Can be even shorter if we take input as a digit list: # Jelly, 10 bytes *LSDƲƬ⁺€ṪL  Try it online! # Jelly, 11 bytes Turns out I got the same as Unrelated String. D*L$SƊƬ⁺€ṪL


A monadic Link accepting a positive integer which yields a positive integer.

Try it online!

### How?

D*L$SƊƬ⁺€ṪL - Link: n Ƭ - collect while distinct: Ɗ - last three links as a monad: D - digits$        -     last two links as a monad:
L         -       length
*          -       exponentiate
S       -     sum
€   - for each:
⁺    -   repeat the last link (the collect-while-distinct, above)
Ṫ  - tail (this will be a single loop)
L - length


# 05AB1E, 15 bytes

Δ¤SDgmO©ªÙ}R®k>


Try it online!

Takes input as a singleton list containing the integer.

A different approach that comes in at 16 bytes:

λSDgmO}ηíεćk}Ù¥н


Try it online!

Commented:

Δ¤SDgmO©ªÙ}R®k>   # implicit input: [x]
Δ         }       # run until the output does not change:
¤                #   take the last integer from the list
S               #   split into digits
D              #   duplicate
g             #   take the length of the copy
m            #   take each digit to the power of the length
O           #   sum all powers
©          #   store this value in the register
ª         #   and append it to the list
Ù        #   uniquify the list
#   the loop only stops if Ù removed the new element,
#   which only happens if it was in the list already
R      # reverse the (unique) list
®     # take the last computed value
k    # find the 0-based index in the list
>   # and increment it

λSDgmO}ηíεćk}Ù¥н  # implicit input: x
λ     }           # recursively apply the code to the input
#   to generate an infinite list
SDgmO            # same as above
η          # take the prefixes
í         # reverse each prefix
ε  }     # map over the reversed prefixed
ć       #   extract the first element
k      #   find its index in the remaining prefix
#   this returns -1 if the prefix was unique
# this results in [-1, ..., -1, res-1, res-1, ...]
Ù    # uniquify => [-1, res-1]
# while this list is finite, 05ab1e does not know this
¥   # take the differences => [(res-1) - (-1)] = [res]
н  # take the first element => res


# APL (dzaima/APL), 30 29 bytes

{1⊃⍸⌽(⊢/=⊢){+/(⊢*≢)10⊤⍵}⍡⍵⊢⍵}


Try it online!

-1 byte using ⎕IO←0.

Since the length of the cycle never exceeds $$\n\$$, we can loop n times instead of finding a fixed point, then calculate the length of the cycle.

## Explanation

{⊃⍸1↓⌽(⊢/=⊢){+/(⊢*≢)10⊤⍵}⍡⍵⊢⍵}
⊢⍵  input integer n
{          }⍡⍵    apply the following n times, collecting intermediate results:
10⊤⍵       get base 10 digits
(⊢*≢)          raise to the power of length
+/                and sum
(⊢/=⊢)                  bit mask of the locations of the last element
1↓⌽                        reverse and remove first 1
⊃⍸                           first index of the last element


# Icon, 99 bytes

procedure f(n)
t:=table()
i:=1
until\t[n]do{t[n]:=i
(s:=0)+:=!n^*n&\z
n:=s
i+:=1}
return i-t[n]
end


Try it online!

# Red, 125 bytes

func[n][m: copy #()i: 1	while[not m/:n][put m n i i: i + 1 s: 0
foreach d k: to""n[s:(-48 + d)**(length? k)+ s]n: s]i - m/:n]


Try it online!

# Scala, 117 bytes

def>(n:Any,k:Seq[_]=Nil):Any=if(k toSet n)1+k.indexOf(n)else>(s"$n".map(d=>math.pow(d-48,s"$n".size).toInt).sum,n+:k)


Try it online!

# Scala, 160 bytes

Stream.iterate(_){n=>s"$n".map(d=>math.pow(d-48,s"$n".size).toInt).sum}.scanLeft(Seq[Int]())(_:+_).flatMap(_.tails).find(l=>l.size>1&&l.head==l.last).get.size-1


Try it online!

A ridiculously long solution, made worse by the fact that Scala doesn't have ** like Python and other languages do, and inits returns the biggest inits first, so we have to use scanLeft(Seq[Int]())(_:+_).

# R, 84 bytes

x=scan();while(!(y=match(x,F,0))){F=c(x,F);x=sum((x%/%10^((z=nchar(x)):0)%%10)^z)};y


Try it online!

Commented:

x=scan();                               # get input as x
# F is vector that holds values of f(x) so far
# (initialized by default as zero)
while(!(y=match(x,F,0))){               # if x is present in F, get its matching index as y,
# otherwise set y to zero.
# While !y (x not present in F yet):
F=c(x,F);                              # prepend F with x
x=sum((x%/%10^((z=nchar(x)):0)%%10)^z) # update x as f(x):
# sum of decimal digits to the power of # digits
};
y                                       # We exit the while loop when F contains x;
# at this point, y gives the index, which is the
# loop length


# J, 40 bytes

-5 by FrownyFrog!

0(i.~~:@|.)(,*/@~:$1#.&(^#)10#.inv{:)^:_  Try it online! ### J, 45 bytes [:#.~[:~:&.|.(,1#.&(^#)10#.inv{:)^:(*/@~:)^:_  Try it online! • …^:_ until result does not change: • …^:(*/@~:) if there is no duplicate in the list: • 10#.inv{: digits of the last number … • 1#.&(^#) powered by their length, summed • , appended to the list. • [:~:&.|. reverse list, get a bitmask of first occurrences in it, reverse back. So 1 2 3 2 3 -> 3 2 3 2 1 -> 1 1 0 0 1 -> 1 0 0 1 1. • [:#.~ count the trailing 1s with mixed base conversion. • 0(i.~~:@|.)(,*/@~:$1#.&(^#)10#.inv{:)^:_ Nov 24 '20 at 4:10
• @FrownyFrog 0(i.~~:@|.) is a really nice one, thanks!
– xash
Nov 24 '20 at 12:54

# K (Kona), 42 bytes

--/&{x=*|x}{x~?x}{x,_+/{x^'#x}10_vs*|x}/,:


Try it online!

# Jelly, 9 bytes

D*L$SƊÐḶL  Try it online! I always wondered why ÐḶ and ÐĿ both existed until this answer made the exact functionality of ÐḶ clear. ## How it works D*L$SƊÐḶL - Main link. Takes an integer n on the left