login
a(1) = 1; for n > 1, a(n) is the smallest positive number that has not yet appeared such that a(n-1) + a(n) has the same number of distinct prime factors as a(n-1) * a(n).
4

%I #14 Jul 17 2023 08:52:06

%S 1,2,10,4,6,8,7,3,11,9,5,13,23,16,12,24,27,17,19,25,15,51,33,37,31,32,

%T 14,46,20,22,38,28,42,18,36,30,40,26,34,44,58,29,43,35,55,47,41,53,52,

%U 50,60,45,21,39,63,49,59,64,48,57,69,61,65,67,79,73,71,81,54,56,70,80,74,76,62,68,72

%N a(1) = 1; for n > 1, a(n) is the smallest positive number that has not yet appeared such that a(n-1) + a(n) has the same number of distinct prime factors as a(n-1) * a(n).

%C The terms are concentrated along the line a(n) = n, resulting in seven-hundred six fixed points in the first 50000 terms. These begin 1, 2, 4, 7, 19, 43, 50, 134, ... . See the linked image. In the same range the smallest unseen number is 46410, suggesting all numbers will eventually appear.

%H Scott R. Shannon, <a href="/A364262/b364262.txt">Table of n, a(n) for n = 1..10000</a>.

%H Scott R. Shannon, <a href="/A364262/a364262.png">Image of the first 50000 terms</a>. The green line is a(n) = n.

%e a(2) = 2 as a(1) + 2 = 1 + 2 = 3 while a(1) * 2 = 1 * 2 = 2, both of which have one distinct prime factor.

%e a(3) = 10 as a(2) + 10 = 2 + 10 = 12 while a(2) * 10 = 2 * 10 = 20, both of which have two distinct prime factors.

%t nn = 120;

%t c[_] := False; f[x_] := PrimeNu[x]; a[1] = j = 1; c[1] = True; u = 2;

%t Do[k = u; While[Or[c[k], f[j + k] != f[j k]], k++];

%t Set[{a[n], c[k], j}, {k, True, k}];

%t If[k == u, While[c[u], u++]], {n, 2, nn}];

%t Array[a, nn] (* _Michael De Vlieger_, Jul 17 2023 *)

%Y Cf. A364261 (nondistinct factors), A001221, A027748.

%K nonn

%O 1,2

%A _Scott R. Shannon_, Jul 16 2023