A394416 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.

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, 33, 30, 39, 27, 51, 45, 55, 11, 77, 70, 68, 66, 62, 60, 58, 56, 52, 16, 74, 72, 82, 80, 76, 28, 78, 69, 63, 57, 19, 95, 90, 86, 84, 87, 81, 93, 75, 65, 13, 91, 105, 102, 100

Offset

1,2

Comments

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.

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.

See A394417 for the rad value of the product of adjacent terms.

Links

Scott R. Shannon, Table of n, a(n) for n = 1..10000

Scott R. Shannon, Image of the first 100000 terms. 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.

Example

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.

Mathematica

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 *)

Crossrefs

Cf. A394417 (rad values), A007947, A392505, A386482, A064413.

Sequence in context: A141257 A122882 A136700 * A394421 A054645 A337645

Adjacent sequences: A394413 A394414 A394415 * A394417 A394418 A394419

Keyword

nonn

Author

Scott R. Shannon, Mar 28 2026

Status

approved