4
$\begingroup$

I started by defining

c0 = 30891/250; c1 = 863/4000; cD = 1;
eq1 = Q1/Sqrt[1000] Sqrt[c0 - c1 (Q1 + Q2 + Q3)] - 
    cD Sqrt[1/500] Sqrt[1/20] (a1/2 - Sin[2 a1]/4) == 0;

Then I want to find the Taylor expansion of the implicit function a1[Q1,Q2,Q3]

AsymptoticSolve[eq1, {a1}, {{Q1, Q2, Q3}, {Q1v, Q2v, Q3v}, 4}, Reals]

But Mathematica returns unsolved expression

AsymptoticSolve[(Q1 Sqrt[30891/250 - (863 (Q1 + Q2 + Q3))/4000])/(
   10 Sqrt[10]) + 1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 
  0, {a1}, {{Q1, Q2, Q3}, {0.0006, 0.0005, 0.00045}, 4}, Reals]

Could someone teach me how to get it work?

$\endgroup$

1 Answer 1

9
$\begingroup$

General remarks

It takes manual work sometimes when the starting value for the series cannot be easily determined. Also, for an exact solver like AsymptoticSolve (as opposed to a numerical-approximation solver), it's best to give exact inputs. You can apply N[] to the results, if you get any.

First, failed attempt

Rationalize the initial points:

AsymptoticSolve[(Q1 Sqrt[
       30891/250 - (863 (Q1 + Q2 + Q3))/4000])/(10 Sqrt[10]) + 
   1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0, {a1}, {{Q1, Q2, Q3}, 
  Rationalize@{0.0006, 0.0005, 0.00045}, 4}, Reals]
(*
AsymptoticSolve[(Q1 Sqrt[30891/250 - (863 (Q1 + Q2 + Q3))/4000]) /
   (10 Sqrt[10]) + 1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 
  0, {a1}, {{Q1, Q2, Q3}, {3/5000, 1/2000, 9/20000}, 4}, Reals]
*)

Second failure

Let's try solving for the initial value of a1 explicitly:

(Q1 Sqrt[30891/250 - (863 (Q1 + Q2 + Q3))/4000])/(10 Sqrt[10]) + 
   1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0 /. 
 Thread[{Q1, Q2, Q3} -> {3/5000, 1/2000, 9/20000}]
(*
(3 Sqrt[9885093247/2])/1000000000 + 
  1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0
*)
Solve[(3 Sqrt[9885093247/2])/1000000000 + 
   1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0, a1]

Solve::nsmet: This system cannot be solved with the methods available to Solve.

(*
Solve[(3 Sqrt[9885093247/2])/1000000000 + 
   1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0, a1]
*)

Well that didn't go too well.

First small success

Mathematica solvers are pretty robust on analytic functions over bounded domains. Let's search for solution is in the high-school way, calculator graphing:

Plot[(3 Sqrt[9885093247/2])/1000000000 + 
   1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0, {a1, -Pi/2, Pi/2}]

Aha! Got it!! The root is between $0$ and $1$:

First@SolveValues[(3 Sqrt[9885093247/2])/1000000000 + 
     1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0 && 0 < a1 < 1, a1]
(*
Root[{-((3 Sqrt[9885093247/2])/2500000) - Sin[2 #1] + 2 #1 &, 
  0.40281671976983448667}]
*)

Final success

Use the transcendental Root[] object, which is a representation of the exact root.

AsymptoticSolve[(Q1 Sqrt[
       30891/250 - (863 (Q1 + Q2 + Q3))/4000])/(10 Sqrt[10]) + 
   1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0,
 {a1,
  First@SolveValues[(3 Sqrt[9885093247/2])/1000000000 + 
       1/100 (-(a1/2) + 1/4 Sin[2 a1]) == 0 && 0 < a1 < 1, a1]
  },
 {{Q1, Q2, Q3}, Rationalize@{0.0006, 0.0005, 0.00045}, 4},
 Reals]
(* large 0.6MB output omitted *)

% // N

Mathematica graphics

$\endgroup$
1
  • $\begingroup$ Superb. Nice to know. Thank you. $\endgroup$
    – josh
    May 27, 2023 at 20:02

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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