login
A330507
a(n) is the smallest number k having for every prime p <= prime(n) at least one prime partition with least part p, and no such partition having least part > prime(n). If no such k exists then a(n) = 0 (see comments).
6
2, 6, 10, 18, 24, 30, 51, 57, 69, 60, 99, 111, 123, 143, 147, 159, 177, 189, 201, 213, 225, 245, 255, 267, 291, 303, 309, 321, 345, 357, 381, 393, 411, 427, 447, 465, 471, 493, 507, 519, 537, 553, 573, 583, 623, 621, 633, 669, 681, 695, 707, 729, 749, 753, 783
OFFSET
1,1
COMMENTS
Alternatively, a(n) is the smallest number whose product of distinct least part primes from all partitions of n into prime parts, is equal to primorial(n).
2 is the only prime term.
a(n) = 0 for n = 90, 151, 349, 352, 444, ... . - Alois P. Heinz, Mar 12 2020
LINKS
Michael De Vlieger, Labeled plot of p at (pi(p), n), for 2 <= n <= 240, with k in a(n) shown in red.
EXAMPLE
a(1) = 2 because [2] is the only prime partition of prime(1) = 2.
a(2) = 6 because [2,2,2] and [3,3] are the only possible prime partitions of 6, namely with prime(1) and prime(2) the only least parts.
MAPLE
b:= proc(n, p, t) option remember; `if`(n=0, 1, `if`(p>n, 0, (q->
add(b(n-p*j, q, 1), j=1..n/p)*t^p+b(n, q, t))(nextprime(p))))
end:
a:= proc(n) option remember; local f, k, p; p:= ithprime(n);
for k to 4*p do f:= b(k, 2, x); if degree(f)<= p and andmap(
h->0<coeff(f, x, h), [ithprime(i)$i=1..n]) then return k fi
od; 0
end:
seq(a(n), n=1..55); # Alois P. Heinz, Mar 12 2020
MATHEMATICA
With[{s = Array[Union@ Select[IntegerPartitions[#], AllTrue[#, PrimeQ] &][[All, -1]] &, 70]}, TakeWhile[Map[FirstPosition[s, #][[1]] &, Rest@ NestList[Append[#, Prime[Length@ # + 1]] &, {}, 12]], IntegerQ]] (* Michael De Vlieger, Mar 06 2020 *)
(* Second program: *)
Block[{a, m = 125, s}, a = ConstantArray[{}, m]; s = {Prime@ PrimePi@ m}; Do[If[# <= m, If[FreeQ[a[[#]], Last@ s], a = ReplacePart[a, # -> Union@ Append[a[[#]], Last@ s]], Nothing]; AppendTo[s, Last@ s], If[Last@ s == 2, s = DeleteCases[s, 2]; If[Length@ s == 0, Break[], s = MapAt[Prime[PrimePi[#] - 1] &, s, -1]], s = MapAt[Prime[PrimePi[#] - 1] &, s, -1]]] &@ Total[s], {i, Infinity}]; TakeWhile[Map[FirstPosition[a, #][[1]] &, Rest@ NestList[Append[#, Prime[Length@ # + 1]] &, {}, Max[Length /@ a]]], IntegerQ]] (* Michael De Vlieger, Mar 11 2020 *)
CROSSREFS
KEYWORD
nonn
AUTHOR
EXTENSIONS
a(19)-a(21) from Michael De Vlieger, Mar 12 2020
a(22)-a(55) from Alois P. Heinz, Mar 12 2020
STATUS
approved