Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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["`*"]
share|improve this question
    
I think you should avoid NSum as you're wasting time calculating sums you already have. Is it acceptable to identify a range, say 9x10^6 through 10^7, then do data = NestList[{#[[1]] + 1, #[[2]] + 1./(#[[1]] + 1 + Sqrt[#[[1]] + 1])} &, {9 10^6, NSum[1.0/(i + Sqrt[i]), {i, 900000}] - 15}, 10^6]; ? This is very fast and you can then inspect data. –  b.gatessucks Dec 29 '12 at 11:25
    
@b.gatessucks One canot avoid NSum. Read e.g. my comment to Mr.Wizard's answer. Of course there can be alwas some improvements, nevertheless in general, you can't substitute NSum with anything else. –  Artes Dec 29 '12 at 17:31
add comment

4 Answers 4

up vote 13 down vote accepted

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
share|improve this answer
    
I believe you can replace the entire definition of myfunc with myfunc[n_?Positive] := NSum[1/(i + Sqrt[i]), {i, Round @ n}] –  Mr.Wizard Dec 29 '12 at 13:02
    
@Mr.Wizard Yes you're right. I nearly totally forgot Positive! –  Silvia Dec 29 '12 at 13:14
    
@Artes hmm let me have a think.. The key point of adopting "PrincipalAxis" is to use the built-in root-searching routine for automatic "trial and error". I'm thinking of defining a proper custom merit function so it can compute fast and precision, but I'm currently in travel and don't have access to an MMA.. –  Silvia Dec 31 '12 at 1:55
2  
@Silvia I mean that in order to have more reliable results one has to use options in NSum like AccuracyGoal, NSumTerms etc. Here you should include e.g. possible options of the function myfunc. –  Artes Dec 31 '12 at 2:15
    
@Artes I see. I was thinking those options will remarkably increase the evaluation time before. Thanks for your reminding and please see my edit. –  Silvia Jan 7 '13 at 18:06
show 5 more comments

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.

share|improve this answer
add comment

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.

share|improve this answer
1  
Count[Accumulate@Array[1.0/(# + Sqrt[#]) &, 12000000], x_ /; x < 15] + 1 // Timing more faster. –  chyaong Dec 29 '12 at 13:45
    
@chyanog I didn't realize LengthWhile was taking so long. I think we can do even better than Count. Update soon. –  Mr.Wizard Dec 29 '12 at 13:55
    
I think so too. –  chyaong Dec 29 '12 at 14:02
    
@chyanog Update complete. –  Mr.Wizard Dec 29 '12 at 14:03
1  
@chyanog Accumulate is an elegant and fast method here. But You can't work with it for significantly bigger numbers with it. There is no other than working with NSum and adjusting WorkingPrecision and AccuracyGoal if you to explore this series extensively. E.g. When you want to find minimal n such that $\frac{1}{2}+\frac{1}{2+\sqrt{2}}+...+\frac{1}{n+\sqrt{n}}>\;30$ –  Artes Dec 29 '12 at 17:26
show 1 more comment

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} *)
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.