Why `AsymptoticSolve` doesn't work for a multivariate implicit function?

Question

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?

Answer 1

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