A138768 For a positive integer n, write the integers 1,2,...,n in the following order: first write 1 (round 0), then all primes less than or equal to n in increasing order (round 1), then 2p for all primes p with 2p<=n, also in increasing order (round 2), then 3p, then 4p and so on. Each number is written down only the first time it is encountered. Let a(n) denote the last number written down.
1, 2, 3, 4, 4, 6, 6, 8, 8, 8, 8, 12, 12, 12, 12, 16, 16, 16, 16, 16, 16, 16, 16, 24, 24, 24, 27, 27, 27, 27, 27, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 48, 48, 48, 48, 48, 48, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64
Offset: 1
Keywords
Examples
For n=10 we get the ordering 1/ 2, 3, 5, 7/ 4, 6, 10/ 9/ 8 (the rounds are separated by /); so a(10)=8.
Links
- Gary Gordon, The Number between 1 and n That Is Least Prime: Problem 11218, Amer. Math. Monthly, 115 (No. 4, 2008), pp. 367-368.
Crossrefs
Cf. A052126.
Programs
-
Maple
with(numtheory): b:=proc(m) local u: if m=1 then 1 else u:=factorset(m): m/max(seq(u[j],j=1..nops(u))) end if end proc: a:=proc(n) local M,i,a: M:=max(seq(b(j),j=1..n)): for i to n do if b(i)=M then a[i]:=i else a[i]:=0 end if end do: max(seq(a[i],i=1..n)) end proc: seq(a(n),n=1..80);
-
Mathematica
b[m_] := If[m == 1, 1, m/Max[FactorInteger[m][[All, 1]]]]; a[n_] := Module[{M, i, a}, M = Max[Table[b[j], {j, 1, n}]]; For[i = 1, i <= n, i++, If[b[i] == M, a[i] = i, a[i] = 0]]; Max[Table[a[i], {i, 1, n}]]]; Table[a[n], {n, 1, 80}] (* Jean-François Alcover, Sep 05 2024, after Maple program *)
Comments