Can you recommend an efficient method for finding the least integer satisfying my inequality?

Question

I tried find the minimum make

$\frac{1}{2}+\frac{1}{2+\sqrt{2}}+\frac{1}{3 +\sqrt{3}}+...+\frac{1}{n+\sqrt{n}}>15$

Following code is so slow when I use condition

NestWhile[# + 1 &, 1, NSum[1.0/(i + Sqrt[i]), {i, #}] < 15 &]

Catch@Fold[If[#1 > 15, Throw@#2, #1 + 1.0/(#2 + Sqrt[#2])] &, 0.0, 
   Range[10^7]] // Timing

but these two are fast without condition

NSum[1.0/(i + Sqrt[i]), {i, 10^7}]

Fold[# + 1/(#2 + Sqrt[#2]) &, 0.0, Range[10^7]]

How can I improve my code make it efficiency if dont't use compilation?

Update:

Use Bisection_method

num = 15;
f[x_] := NSum[1/(i + Sqrt[i]), {i, x}];
n = NestWhile[# + 1 &, 1, f[10^#] < num &]
min = 10^(n - 1);
max = 10^n;
mid = Round[(min + max)/2];
While[Abs[f[mid] - num] > 10^-6, 
  If[f[mid] >= num, max = mid - 1];
  If[f[mid] <= num, min = mid + 1];
  mid = Round[(min + max)/2];
];
{min, mid, max}
Clear["`*"]

Answer 1

I think it might be a good example for FindMinimum with the "PrincipalAxis" method.

First define the summation function myfunc:

Clear[myfunc]
myfunc[n_?NumericQ] := NSum[1/(i + Sqrt[i]), {i, n // Round}]
myfunc[n_?(# <= 0 &)] := 0

then the original problem can be solved by minimizing Abs[myfunc[n]-15]:

sol = FindMinimum[Abs[myfunc[n] - 15], {n, 1}, 
  Method -> "PrincipalAxis"]

{3.92725*10^-8, {n -> 9.88133*10^6}}

res = n /. sol[[2]] // Round

9881329

FullForm[myfunc[res + #]] & /@ {-1, 0, 1}

{14.999999859558717`,14.999999960727488`,15.000000061896255`}

So $res + 1 = 9881330$ is the minimal value for $n$ which makes the inequality true.

Edit:

As @Artes suggested in the comments and in his expansive answer, when $n$ gets bigger, higher precision and accuracy are needed for achieving a correct answer, which leads to the options NSumTerms, AccuracyGoal and WorkingPrecision for NSum.

e.g. for $n=25$, a myfunc with more NSumTerms will be necessary:

Clear[myfunc]
myfunc[n_?NumericQ] := NSum[1/(i + Sqrt[i]), {i, n // Round},
                            NSumTerms -> 400 ]
myfunc[n_?Positive] := 0

n /. FindMinimum[Abs[myfunc[n] - 25], {n, 1},
    Method -> "PrincipalAxis"][[2]] // Round

217788341982

Answer 2

One shouldn't expect a general method which might be comparable to NSum, which is universal on one side and very fast on the other side (Options[ NSum, Compiled] gives {Compiled -> Automatic}). Other methods can be faster only for very specific series or special data. NSum yields estimated results but we can alwas make them arbitrarily precise. There are adequate tools in numerical functionality like e.g. AccuracyGoal to reach appropriate accuracy. See this answer for a more detailed discussion related to the main issue. It appears that Silvia's and Mr.Wizard's methods seem to be more handy for this specific problem, but if you try e.g. finding the minimal n which satisfies $\frac{1}{2}+\frac{1}{2+\sqrt{2}}+...+\frac{1}{n+\sqrt{n}}>30$ then you'll have to work with appropriately increased WorkingPrecision (the default value Options[NSum, WorkingPrecision] is MachinePrecision, i.e. its numerical value $MachinePrecision is 15.9546). Accumulate wouldn't be a good approach since you'd have to sum up roughly 5 10^13 terms.

This series is obviously not convergent :

SumConvergence[ 1/(k + Sqrt[k]), k]

False

i.e. you might explore analogical issue for any positive number not just (15 or 30).

To find n for the sum > 15 we can try a few parameters, first we check NSum[1/(k + Sqrt[k]), {k, 10^7}] then we slightly decrease the upper limmit of summation and we end up with very accurate result :

FindRoot[ 15 - NSum[1/(k + Sqrt[k]), {k, x},
              WorkingPrecision -> 50, AccuracyGoal -> 25, NSumTerms -> 10^3],
         {x, 9881300, 9881500}, WorkingPrecision -> 20, AccuracyGoal -> 10] // Quiet

{x -> 9.8813293871411276453*10^6}

Thus we have a candidate n0 == 9881329. Let's increase NSumTerms decreasing WorkingPrecission :

NSum[ 1/(k + Sqrt[k]), {k, #}, WorkingPrecision -> 30, AccuracyGoal -> 15,
      NSumTerms -> 10^5] & /@ {9881329, 9881330}

{14.9999999608590703242577, 15.0000000620278381114430}

One might ensure that n == 9881330 increasing as well NSumTerms up to 10^7.

If we apply directly Silvia's method myfunc to determine the minimal n such that the sum is > 25we find that n == 217788342012 which is incorrect. Mr.Wizard's methods are even worse here. Therefore we can proceed analogically as before by trial and error. It brings us to this conclusion :

NSum[ 1/(k + Sqrt[k]), {k, #}, WorkingPrecision -> 50, AccuracyGoal -> 25, 
      NSumTerms -> 10^5] & /@ {217788341981, 217788341982}

 {24.99999999999638162229253940380424, 25.00000000000097322645325278931633}

Thus we've found n[25] == 217788341982.

Answer 3

Working within the loop method you could do this:

NestWhile[
  # + 1.0/(++i + Sqrt[i]) &,
  i = 0,
  # < 9 &
] // Timing // First

i

0.219

24197

This is reasonably fast and open-ended, but it still doesn't get you to # < 15 very well.
Timing and result for 15: {106.424, 9881330}

Accumulate

Faster but not open-ended is to pick an arbitrary maximum and use Accumulate:

EDIT: My original use of LengthWhile was horribly inefficient. Much faster:

1 + Tr @ UnitStep[15 - Accumulate @ Array[1.0/(# + Sqrt[#]) &, 12000000]] // Timing

{0.983, 9881330}

I would favor an intelligent sampling method as shown by Artes and Silvia over either of these in most cases.

Answer 4

Not sure this helps re speed, but one can get an underestimated approximation byu using, say, 10^5 terms, then truncating denominators of the rest so as to get the Harmonic series values.

Timing[
 nstart = Ceiling[
   n /. FindRoot[
     HarmonicNumber[n] == 
      15 + HarmonicNumber[100000.] - 
       Sum[1/(k + Sqrt[N@k]), {k, 100000}], {n, 1000}]]]

(* Out[1]= {0.015600, 9825379} *)

Timing[startsum = Fold[# + 1./(#2 + Sqrt[N@#2]) &, 0.0, Range[nstart]]]

(* Out[2]= {2.574016, 14.9943234847116} *)

Timing[j = nstart + 1; 
 While[(startsum += 1./(j + Sqrt[N@j])) <= 15, j++]; j]

(* Out[4]= {0.483603, 9881330} *)