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.

May I ask what is the best way to evaluate

NSolve[{a^10 E^-a - b^10 E^-b == 
   0, (362880 + 
       a (362880 + 
          a (181440 + 
             a (60480 + 
                a (15120 + 
                   a (3024 + 
                    a (504 + 
                    a (72 + a (9 + a))))))))) E^-a + (-362880 - 
       b (362880 + 
          b (181440 + 
             b (60480 + 
                b (15120 + 
                   b (3024 + 
                    b (504 + b (72 + b (9 + b))))))))) E^-b + 0.99 == 
   0}, {a, b}]

I tried several methods but my machine refuse to produce anything. Is the computational complexity really this much?

share|improve this question
1  
By the way, though you've probably already done this, those numbers seem to match sequence A008279, a.k.a. permutation coefficients, a.k.a. falling factorials triangle. –  Andrew Cheong Apr 5 '14 at 6:09

1 Answer 1

up vote 7 down vote accepted

You can reformulate this as a objective function minimisation problem, where you minimise the sum of the squares of the left hand sides of your equations. Here is how to do this with NMinimize, trying all of the optimisation methods that are mentioned in the documentation:

{#, NMinimize[(a^10 E^-a - 
   b^10 E^-b)^2 + ((362880. + 
      a (362880. + 
         a (181440. + 
            a (60480. + 
               a (15120. + 
                a (3024. + 
                a (504. + 
                a (72. + a (9. + a))))))))) E^-a + (-362880. - 
      b (362880. + 
         b (181440. + 
            b (60480. + 
               b (15120. + 
                b (3024. + 
                b (504. + b (72. + b (9. + b))))))))) E^-b + 
   0.99)^2, {a, b}, Method -> #]} & /@
{"NelderMead", "DifferentialEvolution", "SimulatedAnnealing", "RandomSearch"}

which produces the output

{{"NelderMead", {0.965138, {a -> 1.96905, b -> 1.96881}}},
 {"DifferentialEvolution", {3.38813*10^-21, {a -> 1.69024, b -> -1.25858}}},
 {"SimulatedAnnealing", {1.11485*10^-20, {a -> 1.69024, b -> -1.25858}}},
 {"RandomSearch", {0.968532, {a -> 0.900447, b -> 0.774213}}}}

Both "DifferentialEvolution" and "SimulatedAnnealing" have found an accurate solution.

share|improve this answer
    
Ah, so that's how it's done! –  Andrew Cheong Apr 2 '14 at 14:35
    
I had another think about my solution when I read Andrew Cheong’s answer below. Define f1[a_,b_]:=<LHS #1>; f2[a_,b_]:=<LHS #2>, where "LHS" means "left hand side", then evaluate ContourPlot[{f1[a, b] == 0, f2[a, b] == 0}, {a, -50, 50}, {b, -50, 50}, ContourStyle -> {Red, Blue}, PlotPoints -> 100], where any solution corresponds to an intersection between the red and blue contours. Ignoring near-solutions where contours run very close to each other, there are 2 solutions: (1) close to (10,10) as noted by Andrew Cheong below, and (2) at {1.69024…, -1.25858…} as found in my answer above. –  Stephen Luttrell Apr 7 '14 at 18:58

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.