login
Minimal number of primorials or their negatives that add to n.
3

%I #20 Jan 23 2024 11:06:42

%S 0,1,1,2,2,2,1,2,2,3,3,3,2,3,3,4,4,4,3,4,4,4,3,3,2,3,3,3,2,2,1,2,2,3,

%T 3,3,2,3,3,4,4,4,3,4,4,5,5,5,4,5,5,5,4,4,3,4,4,4,3,3,2,3,3,4,4,4,3,4,

%U 4,5,5,5,4,5,5,6,6,6,5,6,6,6,5,5,4,5,5,5

%N Minimal number of primorials or their negatives that add to n.

%H Alois P. Heinz, <a href="/A366693/b366693.txt">Table of n, a(n) for n = 0..10000</a>

%e 5 = 6 - 1 (two primorials), so a(5) = 2.

%e 27 = 30 - 2 - 1 (three primorials), so a(27) = 3.

%t a[nthPrimorials_Integer?NonNegative (* Increase nthPrimorials to use more positive and negative primorials in sum *), numberOfPrimorials_Integer?NonNegative (* Increase numberOfPrimorials to increase cap of minimal number of primorials *)] := a[nthPrimorials, numberOfPrimorials] = Module[{A002110, f, h, s}, A002110[nthPrimorials] = Join[{1}, Denominator[Accumulate[1/Prime[Range[nthPrimorials]]]]]; A002110[n_] := A002110[n] = Join[{1}, Denominator[Accumulate[1/Prime[Range[n]]]]]; f[n_] := f[n] = Flatten[Table[p*r, {p, A002110[n - 1]}, {r, {1, -1}}]]; h[n_, u_] := h[n, u] = Sort[Select[DeleteDuplicates[Flatten[Table[Sum[p[j], {j, 1, u}], ##] & @@ Table[{p[j], f[n]}, {j, 1, u}]]], # > 0 &]]; s = Table[Infinity, {A002110[nthPrimorials][[-1]]}]; Monitor[Do[If[s[[k]] > k, s[[k]] = l], {l, 1, numberOfPrimorials}, {k, h[nthPrimorials, l]}], {l, k}]; s = Join[{0}, s]; If[MemberQ[s, Infinity], s[[1 ;; Position[s, Infinity][[1, 1]] - 1]], s]]; a[6, 6] (* _Robert P. P. McKone_, Oct 21 2023 *)

%Y Cf. A002110, A276150, A366136.

%K nonn,look

%O 0,4

%A _James C. McMahon_, Oct 16 2023