A317384 - OEIS

%I #25 Dec 07 2023 10:55:38

%S 2,1,13,31,43,91,111,231,175,274,351,471,703,526,463,931,823,1723,

%T 1579,1279,1903,2083,1791,2143,2227,2443,2671,2781,2335,3807,3163,

%U 3631,3199,4243,5314,5482,5107,4671,6231,6681,8863,7483,6111,6331,7879,8031,8023,9351

%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 (not necessarily distinct) primes.

%H Alois P. Heinz, <a href="/A317384/b317384.txt">Table of n, a(n) for n = 0..1000</a>

%F a(n) = min { j > 0 : A317240(j) = n }.

%e a(1) = 1: 1.

%e a(2) = 13: 1 + 2 * (1 + 5) = 1 + 3 * (1 + 3) = 13.

%e a(3) = 31: 1 + 2 * (1 + 2 * (1 + 2 * (1 + 2))) = 1 + 3 * (1 + 3 * (1 + 2)) = 1 + 5 * (1 + 5) = 31.

%p b:= proc(n) option remember; `if`(n=1, 1,

%p       add(b((n-1)/p), p=numtheory[factorset](n-1)))

%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..50);

%t pp[n_] := pp[n] = FactorInteger[n][[All, 1]];

%t q[n_] := q[n] = Switch[n, 1, True, 2, False, _, AnyTrue[pp[n-1], q[(n-1)/#]&]];

%t b[n_] := b[n] = Which[n == 1, 1, ! q[n], 0, True, Sum[b[(n-1)/p], {p, pp[n-1]}]];

%t a[n_] := Module[{k}, For[k = 1, True, k++, If[n == b[k], Return[k]]]];

%t Table[a[n], {n, 0, 50}] (* _Jean-François Alcover_, Dec 07 2023, after _Alois P. Heinz_ *)

%Y Cf. A317240, A317385.

%K nonn

%O 0,1

%A _Alois P. Heinz_, Jul 26 2018