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).

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

Alois P. Heinz, Table of n, a(n) for n = 1..500

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

Cf. A000040, A051034, A331634, A332861, A002110, A333238.

Sequence in context: A140777 A309502 A281664 * A290220 A320678 A050844

Adjacent sequences: A330504 A330505 A330506 * A330508 A330509 A330510

Keyword

nonn

Author

David James Sycamore, Mar 01 2020

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