%I #15 Mar 29 2026 10:30:37
%S 1,2,6,10,8,14,12,22,20,26,24,34,32,38,36,46,44,42,40,35,25,15,21,9,3,
%T 33,30,39,27,51,45,55,11,77,70,68,66,62,60,58,56,52,16,74,72,82,80,76,
%U 28,78,69,63,57,19,95,90,86,84,87,81,93,75,65,13,91,105,102,100
%N a(1) = 1, a(2) = 2; for n > 2, a(n) is the greatest unused number < a(n-1) such that it shares a factor with a(n-1) while rad(a(n)*a(n-1)) has not previously occurred as the rad value of the product of adjacent terms, where rad(k) = A007947(k). If no such number exists then a(n) is the smallest number > a(n-1) satisfying the same criteria.
%C Similar to A386482 the primes do not occur in their natural order, and the terms preceeding and following prime terms can be high multiples of the prime.
%C The fixed points in the first 10^6 terms are 1, 2, 240, 723, 2123, 3263, 11885, 27305, 90145, 122419, 918023; more likely exist. The sequence is conjectured to be a permutation of the positive numbers.
%C See A394417 for the rad value of the product of adjacent terms.
%H Scott R. Shannon, <a href="/A394416/b394416.txt">Table of n, a(n) for n = 1..10000</a>
%H Scott R. Shannon, <a href="/A394416/a394416.png">Image of the first 100000 terms</a>. The colors are graduated across the spectrum from red to violet to show the number of prime factors of each term, counted with multiplicity. The thin green line is a(n) = n.
%e a(5) = 8 as the rad values for the products of previous adjacent terms are 2, 6 and 30, while 8 < a(4) = 10, shares a factor with it, and rad(8*10) = 10 which does not equal any previous rad values. This is the first term to differ from A392505.
%t Block[{c, j, k, q, r, rad, s, v, nn}, nn = 120; c[_] := False; q[_] := False; rad[x_] := rad[x] = Times @@ FactorInteger[x][[All, 1]]; Map[Set[c[#], True] &, s = {1, 2}]; MapApply[Set[q[rad[Times @@ {##}]], True] &, Partition[s, 2, 1]]; v = 1; j = Last[s]; While[Or[! SquareFreeQ[v], q[rad[v] ] ], v++]; s~Join~Reap[Do[k = v; While[Or[c[k], q[Set[r, rad[j*k] ] ], CoprimeQ[k, j] ], k++]; Sow[k]; Set[{c[k], q[r], j}, {True, True, k}]; If[r == v, While[Or[! SquareFreeQ[v], q[rad[v]]], v++] ], {n, Length[s] + 1, nn}] ][[-1, 1]] ] (* _Michael De Vlieger_, Mar 29 2026 *)
%Y Cf. A394417 (rad values), A007947, A392505, A386482, A064413.
%K nonn
%O 1,2
%A _Scott R. Shannon_, Mar 28 2026