|
%I #35 Apr 24 2024 12:41:55
%S 1,2,3,5,4,7,6,10,11,8,13,9,17,12,19,14,15,21,22,18,23,16,29,20,26,24,
%T 31,25,28,34,30,33,27,37,32,38,35,39,40,41,36,43,42,46,44,47,45,51,49,
%U 52,53,48,58,55,56,57,50,59,54,61,60,62,63,67,64,68,65,66
%N a(1) = 1. For n > 1 a(n) is the smallest unused k such that A007947(k*a(n-1)) is novel.
%C In other words least novel k such that the radical of (k*a(n-1)) has not been seen earlier as the radical of the product of any pair of consecutive terms (radical means A007947, often abbreviated as "rad" in formulae, see Example).
%C This sequence is a permutation of the positive integers (A000027), with primes in order.
%C Initially powers of 2 (>= 4) are flanked by primes: (5,4,7); (11,8,13); (23,16,29), but this pattern does not continue past 16.
%C From _Michael De Vlieger_, Apr 21 2024: (Start)
%C a(n) = k = p^m implies a(n-1) is indivisible by p prime.
%C a(n) = k = 2^m implies a(n-1) is odd.
%C a(n) = k = p implies a(n-1) is not a power of p, hence, there exist no adjacent powers of the same prime in the sequence.
%C (End)
%H Michael De Vlieger, <a href="/A372043/b372043.txt">Table of n, a(n) for n = 1..10000</a>
%H Michael De Vlieger, <a href="/A372043/a372043.png">Plot a(n) at (x,y) = (n mod 360, -floor(n/360))</a> for n = 1..129600, showing primes in red, prime powers in gold, squarefree composites in green, and numbers neither squarefree nor prime powers in blue and black, with black additionally signifying powerful numbers that are not prime powers.
%e a(1) = 1, rad(1) = 1 so a(2) = 2, the least unused number such that rad(2*a(1)) = 2 and no product of two consecutive prior terms has rad = 2.
%e Likewise a(3) = 3 since rad(2*3) = 6 is novel.
%e a(4) cannot be 4 because then we would have rad(3*4) = 6 and this is not novel (see a(3)). However 5 works since rad(3*5) = 15, and this is novel.
%t nn = 120; c[_] := False; q[_] := False;
%t f[x_] := f[x] = Times @@ FactorInteger[x][[All, 1]];
%t a[1] = j = 1; c[1] = q[1] = True; u = 2;
%t Do[m = u; While[Or[c[Set[k, f[j m]]], q[m]], m++];
%t Set[{a[n], c[k], q[m], j}, {m, True, True, m}];
%t If[m == u, While[q[u], u++]], {n, 2, nn}];
%t Array[a, nn] (* _Michael De Vlieger_, Apr 17 2024 *)
%o (PARI) rad(n) = factorback(factorint(n)[, 1]); \\ A007947
%o leastk(w, prec, va) = my(k=1); while (select(x->(x==rad(k*prec)), w) || select(x->(x==k), va), k++); k;
%o lista(nn) = my(va = vector(nn)); va[1] = 1; for (n=2, nn, my(w = vector(n-1, k, rad(va[k+1]*va[k]))); va[n] = leastk(w, va[n-1], va);); va; \\ _Michel Marcus_, Apr 19 2024
%Y Cf. A000027, A007947.
%K nonn
%O 1,2
%A _David James Sycamore_, Apr 17 2024
|
