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, Table of n, a(n) for n = 1..10000
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
KEYWORD
nonn
AUTHOR
N. J. A. Sloane, Dec 29 2014
EXTENSIONS
Terms beyond 361 from R. J. Mathar, Jan 22 2015
STATUS
approved