%I #18 Nov 07 2024 08:30:30
%S 3,15,15,105,105,1155,1155,1365,15015,15015,15015,255255,255255,
%T 596505,4849845,4849845,4849845,10140585,10140585,179444265,229474245,
%U 229474245,242777535,640049865,5898837945,7357214865,7357214865,7357214865,13350001665,196656364905
%N a(n) is the smallest product of prime numbers such that all numbers from 6 and 2n can be written as the sum of two prime factors (duplication allowed) of a(n).
%C The prime factors of a(n) make a subset of prime numbers that satisfies the Goldbach Conjecture for even numbers from 6 to 2n.
%H Lei Zhou, <a href="/A237628/b237628.txt">Table of n, a(n) for n = 3..79</a>
%e n=4: 2*4=8. 8=3+5. This is the only possible two-prime decomposition which contains prime numbers 3 and 5, while 6=3+3, 3 is an element of set {3,5}. So a(4)=3*5=15.
%e n=5: 2*5=10. 6=3+3, 8=3+5, 10=5+5. So two selections of prime numbers in set {3,5} (reuse allowed) can be summed into all three numbers 6, 8, and 10. So a(5)=3*5=15.
%e ...
%e n=8: 2n=16. We will be able to find two sets, {3,5,7,11} and {3,5,7,13}, that have such feature:
%e for set {3,5,7,11}, 6=3+3, 8=3+5, 10=5+5, 12=5+7, 14=7+7, and 16=5+11;
%e for set {3,5,7,13}, 6=3+3, 8=3+5, 10=5+5, 12=5+7, 14=7+7, and 16=3+13.
%e 3*5*7*11=1155, and 3*5*7*13=1365. 1155<1365, so a(8)=1155. Here we did not count set {3,5,7,11,13} which also has the desired feature since the two shorter sets are its subsets such that the products of the elements in the subsets are obviously smaller than the product of elements in this larger set.
%t a = {{{3}}}; Table[n2 = 2*n; na = {}; la = Last[a]; lo = Length[la]; Do[ok = 0; Do[p1 = la[[i, j]]; p2 = n2 - p1; If[MemberQ[la[[i]], p2], ok = 1], {j, 1, Length[la[[i]]]}];
%t If[ok == 1, na = Sort[Append[na, la[[i]]]], Do[p1 = la[[i, j]]; p2 = n2 - p1; If[PrimeQ[p2], ng = Sort[Append[la[[i]], p2]]; big = 0; If[Length[na] > 0, Do[If[Intersection[na[[k]], ng] == na[[k]], big = 1], {k, 1, Length[na]}]]; If[big == 0, na = Sort[Append[na, ng]]]], {j, 1, Length[la[[i]]]}]], {i, 1, lo}]; AppendTo[a, na]; b = {};
%t lna = Length[na]; Do[prd = Times @@ na[[k]]; AppendTo[b, prd], {k, 1, lna}]; Min[b], {n, 4, 32}](*Program lists the 4th item and beyond*)
%Y Cf. A000040, A002375, A240708.
%K nonn,hard
%O 3,1
%A _Lei Zhou_, May 02 2014