This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.
\\ Use the program given in A280866.
\\ Needs also code from A280866: A046523(n) = { my(f=vecsort(factor(n)[, 2], , 4), p); prod(i=1, #f, (p=nextprime(p+1))^f[i]); }; \\ From A046523 rgs_transform(invec) = { my(om = Map(), outvec = vector(length(invec)), u=1); for(i=1, length(invec), if(mapisdefined(om,invec[i]), my(pp = mapget(om, invec[i])); outvec[i] = outvec[pp] , mapput(om,invec[i],i); outvec[i] = u; u++ )); outvec; }; v304743 = rgs_transform(vector(65539,n,A046523(A280866(n)))); A304743(n) = v304743[n];
\\ Needs also code from A280866: A064989(n) = {my(f); f = factor(n); if((n>1 && f[1,1]==2), f[1,2] = 0); for (i=1, #f~, f[i,1] = precprime(f[i,1]-1)); factorback(f)}; A246277(n) = { if(1==n, 0, while((n%2), n = A064989(n)); (n/2)); }; rgs_transform(invec) = { my(om = Map(), outvec = vector(length(invec)), u=1); for(i=1, length(invec), if(mapisdefined(om,invec[i]), my(pp = mapget(om, invec[i])); outvec[i] = outvec[pp] , mapput(om,invec[i],i); outvec[i] = u; u++ )); outvec; }; v304742 = rgs_transform(vector(65539,n,A246277(A280866(n)))); A304742(n) = v304742[n];
The 11th prime, 31, appears in A280864 at index 49, and in A280866 at index 43, so a(11) = 49 - 43 = 6.
Let s = A019565 and let t = A280866. a(0) = 1 since s(0) = 1 = t(1). a(1) = 2 since s(1) = 2 = t(2). a(2) = 4 since s(2) = 3 = t(4). a(3) = 5 since s(3) = 5 = t(5). Table relating this sequence to s and t. The last column shows Y if s(n) is divisible by the prime in the heading, otherwise ".": n s(n) a(n) 2357 ---------------------- 0 1 1 . 1 2 2 Y 2 3 4 .Y 3 6 5 YY 4 5 7 ..Y 5 10 8 Y.Y 6 15 17 .YY 7 30 26 YYY 8 7 11 ...Y 9 14 12 Y..Y 10 21 20 .Y.Y 11 42 37 YY.Y 12 35 36 .YYY 13 70 67 Y.YY 14 105 68 .YYY 15 210 205 YYYY ...
nn = 2^14; c[] := False; m[] := 1; i = 1; j = m[1] = m[2] = 2; c[1] = c[2] = True; f[x_] := f[x] = Times @@ FactorInteger[x][[All, 1]]; s = Association[ Monitor[Reap[ Do[While[c[Set[k, # m[#]]], m[#]++] &[f[i * j]/f[i]]; If[SquareFreeQ[k], Sow[Total[2^(-1 + PrimePi[FactorInteger[k][[All, 1]]])] -> n] ]; Set[{c[k], i, j}, {True, j, k}], {n, 3, nn}] ][[-1, 1]], n]]; TakeWhile[{1, 2}~Join~Array[If[KeyExistsQ[s, #], Lookup[s, #], 0] &, Floor@ Sqrt[nn], 2], # > 0 &]
The first terms, alongside their required and forbidden prime factors are: n a(n) Required Forbidden -- ---- -------- --------- 1 1 none none 2 2 none none 3 4 2 none 4 3 none 2 5 6 3 none 6 8 2 3 7 5 none 2 8 10 5 none 9 12 2 5 10 9 3 2 11 7 none 3 12 14 7 none 13 16 2 7 14 11 none 2 15 22 11 none 16 18 2 11 17 15 3 2 18 20 5 3 19 24 2 5 20 21 3 2 21 28 7 3 22 26 2 7 23 13 13 2 24 17 none 13 25 34 17 none 26 30 2 17 27 45 3, 5 2 28 19 none 3, 5 29 38 19 none 30 32 2 19 31 23 none 2 32 46 23 none 33 36 2 23 34 27 3 2 35 25 none 3 36 35 5 none 37 42 7 5 38 48 2, 3 7 39 29 none 2, 3 40 58 29 none 41 40 2 29 42 55 5 2
N:= 1000: # to get all terms until the first term > N
A[1]:= 1:
A[2]:= 2:
G:= {}:
Avail:= [$3..N]:
found:= true:
lastn:= 2:
for n from 3 while found and nops(Avail)>0 do
found:= false;
H:= G;
G:= numtheory:-factorset(A[n-1]);
r:= convert(G minus H,`*`);
s:= convert(G intersect H, `*`);
for j from 1 to nops(Avail) do
if Avail[j] mod r = 0 and igcd(Avail[j],s) = 1 then
found:= true;
A[n]:= Avail[j];
Avail:= subsop(j=NULL,Avail);
lastn:= n;
break
fi
od;
od:
seq(A[i],i=1..lastn); # Robert Israel, Mar 22 2017
terms = 100; rad[n_] := Times @@ FactorInteger[n][[All, 1]]; A280864 = Reap[present = 0; p = 1; pp = 1; Do[forbidden = GCD[p, pp]; mandatory = p/forbidden; a = mandatory; While[BitGet[present, a] > 0 || GCD[forbidden, a] > 1, a += mandatory]; Sow[a]; present += 2^a; pp = p; p = rad[a], terms]][[2, 1]] (* Jean-François Alcover, Nov 23 2017, translated from Rémy Sigrist's PARI program *)
From _Michael De Vlieger_, Apr 23 2024: (Start)
Let rad(x) = A007947(x) and let P(x) = A002110(x).
Let S = { prime p : p | a(n-2) } and let T = { prime p : p | a(n-1) }. Then k = Product_{p in S\T} p = rad(a(n-2)*a(n-1))/rad(a(n-1)).
a(3) = 3 since rad(1*2)/rad(2) = 1; a(1) = 1, a(2) = 2, therefore a(3) = 3*1.
a(4) = 4 since rad(2*3)/rad(3) = 2; a(2) = 2, thus a(4) = 2*2.
a(5) = 6 since rad(3*4)/rad(4) = 6/2 = 3; a(3) = 3, thus a(5) = 2*3.
a(91305) = 108 and a(91306) = P(17), therefore k = 1 since rad(108) | P(17). The smallest missing number is 53, therefore a(91307) = 53*1. Related sequence A368133 = b is such that it is coincident with this sequence until b(91307) = 61, since prime(18) = 61 is the smallest prime that does not divide b(91306) = P(17). (End)
nn = 100; c[] := False; m[] := 1; f[x_] := f[x] = Times @@ FactorInteger[x][[All, 1]]; Array[Set[{a[#], c[#], m[#]}, {#, True, 2}] &, 2]; i = 1; j = r = 2; Do[(While[c[Set[k, # m[#]]], m[#]++]) &[r/f[j]]; Set[{a[n], c[k], i, j, r}, {k, True, j, k, f[j*k]}], {n, 3, nn}]; Array[a, nn] (* Michael De Vlieger, Feb 21 2024 *)
a(1) = 1, a(2) = 2 and since 2|a(2) but not a(1), and no other primes are involved, a(3) = 4, the least novel multiple of 2, the squarefree kernel of 2 (by (i)). Every prime divisor of a(3) = 4 also divides a(2) = 2, thus a(4) = 3, the least unused number (by (iii)). a(23) = 13 because 13|a(22) = 26, but does not divide a(21) = 28 (by (ii)). Then since every prime divisor of a(23) also divides a(22), a(24) = 17, the least unused term (by (iii)). This is the first occasion of consecutive primes. a(25) = 34, a(26) = 30 and there are two primes (3,5) which divide 30 but not 34. At this point the least novel multiples of 3 and 5 are 27 and 25 respectively, so a(27) = 25 (by (ii)). This is the first departure from A280864/A280866, which both have a(27) = 45.
Block[{a, c, f, g, k, m, q, u, nn}, nn = 120; c[] = False; q[] = 1; Array[Set[{a[#], c[#]}, {#, True}] &, 3]; q[2] = 2; u = 3; Do[m = FactorInteger[a[n - 1]][[All, 1]]; f = Select[m, CoprimeQ[#, a[n - 2]] &]; If[AllTrue[m, Mod[a[n - 2], #] == 0 &], k = u, Set[{k, q[#1]}, {#2, #2/#1}] & @@ First@ MinimalBy[Map[{#, Set[g, q[#]]; While[c[g #], g++]; # g} &, f], Last] ]; Set[{a[n], c[k]}, {k, True}]; If[k == u, While[c[u], u++]], {n, 3, nn}]; Array[a, nn] ] (* Michael De Vlieger, Nov 06 2022 *)
Comments