Narcissistic loop lengths

Question

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 code-golf 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.

Answer 1

Haskell, 85 bytes

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 ]

Answer 2

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.

Answer 3

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!

Answer 4

Raku, 67 65 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.

Answer 5

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!

Answer 6

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  

Answer 7

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
    }
}

Answer 8

Wolfram Language (Mathematica), 70 59 bytes

Gather@NestList[Tr[#^#2&@@RealDigits@#]&,#,#]~Count~{_,__}&

Try it online!

-11 bytes from @att

Answer 9

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.

Answer 10

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

Answer 11

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

Answer 12

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

Answer 13

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!

Answer 14

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

Answer 15

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

Answer 16

APL (dzaima/APL), ³⁰ 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

Answer 17

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!

Answer 18

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!

Answer 19

Scala, 117 bytes

Port of Wheat Wizard's Haskell answer.

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]())(_:+_).

Answer 20

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

Answer 21

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.

Answer 22

K (Kona), 42 bytes

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

Try it online!

Answer 23

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
     Ɗ    - Group the previous 3 links into a monad f(n):
D         -   Convert n to digits, D
   $      -   Group the previous 2 links into a monad g(D):
  L       -     Get the length of D
 *        -     Raise each digit to the power of that length
    S     -   Sum
      ÐḶ  - Repeatedly apply f(n) until a value is repeated. Then, apply f(n)
            to that value until it loops, and return the loop formed
        L - Take the length of the loop