login
a(1)=1. For n>1, start with n, concatenate the indices of its prime factors, and repeat until either (i) a prime p is reached, when we set a(n)=p; or (ii) the process enters a loop of length m, when we set a(n) = -m; or (iii) the trajectory diverges to infinity, when we set a(n) = 0.
0

%I #44 Sep 02 2019 04:55:29

%S 1,2,3,11,5,1733,7,12637,23,13,11,1733,13,-1,23,1103,17,1117,19,113,

%T 1277,23,23,1277,-2,1103,1801,222312455509,29,349,31,1439,-2,17,17,

%U 281,37,1117,1103,121327,41,1103,43,1103,223,19,47,11369,1103,11369,1801,11147108327

%N a(1)=1. For n>1, start with n, concatenate the indices of its prime factors, and repeat until either (i) a prime p is reached, when we set a(n)=p; or (ii) the process enters a loop of length m, when we set a(n) = -m; or (iii) the trajectory diverges to infinity, when we set a(n) = 0.

%C A loop of length 3 is reached with the initial number 714: 714=2*3*7*17 = p_1*p_2*p_4*p_7 -> 1247=29*43 = p_10*p_14 -> 1014=2*3*13*13 -> 1266=2*3*211 -> 1247. The loop is 1247 -> 1014 -> 1266.

%e 10=2*5 -> 2=prime(1), 5=prime(3) -> 13, prime, so a(10)=13.

%e 25=5*5 -> 5=prime(3) -> 33 = 3*11 -> 3=prime(2), 11=prime(5) -> 25 (the initial number) -> loop: 25-33-25-33-... -> loop of length 2, so a(25)=-2.

%t f[n_] := FromDigits@ Flatten@ IntegerDigits@ Table[PrimePi@ e[[1]] + 0 Range@ e[[2]], {e, FactorInteger@n}]; a[1]=1; a[n_]:= Block[{z}, z = NestWhileList[f, n, (! PrimeQ@ Last@ List@ ## && Unequal@ ##) &, All]; If[ PrimeQ@ Last@ z, Last@ z, First[ Subtract @@ Position[z, Last@ z]]]]; Array[a, 39] (* _Giovanni Resta_, Sep 01 2019 *)

%Y Cf. A037274 (home primes).

%K sign,base

%O 1,2

%A _Peter Weiss_, Mar 01 2017

%E Definition revised by _N. J. A. Sloane_, Mar 07 2017

%E More terms from _Giovanni Resta_, Sep 01 2019