A066817 - OEIS

%I #18 Nov 12 2023 13:27:18

%S 0,2131,23,3224591,0,0,

%T 241127117451117479045190960709721125675426733715695733779133596697360781090711425903130196316185995152974660668512820125356019549490226189398938302252287927928254649608061563193945459975102656949618158919173931,

%U 0,0,0,2251,0,0,0,3224591,314313643123658229739531,97211238048939739899395714118873644859466103898031,0,46747167851021731,3224591,97211238048939739899395714118873644859466103898031,3141114911731,5171

%N Conjectured values of first prime in the orbit f(m), f(f(m)), ..., where f(n) = A067599(n) and m = n-th composite number; or 0 if none exists.

%C The terms with 0 value listed above are conjectural. There are no primes < 10^30.

%C From _Sean A. Irvine_, Nov 09 2023: (Start)

%C None of the unresolved cases with n < 50 terminates in a prime < 10^130.

%C Because the trajectories under f can coalesce certain values are known to be equal even if that value is currently unknown. For example, a(1) = a(13) and a(9) = a(14).

%C Because of the inclusion of exponents 1 in the concatenation defined by f, terms in the trajectory typically grow quicker than in A195264 or A037274.

%C (End)

%t (* f returns an array encoding the prime factorization of n *) f[ n_] := Module[ {a, l, i, t = {} }, a = FactorInteger[ n]; l = Length[ a]; For[ i = 1, i <= l, i++, t = Append[ t, a[ [ i]][ [ 1]]]; t = Append[ t, a[ [ i]][ [ 2]]]]; t];

%t (* g returns the concatenation of the elements of its input array *) g[ x_] := Module[ {r = "", m = Length[ x], l}, For[ l = 1, l <= m, l++, r = StringJoin[ r, ToString[ x[ [ l]]]]]; r];

%t (* h returns an array of the digits of its input int string *) h[ n_] := IntegerDigits[ ToExpression[ n]]

%t (* j returns the number formed from the digits in its input array *) j[ x_] := Module[ {r = 0, m = Length[ x], t = x, l}, For[ l = 1, l <= m, l++, r = 10*r + t[ [ 1]]; t = Rest[ t]]; r];

%t (* k composes the previous functions *) k[ n_] := j[ h[ g[ f[ n]]]]

%t s[ n_] := Module[ {a=n, r=0}, While[ !PrimeQ[ a] && a<10^30, a=k[ a]]; If[ PrimeQ[ a], r=a]; r]; Table[ s[ i], {i, 2, 50}]

%Y Cf. A002808, A067599, A067600, A037274, A195264.

%K nonn,base,less

%O 1,2

%A _Joseph L. Pe_, Feb 01 2002

%E Offset changed to 1 by _Jinyuan Wang_, Jul 30 2020

%E a(7) and a(17) resolved and missing a(21) inserted by _Sean A. Irvine_, Nov 09 2023