|
%I #46 Nov 21 2021 09:28:00
%S 1,2,3,2,5,2,7,2,9,2,11,4,13,2,15,2,17,18,19,4,21,2,23,8,25,2,27,4,29,
%T 6,31,2,33,2,35,12,37,2,39,40,41,6,43,4,9,2,47,16,49,50,51,4,53,18,55,
%U 8,57,2,59,12,61,2,63,2,65,6,67,4,69,10,71,24,73,2
%N a(1) = 1. For n >=2 the number k in n-th position becomes a(n) only if all terms a(1)..a(n-1) have already been defined, and if the smallest number m, greater than k, not already defined and sharing greatest prime factor (gpf) p with k is reduced to m/p.
%C A limiting sequence using greatest prime factor. Each number in A000027, in natural order, is considered for admittance to the sequence. A number in n-th position at the start may be reduced several times prior to being admitted as a(n), or may not be reduced at all. Every power 2^k of 2 is reduced eventually to 2, by reduction of A007053(2^(k-1)) even semiprimes, plus 2s from reductions of smaller powers of 2.
%C Let [p] = {m: m a fixed point with gpf = p}, then [2] = {2}, [3] = {3,9,18,27}, [5] = {5,15,25,40,50,90}, etc. Every odd multiple of odd prime p, up to and including p^2, is necessarily a fixed point. The number of terms in [p] is limited by reduction of q-smooth numbers (q>p) to those having gpf p. Conjecture: For odd prime p, [p] is a finite set with greatest term > p^2, and <= p^3. A variant based on least prime divisors is also possible.
%H Michael De Vlieger, <a href="/A348846/a348846.png">Log-log scatterplot of a(n)</a> for n = 1..1800.
%F a((2*m+1)*p) is a fixed point for all primes p, with m = 0,1,...,(p-1)/2.
%F a(2*p) = 2 for all primes p.
%F a(2^k) = 2 for all k >= 1.
%e After a(1) = 1, the next eligible number is 2, which becomes a(2) when 4 is reduced to 4/2 = 2.
%e a(3) = 3 because 6 is reduced to 2.
%e Next in line is 2 (previously 4), which enters as a(4) when 8 is reduced to 4.
%e a(5) = 5 when 10 is reduced to 2.
%e Next in line is 2 (previously 6) which enters as a(6) when 4 (previously 8) is reduced to 2.
%e a(7) = 7, and so on.
%t {1}~Join~Reap[Do[If[! IntegerQ[r[i]], Set[r[i], i]]; Which[PrimeQ[i], Set[m, 2 #],IntegerQ@ Log2[#], Block[{j = 1, k = Log2[#]}, While[r[Set[m, 2^(k + j)]] <= #, j++]], True, Block[{n = #1, k = #1/#2, j = 1}, p = #2; While[Nand[FactorInteger[#][[-1, 1]] <= p, r[#] > #] &@ Set[m, (j + k) p], j++]] & @@ {#, FactorInteger[#][[-1, 1]]}] &@ r[i]; If[IntegerQ[r[m]], r[m] /= FactorInteger[r[m]][[-1, 1]], Set[r[m], m/(FactorInteger[m][[-1, 1]])]]; Sow[r[i]], {i, 2, 120}]][[-1, -1]] (* _Michael De Vlieger_, Nov 07 2021 *)
%Y Cf. A000027, A136119, A007053.
%K nonn
%O 1,2
%A _David James Sycamore_, Nov 07 2021
%E More terms from _Michael De Vlieger_, Nov 07 2021
|
