login
A253288
Each term a(n) satisfies four properties: 1, divisible by all prime factors of n; 2, divisible by only the prime factors of n; 3, not equal to any of the terms a(1), a(2), ... a(n-1); 4, smallest number satisfying 1-3 if A005361(n) is even, or second smallest number satisfying 1-3 if A005361(n) is odd.
2
1, 4, 9, 2, 25, 12, 49, 16, 3, 20, 121, 6, 169, 28, 45, 8, 289, 18, 361, 10, 63, 44, 529, 36, 5, 52, 81, 14, 841, 60, 961, 64, 99, 68, 175, 24, 1369, 76, 117, 50, 1681, 84, 1849, 22, 15, 92, 2209, 48, 7, 40, 153, 26, 2809, 72, 275, 98, 171, 116, 3481, 30, 3721, 124, 21, 32
OFFSET
1,2
COMMENTS
This sequence is permutation of the positive integers.
The prime p occurs at n = p^2.
Multiples of a number x have density 1/x.
Conjecture: this permutation of positive integers is self-inverse. Compare with A358971. The principal distinction between this sequence and A358971 is that fixed points aside from A358971(1) = 1 are explicitly ruled out in the latter. - Michael De Vlieger, Dec 10 2022
REFERENCES
Brad Klee, Posting to Sequence Fans Mailing List, Dec 21, 2014.
LINKS
Michael De Vlieger, Log log scatterplot of a(n), n = 1..2^20.
Michael De Vlieger, Log log scatterplot of a(n) <= 12000, n = 1..2^10 showing primes in red, other prime powers (in A246547) in gold, squarefree composites (in A120944) in green, numbers neither squarefree nor prime power (in A120706) in blue and magenta. The terms in magenta are products of composite prime powers (in A286708).
Michael De Vlieger, Log log scatterplot of a(n) <= 2^14, n = 1..2^14, showing a(n) such that rad(n) = 6 in red, and A358971(n) such that rad(n) = 6 in blue for comparison. This is an example of a self-inverse relation among terms a(n) in A003586.
Michael De Vlieger, Log log scatterplot of a(n) <= 80000, n = 1..2^14, showing a(n) in tiny black points if a(n) = A358971(n), else a(n) in red, and A358971(n) in blue.
MAPLE
A253288div := proc(a, n)
local npr, d, apr ;
npr := numtheory[factorset](n) ;
for d in npr do
if modp(a, d) <> 0 then
return false;
end if;
end do:
apr := numtheory[factorset](a) ;
if apr minus npr = {} then
true;
else
false;
end if;
end proc:
A253288 := proc(n)
option remember;
local a, i, prev, act, ev ;
if n =1 then
1;
else
act := 1 ;
if type(A005361(n), 'even') then
ev := true;
else
ev := false;
end if;
for a from 1 do
prev := false;
for i from 1 to n-1 do
if procname(i) = a then
prev := true;
break;
end if;
end do:
if not prev then
if A253288div(a, n) then
if ev or act > 1 then
return a;
else
act := act+1 ;
end if;
end if;
end if;
end do:
end if;
end proc:
seq(A253288(n), n=1..80) ; # R. J. Mathar, Jan 22 2015
MATHEMATICA
nn = 1000; c[_] = False; q[_] = 1; f[n_] := f[n] = Map[Times @@ # &, Transpose@ FactorInteger[n]]; a[1] = 1; c[1] = True; u = 2; Do[Which[PrimeQ[n], k = n^2, PrimeQ@ Sqrt[n], k = Sqrt[n], SquareFreeQ[n], k = First@ f[n]; m = q[k]; While[Nand[! c[k m], k m != n, Divisible[k, First@ f[m]]], m++]; While[Nor[c[q[k] k], Divisible[k, First@ f[q[k]]]], q[k]++]; k *= m, True, t = 0; Set[{k, s}, {First[#], 1 + Boole@ OddQ@ Last[#]} &[f[n]]]; m = q[k]; Until[t == s, If[m > q[k], m++]; While[Nand[! c[k m], Divisible[k, First@f[m]]], m++]; t++]; If[s == 1, While[Nor[c[q[k] k], Divisible[k, First@ f[q[k]]]], q[k]++]]; k *= m]; Set[{a[n], c[k]}, {k, True}]; If[k == u, While[c[u], u++]], {n, 2, nn}]; Array[a, nn] (* Michael De Vlieger, Dec 10 2022 *)
CROSSREFS
Cf. A005361 (Product of exponents of prime factorization of n), A358971.
Sequence in context: A256513 A358916 A064505 * A358971 A358786 A360541
KEYWORD
nonn
AUTHOR
N. J. A. Sloane, Dec 29 2014
EXTENSIONS
Terms beyond 361 from R. J. Mathar, Jan 22 2015
STATUS
approved