|
%I #26 Jul 14 2021 14:54:13
%S 2,1,25,43,211,638,664,1613,2991,7021,11306,9439,17361,23230,40886,
%T 38341,49063,36583,99111,111229,110631,171718,233451,255531,309141,
%U 327643,369519,521266,489406,738544,682690,812826,1048594,1015096,2003002,2118439,1602360,2204907,2850772,2702743,2794198
%N Smallest positive integer that has exactly n representations of the form 1 + p1 * (1 + p2* ... * (1 + p_j)...), where [p1, ..., p_j] is a (possibly empty) list of distinct primes.
%F a(n) = min { j > 0 : A317241(j) = n }.
%e a(1) = 1: 1.
%e a(2) = 25: 1 + 2 * (1 + 11) = 1 + 3 * (1 + 7) = 25.
%e a(3) = 43: 1 + 2 * (1 + 5 * (1 + 3)) = 1 + 3 * (1 + 13) = 1 + 7 * (1 + 5) = 43.
%p b:= proc(n, s) option remember; `if`(n=1, 1, add(b((n-1)/p
%p , s union {p}), p=numtheory[factorset](n-1) minus s))
%p end:
%p a:= proc(n) option remember; local k;
%p for k while n<>b(k, {}) do od; k
%p end:
%p seq(a(n), n=0..15);
%t b[n_, s_] := b[n, s] = If[n == 1, 1, Sum[If[p == 1, 0, b[(n - 1)/p, s~Union~{p}]], {p, FactorInteger[n - 1][[All, 1]]~Complement~s}]];
%t A[n_, k_] := Module[{h, p, q = 0}, p[_] = {}; While[Length[p[k]] < n, q++; h = b[q, {}]; p[h] = Append[p[h], q]]; p[k][[n]]];
%t a[k_] := If[k == 0, 2, A[1, k]];
%t Table[a[n], {n, 0, 15}] (* _Jean-François Alcover_, Jul 14 2021, after _Alois P. Heinz_ in A317390 *)
%Y Row n=1 of A317390.
%Y Cf. A317241, A317384.
%K nonn
%O 0,1
%A _Alois P. Heinz_, Jul 26 2018
|
