|
%I #11 Jul 15 2021 02:47:45
%S 2,1,14,59,143,239,1079,2519,1439,7559,17639,4319,14399,70559,55439,
%T 113399,120959,166319,205919,332639,760319,554399,907199,277199,
%U 720719,2162159,3245759,4324319,2494799,5266799,5765759,9172799,8315999,15724799,16853759,21067199
%N a(n) is the least k such that there are exactly n numbers i with A075254(i) = k.
%C a(n) is the least solution k to A346377(k) = n.
%e a(3) = 59 because there are 3 solutions to A075254(k) = 59, namely
%e A075254(38) = 38+2+19 = 59
%e A075254(44) = 44+2+2+11 = 59
%e A075254(48) = 48+2+2+2+2+3 = 59
%e and no number < 59 has exactly 3 solutions.
%p f:= proc(n) local t; add(t[1]*t[2],t=ifactors(n)[2])+n end proc:
%p N:= 10^6: # for terms <= N
%p V:= Vector(N):
%p for n from 1 to N do
%p v:= f(n);
%p if v <= N then V[v]:= V[v]+1 fi
%p od:
%p m:= max(V):
%p A:= Array(0..m):
%p for i from 1 to N do
%p if A[V[i]] = 0 then A[V[i]]:= i fi
%p od:
%p convert(A,list);
%t f[1] = 1; f[n_] := n + Plus @@ Times @@@ FactorInteger[n]; m = 10^7; v = Table[0, {m}]; Do[i = f[n]; If[i <= m, v[[i]]++], {n, 1, m}]; TakeWhile[Table[ FirstPosition[v, k][[1]], {k, 0, Max[v]}], NumericQ] (* _Amiram Eldar_, Jul 14 2021 *)
%Y Cf. A075254, A346377
%K nonn
%O 0,1
%A _J. M. Bergot_ and _Robert Israel_, Jul 14 2021
|
