Longitudes de bucle narcisista
Un número narcisista es un número natural que es igual a la suma de sus dígitos cuando cada dígito se eleva a la potencia de los dígitos del número. Por ejemplo \$8208 = 8^4 + 2^4 + 0^4 + 8^4\$, también es narcisista.
Definiremos una función \$f(x)\$como el siguiente, para un número natural \$x = d_1d_2\dots d_n\$, donde \$d_i\$es un solo dígito \$0\$a \$9\$(por lo tanto \$x\$tiene \$n\$ dígitos):
$$f(x) = \sum_{i=1}^nd_i^n$$
En este caso, un número es narcisista si \$f(x) = x\$.
Sin embargo, cuando aplicamos \$f(x)\$a un número repetidamente, encontramos que surge un patrón interesante. Para cualquier \$x\$, la secuencia alcanza un punto fijo (es decir, un número narcisista) o entra en un bucle fijo que se repite infinitamente. Por ejemplo, tome los tres enteros \$x = 104, 127, 370\$:
\$x = 104\$: Aplicación repetida de \$f(x)\$ conduce a la siguiente cadena
$$104, 65, 61, 37, 58, 89, 145, 190, 730, 370, 370, ...$$
Aquí, el bucle finalmente alcanza un punto fijo, \$370\$.
\$x = 127\$: Aplicación repetida de \$f(x)\$ lleva a
$$127, 352, 160, 217, 352, 160, 217, ...$$
Aquí, el triple \$352, 160, 217\$ repite ad infinitum
\$x = 370\$: \$x\$aquí ya es narcisista, por lo que la cadena será un flujo interminable de \$370\$s.
Estos ejemplos documentan los dos posibles resultados para un \$x\$. Al tratar un punto fijo como un bucle de longitud \$1\$, llegamos ahora a la tarea en cuestión:
Dado un número natural \$n > 0\$, muestra la longitud del bucle que surge mediante la aplicación repetida de \$f(n)\$.
Los tres ejemplos anteriores devuelven \$1\$, \$3\$y \$1\$respectivamente. Puedes asumir que todos \$n\$eventualmente ingrese en un bucle, que parece ser el caso para al menos todos \$n < 10^4\$. Si existe un \$n\$para lo cual esto es falso, su programa puede hacer cualquier cosa menos convocar a Cthulhu .
Esto es código de golf, por lo que gana el código más corto en bytes.
La gran mayoría de los números regresan \$1\$. Sin embargo, estas dos matrices contienen todos \$n < 1000\$ que no, junto con cuáles deberían ser sus resultados:
[ 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]
Además, este es un programa que toma un entero \$n\$y, para cada entero \$1 \le i \le n\$, genera su salida y el bucle que surge.
Esta es una pregunta sobre Math.SE sobre si la salida alguna vez excede \$14\$, y si cada número natural eventualmente entrará en un bucle o no.
Respuestas
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]
([]?)
¡Pruébelo en línea!
Esto es frustrantemente largo para Haskell. Tenemos una función principal aquí. Realiza un seguimiento de una lista kde números que ya visitamos y agrega nuevos números al frente. Una vez que llegamos a un número xque está en nuestra lista, devolvemos uno más que el prefijo más grande que no contiene 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
Guardado un byte gracias a 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)
¡Pruébelo en línea!
Espera entrada como una cadena.
Gelatina , 12 bytes
Me pregunto si esto es lo mismo que la respuesta de Caird (probablemente no lo sea, porque el flujo de control aquí casi con certeza puede ser simplificado por cualquiera que realmente conozca Jelly, o tal vez incluso por una buena utilidad de compresión sin pérdidas). Esto también puede estar mal.
D*L$S
ÇÐLÇƬL
¡Pruébelo en línea!
Raku , 67 65 64 bytes
{{$_-1-.first(:k,.tail)}($_,{sum .comb X**.chars}...{%\{$_}++})}
¡Pruébelo en línea!
$_, { ... } ... { ... }genera la secuencia de números, comenzando con$_, el argumento de la función externa. Las primeras llaves encierran la función que genera los elementos sucesivos y las segundas llaves encierran la función que indica cuándo detenerse.sum .comb X** .charsproduce el siguiente número del anterior. Elcombmétodo sin argumentos divide cadenas / números en sus caracteres / dígitos. Elcharsmétodo devuelve el número de caracteres / dígitos en una cadena / número. La lista de dígitos se multiplica por exponentes con el número de dígitos delX**operador y luego se suma.- La condición final utiliza una variable hash de estado anónima
%, que almacena el número de veces que se ha visto cada elemento hasta el momento. La iteración se detiene cuando se ve el número actual por segunda vez. - Esa secuencia se alimenta a una función anónima interna, que se llama de inmediato. (Esto es un poco más corto que almacenar la secuencia en una variable). Al igual que la función externa, esta función interna acepta su argumento en la
$_variable. .first(:k, .tail)encuentra el índice (gracias al:kadverbio) del primer elemento de la secuencia que es igual al elemento final, devuelto por.tail.$_ - 1 - .first(...)es la longitud de la secuencia, menos uno, menos el primer índice del único elemento repetido, lo que da la longitud del ciclo final.
Wolfram Language (Mathematica) , 78 73 bytes
-5 gracias a J42161217. Su respuesta es mejor, así que compruébalo también.
#[]//.a_@e___/;a!=e:>a~Tr[#^#2&@@RealDigits@a]~e/.a_@e__:>{e}~Position~a&
¡Pruébelo en línea!
Cáscara , 12 bytes
LUṠ-U¡λṁ^L¹d
¡Pruébelo en línea!
Encontré una mejor manera de hacerlo eliminando el prefijo único más largo de la lista infinita y tomando el prefijo único más largo de ese.
Cáscara , 14 bytes
▼mLUmUṫ¡λṁ^L¹d
¡Pruébelo en línea!
Básicamente, hacemos una lista infinita de listas infinitas para encontrar cuál contiene el ciclo requerido. Luego tomamos la duración del ciclo.
Explicación
▼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;}}
¡Pruébelo en línea!
Explicado
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~{_,__}&
¡Pruébelo en línea!
-11 bytes de @att
Carbón , 27 bytes
ＮθＷ¬№υθ«⊞υθ≔ΣＸ↨θχＬθθ»Ｉ⊕⌕⮌υθ
¡Pruébelo en línea! El enlace corresponde a la versión detallada del código. Explicación:
Ｎθ
Entrada n.
Ｗ¬№υθ«
Repita hasta que se detecte un bucle.
⊞υθ
Guarda el valor anterior.
≔ΣＸ↨θχＬθθ
Calcule el siguiente valor.
»Ｉ⊕⌕⮌υθ
Muestra el número de términos en el ciclo.
JavaScript (ES7), 72 bytes
Espera el número de entrada como una cadena.
n=>(g=i=>i-g[[...n].map(d=>t+=d**n.length,t=0)|t]||g(-~i,g[n=t+'']=i))``
¡Pruébelo en línea!
Comentado
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
¡Pruébelo en línea!
{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
¡Pruébelo en línea! O trace la secuencia de 50a 170(tarda unos 30 segundos).
Explicación
` % 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
Gelatina , 11 bytes
D*L$SƊƬ⁺€ṪL
¡Pruébelo en línea!
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.
Puede ser incluso más corto si tomamos la entrada como una lista de dígitos:
Gelatina , 10 bytes
*LSDƲƬ⁺€ṪL
¡Pruébelo en línea!
Gelatina , 11 bytes
Resulta que obtuve lo mismo que Cadena no relacionada .
D*L$SƊƬ⁺€ṪL
Un enlace monádico que acepta un número entero positivo que da como resultado un número entero positivo.
¡Pruébelo en línea!
¿Cómo?
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>
¡Pruébelo en línea!
Toma la entrada como una lista singleton que contiene el número entero.
Un enfoque diferente que tiene 16 bytes:
λSDgmO}ηíεćk}Ù¥н
¡Pruébelo en línea!
Comentó :
Δ¤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⊤⍵}⍡⍵⊢⍵}
¡Pruébelo en línea!
-1 byte usando ⎕IO←0.
Dado que la duración del ciclo nunca excede \$n\$, podemos repetir n veces en lugar de encontrar un punto fijo, luego calcular la duración del ciclo.
Explicación
{⊃⍸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
Icono , 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
¡Pruébelo en línea!
Rojo , 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]
¡Pruébelo en línea!
Scala, 117 bytes
Respuesta de Haskell del asistente del puerto de trigo .
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)
¡Pruébelo en línea!
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
¡Pruébelo en línea!
Una solución ridículamente larga, agravada por el hecho de que Scala no tiene **como lo hacen Python y otros lenguajes, y initsdevuelve primero los datos más grandes, así que tenemos que usar 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
¡Pruébelo en línea!
Comentó:
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
K (Kona) , 42 bytes
--/&{x=*|x}{x~?x}{x,_+/{x^'#x}10_vs*|x}/,:
¡Pruébelo en línea!
J , 40 bytes
-5 por FrownyFrog!
0(i.~~:@|.)(,*/@~:$1#.&(^#)10#.inv{:)^:_
¡Pruébelo en línea!
J , 45 bytes
[:#.~[:~:&.|.(,1#.&(^#)10#.inv{:)^:(*/@~:)^:_
¡Pruébelo en línea!
…^:_hasta que el resultado no cambie:…^:(*/@~:)si no hay duplicado en la lista:10#.inv{:dígitos del último número ...1#.&(^#)impulsado por su longitud, sumado,adjunto a la lista.[:~:&.|.lista inversa, obtenga una máscara de bits de las primeras apariciones en ella, retroceda. Entonces1 2 3 2 3 -> 3 2 3 2 1 -> 1 1 0 0 1 -> 1 0 0 1 1.[:#.~cuente los 1 finales con conversión de base mixta.