Find arguments for binomial up to given value

Question

I have estimated the complexity of my numerical experiment like this:

complexity[{n,k}] := Binomial[n+k-1, k]

I want to prepare a list of {n,k} pairs with ascending complexity up to a certain complexity. I am only interested in k>0 and n>1.

My very naive approach is to generate a big list and filter it:

pairsUpToComplexity[limit_] := 
 Select[complexity[#] <= limit &]@
   Flatten[ Table[{n, k}, {n, 2, limit}, {k, 1, limit}], 1] // 
  SortBy[complexity]

However, this is not efficient at all. For example, pairsUpToComplexity[1000] generates a table of 999000 pairs and then filters it down to 2124. The complexity of the list generation seems to high itself...

Answer 1

Find the upper limit of n for a given k at which the complexity is less than the limit. Then, generate the pairs.

To get the upper value of n, you can use NSolve, but this is very slow. Another way would be to use Lazy Evaluation which is much faster.

Using Lazy Evaluation:

complexity[n_, k_] := Binomial[n + k - 1, k]
getNLazy[limit_, k_] := 
 First@(Lazy[Integers]~Select~(complexity[#, k] > limit &)) - 1
pairsUpToComplexity1[limit_] := 
 Flatten[#, 1] &@(Tuples@{Range[2, getNLazy[limit, #]], {#}} & /@ 
    Range[limit])

Using Select:

complexity[n_, k_] := Binomial[n + k - 1, k]
pairsUpToComplexity2[limit_] := 
 Select[Tuples[{Range[2, limit], Range[limit]}], 
  complexity @@ # <= limit &]

Comparison: For limit =1000

sol1 = SortBy[#, Last] &@pairsUpToComplexity1[1000];//AbsoluteTiming
sol2 = SortBy[#, Last] &@pairsUpToComplexity2[1000];//AbsoluteTiming
sol1==sol2
(*True*)

0.054 s

5.503 s

Answer 2

Since we are using Binomials, we do not need to go all the way upto limit but only upto the number whose factorial is less than limit. Also due to symmetricity of Binomial, If Binomial[n,k] is valid, we can automatically count Binomial[n, n-k] as valid. Here is a fast code to do so:

complexity[{n_, k_}] := Binomial[n + k - 1, k]

FindAllBinomials[limit_] :=
 Module[{list = {}, chk, u},
  u = Floor[x /. Last[Quiet[FindMinimum[Abs[x! - limit] && x >= 0, {x,1}]]]];
  list =
   Table[
    chk = Round[(k!*limit)^(1./k)];
    Select[
     Join @@ ({{# - k + 1, k}, {k + 1, # - k}} & /@ Range[chk + k/2]), 
     #[[1]] > 1 && #[[2]] > 0 && complexity[#] <= limit &],
    {k, 1, u}];
  Union @@ list
  ]

In[1906]:= AbsoluteTiming[list = FindAllBinomials[1000];]
Out[1906]= {0.014422, Null}

In[1907]:= Length[list]
Out[1907]= 2124