1
$\begingroup$

I have a system of algebraic equations with 9 equations and 19 unknowns. The system is

system = {n^4*\[Gamma]*Subscript[A, 0]^4 - n^4*\[Omega]*Subscript[A, 0]^4 + n^4*Subscript[A, 0]^3*Subscript[c, 1] + n^4*Subscript[A, 0]^2*Subscript[c, 2] + 
  n^4*Subscript[A, 0]*Subscript[c, 3] + n^4*Subscript[c, 4] - n^4*\[Kappa]^2*Subscript[A, 0]^4*Subscript[\[Alpha], 1] - 
  3*n^4*\[Kappa]^4*Subscript[A, 0]^4*Subscript[\[Alpha], 2] + n^4*\[Kappa]*Subscript[A, 0]^4*Subscript[\[Beta], 1] + n^4*Subscript[A, 0]^5*Subscript[\[Mu], 1] + 
  n^4*Subscript[A, 0]^6*Subscript[\[Mu], 2] + n^4*Subscript[A, 0]^7*Subscript[\[Mu], 3] + n^4*Subscript[A, 0]^8*Subscript[\[Mu], 4] == 0 && 
4*n^4*\[Gamma]*Subscript[A, 0]^3*Subscript[A, 1] - 4*n^4*\[Omega]*Subscript[A, 0]^3*Subscript[A, 1] + 3*n^4*Subscript[A, 0]^2*Subscript[A, 1]*
   Subscript[c, 1] + 2*n^4*Subscript[A, 0]*Subscript[A, 1]*Subscript[c, 2] + n^4*Subscript[A, 1]*Subscript[c, 3] - 
  4*n^4*\[Kappa]^2*Subscript[A, 0]^3*Subscript[A, 1]*Subscript[\[Alpha], 1] + n^3*Subscript[a, 1]^2*Subscript[A, 0]^3*Subscript[A, 1]*Subscript[\[Alpha], 1] - 
  12*n^4*\[Kappa]^4*Subscript[A, 0]^3*Subscript[A, 1]*Subscript[\[Alpha], 2] + 6*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[A, 0]^3*Subscript[A, 1]*
   Subscript[\[Alpha], 2] + n^3*Subscript[a, 1]^4*Subscript[A, 0]^3*Subscript[A, 1]*Subscript[\[Alpha], 2] + 4*n^4*\[Kappa]*Subscript[A, 0]^3*Subscript[A, 1]*
   Subscript[\[Beta], 1] + 5*n^4*Subscript[A, 0]^4*Subscript[A, 1]*Subscript[\[Mu], 1] + 6*n^4*Subscript[A, 0]^5*Subscript[A, 1]*Subscript[\[Mu], 2] + 
  7*n^4*Subscript[A, 0]^6*Subscript[A, 1]*Subscript[\[Mu], 3] + 8*n^4*Subscript[A, 0]^7*Subscript[A, 1]*Subscript[\[Mu], 4] == 0 && 
6*n^4*\[Gamma]*Subscript[A, 0]^2*Subscript[A, 1]^2 - 6*n^4*\[Omega]*Subscript[A, 0]^2*Subscript[A, 1]^2 + 3*n^4*Subscript[A, 0]*Subscript[A, 1]^2*
   Subscript[c, 1] + n^4*Subscript[A, 1]^2*Subscript[c, 2] - 3*n^3*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 0]^3*Subscript[A, 1]*
   Subscript[\[Alpha], 1] - 6*n^4*\[Kappa]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 1] + n^2*Subscript[a, 1]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*
   Subscript[\[Alpha], 1] + 2*n^3*Subscript[a, 1]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 1] - 
  18*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 0]^3*Subscript[A, 1]*Subscript[\[Alpha], 2] - 
  15*n^3*Subscript[a, 1]^4*Subscript[a, 2]*Subscript[A, 0]^3*Subscript[A, 1]*Subscript[\[Alpha], 2] - 18*n^4*\[Kappa]^4*Subscript[A, 0]^2*Subscript[A, 1]^2*
   Subscript[\[Alpha], 2] + 6*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 
  12*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 7*n^2*Subscript[a, 1]^4*Subscript[A, 0]^2*
   Subscript[A, 1]^2*Subscript[\[Alpha], 2] - 4*n^3*Subscript[a, 1]^4*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 
  6*n^4*\[Kappa]*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Beta], 1] + 10*n^4*Subscript[A, 0]^3*Subscript[A, 1]^2*Subscript[\[Mu], 1] + 
  15*n^4*Subscript[A, 0]^4*Subscript[A, 1]^2*Subscript[\[Mu], 2] + 21*n^4*Subscript[A, 0]^5*Subscript[A, 1]^2*Subscript[\[Mu], 3] + 
  28*n^4*Subscript[A, 0]^6*Subscript[A, 1]^2*Subscript[\[Mu], 4] == 0 && 
4*n^4*\[Gamma]*Subscript[A, 0]*Subscript[A, 1]^3 - 4*n^4*\[Omega]*Subscript[A, 0]*Subscript[A, 1]^3 + n^4*Subscript[A, 1]^3*Subscript[c, 1] + 
  2*n^3*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 0]^3*Subscript[A, 1]*Subscript[\[Alpha], 1] - 2*n^2*Subscript[a, 1]^2*Subscript[a, 2]*
   Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 1] - 7*n^3*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 0]^2*Subscript[A, 1]^2*
   Subscript[\[Alpha], 1] - 4*n^4*\[Kappa]^2*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 1] + 2*n^2*Subscript[a, 1]^2*Subscript[A, 0]*Subscript[A, 1]^3*
   Subscript[\[Alpha], 1] + n^3*Subscript[a, 1]^2*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 1] + 12*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]^2*
   Subscript[A, 0]^3*Subscript[A, 1]*Subscript[\[Alpha], 2] + 50*n^3*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 0]^3*Subscript[A, 1]*
   Subscript[\[Alpha], 2] - 12*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] - 
  42*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] - 
  50*n^2*Subscript[a, 1]^4*Subscript[a, 2]*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 
  5*n^3*Subscript[a, 1]^4*Subscript[a, 2]*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] - 12*n^4*\[Kappa]^4*Subscript[A, 0]*Subscript[A, 1]^3*
   Subscript[\[Alpha], 2] + 12*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 
  6*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 6*n*Subscript[a, 1]^4*Subscript[A, 0]*Subscript[A, 1]^3*
   Subscript[\[Alpha], 2] - 4*n^2*Subscript[a, 1]^4*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 
  n^3*Subscript[a, 1]^4*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 4*n^4*\[Kappa]*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Beta], 1] + 
  10*n^4*Subscript[A, 0]^2*Subscript[A, 1]^3*Subscript[\[Mu], 1] + 20*n^4*Subscript[A, 0]^3*Subscript[A, 1]^3*Subscript[\[Mu], 2] + 
  35*n^4*Subscript[A, 0]^4*Subscript[A, 1]^3*Subscript[\[Mu], 3] + 56*n^4*Subscript[A, 0]^5*Subscript[A, 1]^3*Subscript[\[Mu], 4] == 0 && 
n^4*\[Gamma]*Subscript[A, 1]^4 - n^4*\[Omega]*Subscript[A, 1]^4 + n^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*
   Subscript[\[Alpha], 1] + 5*n^3*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 1] - 
  4*n^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 1] - 5*n^3*Subscript[a, 1]^2*Subscript[a, 2]*
   Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 1] - n^4*\[Kappa]^2*Subscript[A, 1]^4*Subscript[\[Alpha], 1] + 
  n^2*Subscript[a, 1]^2*Subscript[A, 1]^4*Subscript[\[Alpha], 1] - 60*n^3*Subscript[a, 1]^4*Subscript[a, 2]^3*Subscript[A, 0]^3*Subscript[A, 1]*
   Subscript[\[Alpha], 2] + 6*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 
  30*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 
  115*n^2*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 
  35*n^3*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] - 
  24*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] - 
  30*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] - 
  30*n*Subscript[a, 1]^4*Subscript[a, 2]*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] - 10*n^2*Subscript[a, 1]^4*Subscript[a, 2]*
   Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] - 5*n^3*Subscript[a, 1]^4*Subscript[a, 2]*Subscript[A, 0]*Subscript[A, 1]^3*
   Subscript[\[Alpha], 2] - 3*n^4*\[Kappa]^4*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 6*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 
  Subscript[a, 1]^4*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + n^4*\[Kappa]*Subscript[A, 1]^4*Subscript[\[Beta], 1] + 
  5*n^4*Subscript[A, 0]*Subscript[A, 1]^4*Subscript[\[Mu], 1] + 15*n^4*Subscript[A, 0]^2*Subscript[A, 1]^4*Subscript[\[Mu], 2] + 
  35*n^4*Subscript[A, 0]^3*Subscript[A, 1]^4*Subscript[\[Mu], 3] + 70*n^4*Subscript[A, 0]^4*Subscript[A, 1]^4*Subscript[\[Mu], 4] == 0 && 
2*n^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 1] + 4*n^3*Subscript[a, 1]^2*Subscript[a, 2]^2*
   Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 1] - 2*n^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 1]^4*Subscript[\[Alpha], 1] - 
  n^3*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 1]^4*Subscript[\[Alpha], 1] + 24*n^3*Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 0]^3*
   Subscript[A, 1]*Subscript[\[Alpha], 2] - 108*n^2*Subscript[a, 1]^4*Subscript[a, 2]^3*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] - 
  72*n^3*Subscript[a, 1]^4*Subscript[a, 2]^3*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 
  12*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 
  24*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 
  54*n*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 68*n^2*Subscript[a, 1]^4*Subscript[a, 2]^2*
   Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 28*n^3*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 0]*Subscript[A, 1]^3*
   Subscript[\[Alpha], 2] - 12*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 1]^4*Subscript[\[Alpha], 2] - 
  6*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]*Subscript[A, 1]^4*Subscript[\[Alpha], 2] - 4*Subscript[a, 1]^4*Subscript[a, 2]*Subscript[A, 1]^4*
   Subscript[\[Alpha], 2] - 6*n*Subscript[a, 1]^4*Subscript[a, 2]*Subscript[A, 1]^4*Subscript[\[Alpha], 2] - 4*n^2*Subscript[a, 1]^4*Subscript[a, 2]*
   Subscript[A, 1]^4*Subscript[\[Alpha], 2] - n^3*Subscript[a, 1]^4*Subscript[a, 2]*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 
  n^4*Subscript[A, 1]^5*Subscript[\[Mu], 1] + 6*n^4*Subscript[A, 0]*Subscript[A, 1]^5*Subscript[\[Mu], 2] + 
  21*n^4*Subscript[A, 0]^2*Subscript[A, 1]^5*Subscript[\[Mu], 3] + 56*n^4*Subscript[A, 0]^3*Subscript[A, 1]^5*Subscript[\[Mu], 4] == 0 && 
n^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 1]^4*Subscript[\[Alpha], 1] + n^3*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 1]^4*
   Subscript[\[Alpha], 1] + 36*n^2*Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] + 
  36*n^3*Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 0]^2*Subscript[A, 1]^2*Subscript[\[Alpha], 2] - 
  42*n*Subscript[a, 1]^4*Subscript[a, 2]^3*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] - 90*n^2*Subscript[a, 1]^4*Subscript[a, 2]^3*
   Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] - 48*n^3*Subscript[a, 1]^4*Subscript[a, 2]^3*Subscript[A, 0]*Subscript[A, 1]^3*
   Subscript[\[Alpha], 2] + 6*n^2*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 
  6*n^3*\[Kappa]^2*Subscript[a, 1]^2*Subscript[a, 2]^2*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 6*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 1]^4*
   Subscript[\[Alpha], 2] + 18*n*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 
  19*n^2*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 7*n^3*Subscript[a, 1]^4*Subscript[a, 2]^2*Subscript[A, 1]^4*
   Subscript[\[Alpha], 2] + n^4*Subscript[A, 1]^6*Subscript[\[Mu], 2] + 7*n^4*Subscript[A, 0]*Subscript[A, 1]^6*Subscript[\[Mu], 3] + 
  28*n^4*Subscript[A, 0]^2*Subscript[A, 1]^6*Subscript[\[Mu], 4] == 0 && 
12*n*Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 36*n^2*Subscript[a, 1]^4*Subscript[a, 2]^4*
   Subscript[A, 0]*Subscript[A, 1]^3*Subscript[\[Alpha], 2] + 24*n^3*Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 0]*Subscript[A, 1]^3*
   Subscript[\[Alpha], 2] - 4*Subscript[a, 1]^4*Subscript[a, 2]^3*Subscript[A, 1]^4*Subscript[\[Alpha], 2] - 18*n*Subscript[a, 1]^4*Subscript[a, 2]^3*
   Subscript[A, 1]^4*Subscript[\[Alpha], 2] - 26*n^2*Subscript[a, 1]^4*Subscript[a, 2]^3*Subscript[A, 1]^4*Subscript[\[Alpha], 2] - 
  12*n^3*Subscript[a, 1]^4*Subscript[a, 2]^3*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + n^4*Subscript[A, 1]^7*Subscript[\[Mu], 3] + 
  8*n^4*Subscript[A, 0]*Subscript[A, 1]^7*Subscript[\[Mu], 4] == 0 && Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 
  6*n*Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + 11*n^2*Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 1]^4*
   Subscript[\[Alpha], 2] + 6*n^3*Subscript[a, 1]^4*Subscript[a, 2]^4*Subscript[A, 1]^4*Subscript[\[Alpha], 2] + n^4*Subscript[A, 1]^8*Subscript[\[Mu], 4] == 0}

and unknowns are

 unknowns={n, \[Gamma], \[Kappa], \[Omega], Subscript[a, 1], Subscript[a, 2], \
Subscript[A, 0], Subscript[A, 1], Subscript[c, 1], Subscript[c, 2], \
Subscript[c, 3], Subscript[c, 4], Subscript[\[Alpha], 1], Subscript[\
\[Alpha], 2], Subscript[\[Beta], 1], Subscript[\[Mu], 1], Subscript[\
\[Mu], 2], Subscript[\[Mu], 3], Subscript[\[Mu], 4]} 

I want to solve the system analytically in Mathematica using Solve or Reduce etc. where Subscript[A, 1] != 0].

 Solve[system, Union[{Subscript[A, 0], Subscript[A, 1]}, {\[Gamma], \[Kappa], \[Omega], Subscript[\[Alpha], 1], Subscript[\[Beta], 1], Subscript[a, 1], Subscript[a, 2]}], 
   Assumptions -> Subscript[A, 1] != 0]; 

But, even if I wait 5 hours after evaluating, Mathematica does not give any results.

Question: Except the parameter Subscript[A, 0], Subscript[A, 1], there are 17 unknowns. The number of the all subsets of is 2^(17). How can we determine the parameters that will be used in the Solve in addition to Subscript[A, 0], Subscript[A, 1]?

$\endgroup$
7
  • 1
    $\begingroup$ These equations are highly non-linear. What analytical solution could you possibly expect here? If Mathematica could even give a single solution for one of the unknowns, what could you do? The answer will be pages and pages long. $\endgroup$ Apr 14, 2023 at 13:20
  • $\begingroup$ I am a Ph.D student and deal with highly nonlinear system of equations and wonder how to develop a viewpoint to get solution sets for cases like this. In Solve, when we use several parameters in addition to A_0,A_1, I think the obtained solution sets won't be page. (As I see on the other highly nonlinear systems) $\endgroup$
    – HD239
    Apr 14, 2023 at 13:55
  • 1
    $\begingroup$ Isn't this art for art's sake? $\endgroup$
    – user64494
    Apr 14, 2023 at 14:18
  • 1
    $\begingroup$ LeafCount[system] and then LeafCount[Simplify[system]] doesn't solve anything but does show it is possible to cut the size by more than half in a few seconds. That might help Solve or Reduce. Replacing all those Subscript with shorter ordinary names might also help. You can put all your Subscript back if you get the solution $\endgroup$
    – Bill
    Apr 14, 2023 at 14:37
  • 1
    $\begingroup$ I'd suggest that you work your way up. Start with a made-up simpler system of equations -- maybe 2 equations and 3 unknowns with some of the same nonlinearities. If you can solve that, add some more unknowns and equations. This way, you may get an idea of what is feasible. $\endgroup$
    – bill s
    Apr 14, 2023 at 14:42

1 Answer 1

1
$\begingroup$

Determining the parameters to be used in Solve, in addition to {Subscript[A, 0], Subscript[A, 1]}, as requested at the closing of the question above, is not a trivial task but can be accomplished. For simplicity, isolate and work with the left sides of the nine equations

eq = Simplify[Subtract @@@ List @@ system[[1]]];

The first step is to replace Subscript, which saves substantial computational time and memory. A simple approach is

map = Thread[Variables[eq] -> Table[Unique["x"], 19]]
eq1 = eq /. map;
(* {n -> x11, γ -> x12, κ -> x13, ω -> x14, Subscript[a, 1] -> x15, 
    Subscript[a, 2] -> x16, Subscript[A, 0] -> x17, Subscript[A, 1] -> x18, 
    Subscript[c, 1] -> x19, Subscript[c, 2] -> x20, Subscript[c, 3] -> x21, 
    Subscript[c, 4] -> x22, Subscript[α, 1] -> x23, Subscript[α, 2] -> x24, 
    Subscript[β, 1] -> x25, Subscript[μ, 1] -> x26, Subscript[μ, 2] -> x27, 
    Subscript[μ, 3] -> x28, Subscript[μ, 4] -> x29} *)

Several of the equations contain multiplicative factors of x18 and x11. Since the question states that x18 != 0, multiplicative powers of it can be set to 1. Similarly, multiplicative powers of x11, which may equal 0, can be set to x11. These savings are modest, but every bit helps.

FactorList /@ eq1;
DeleteCases[%, {x18, _}, 4] /. {x11, _Integer} -> {x11, 1};
eq2 = (Times @@ Power @@@ #) & /@ %

Examination of eq2 (which is rather long to reproduce here) indicates that 13 variables enter linearly.

linvar = {x12, x14, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29};

which can be demonstrated by

CoefficientArrays[eq2, linvar]

enter image description here

mat = % // Last // Normal;
FreeQ[mat, Alternatives @@ linvar]
(* True*)

Solving directly for any nine linvar variables is straightforward, if the corresponding matrix has rank 9; i.e., the corresponding determinant does not vanish.

f[v_] := Module[{rank}, 
    rank = CoefficientArrays[eq2, v] // Last // Normal // MatrixRank; 
    If[rank == 9, v, Nothing]]
f /@ Subsets[linvar, {9}]

115 nine-element subsets of linvar meet this requirement. For instance,

Solve[Thread[eq2 == 0], {x12, x19, x20, x21, x22, x23, x24, x26, x28}]

produces results in terms of the remaining ten variables in just a few seconds. However, the OP requested solutions for x17 and x18, which do not enter the equations linearly. The approach I took was to Solve seven of the nine equations in eq2 for variables from linvar and substitute the results into the remaining two equations to obtain two polynomial expressions for x17 and x18. Because they have fewest terms, the remaining two are selected as eq[[8;]]. They can be further simplified by

eq3 = ReplacePart[eq2, 8 -> Collect[eq2[[8]] - 8 x17 eq2[[9]], 
   {x24, x28, x29}, Simplify]]

where {x24, x28, x29} are the remaining linvar variables in those two equations. To find an additional four linvar variables, I proceeded as above.

g[v_] := Module[{rank}, 
    rank = CoefficientArrays[eq2[[;; 7]], Join[v, {x24, x28, x29}]] 
    // Last // Normal // MatrixRank; If[rank == 7, v, Nothing]]
 g /@ Subsets[Complement[linvar, {x24, x28, x29}], {4}]

which yields 140 possibilities. Choose

Solve[Thread[eq3[[;; 7]] == 0], {x23, x24, x25, x26, x27, x28, x29}] // Flatten;
Numerator /@ Together /@ (eq3[[8 ;;]] /. %);
Last /@ FactorList /@ %;
eq4 = Collect[% /. {z_, 1} -> z, {x18, x17}, Simplify]

Once again, the two new equations contain multiplicative factors that do not yield useful results. So, I removed them. Here are the two equations in final form.

{2 (2 + 9 x11 - 41 x11^2 + 30 x11^3) x16^3 x17^6 x19 + 
     4 (4 + 20 x11 - 71 x11^2 + 30 x11^3) x16^3 x17^5 x20 + 
     14 (2 + 13 x11 - 37 x11^2) x16^3 x17^4 x21 - 
     16 x11 (-14 + 31 x11 + 30 x11^2) x16^3 x17^3 x22 + 
 x18^3 ((-10 + 81 x11 - 173 x11^2 + 102 x11^3) x17^3 x19 + (-20 + 
     152 x11 - 275 x11^2 + 102 x11^3) x17^2 x20 + 
     7 x11 (2 + 17 x11 - 39 x11^2) x17 x21 + 
     4 (20 - 88 x11 + 195 x11^2 - 162 x11^3) x22) + 
 x18^2 (4 (-4 + 45 x11 - 107 x11^2 + 
     66 x11^3) x16 x17^4 x19 + (-52 + 496 x11 - 967 x11^2 + 
     366 x11^3) x16 x17^3 x20 - 
     7 (10 - 79 x11 + 85 x11^2 + 66 x11^3) x16 x17^2 x21 + 
     4 (12 - 92 x11 + 391 x11^2 - 510 x11^3) x16 x17 x22) + 
 x18 ((-2 + 117 x11 - 337 x11^2 + 222 x11^3) x16^2 x17^5 x19 + 
     8 (-2 + 53 x11 - 122 x11^2 + 48 x11^3) x16^2 x17^4 x20 - 
     7 (10 - 115 x11 + 187 x11^2 + 24 x11^3) x16^2 x17^3 x21 - 
     16 (14 - 49 x11 + 15 x11^2 + 108 x11^3) x16^2 x17^2 x22), 
 (1 + 6 x11 - 25 x11^2 + 18 x11^3) x16^3 x17^6 x19 + 
     2 (2 + 13 x11 - 43 x11^2 + 18 x11^3) x16^3 x17^5 x20 + (7 + 
     56 x11 - 149 x11^2 - 6 x11^3) x16^3 x17^4 x21 - 
     56 x11 (-1 + 2 x11 + 3 x11^2) x16^3 x17^3 x22 + 
 x18^3 (3 (-1 + 8 x11 - 17 x11^2 + 10 x11^3) x17^3 x19 + 
     3 (-2 + 15 x11 - 27 x11^2 + 10 x11^3) x17^2 x20 + (1 - 3 x11 + 
     50 x11^2 - 90 x11^3) x17 x21 - 
     14 (-2 + 9 x11 - 19 x11^2 + 15 x11^3) x22) + 
 x18^2 ((-5 + 54 x11 - 127 x11^2 + 78 x11^3) x16 x17^4 x19 + 
     2 (-8 + 74 x11 - 143 x11^2 + 54 x11^3) x16 x17^3 x20 - (19 - 
     148 x11 + 139 x11^2 + 162 x11^3) x16 x17^2 x21 + 
     14 (2 - 13 x11 + 42 x11^2 - 48 x11^3) x16 x17 x22) + 
 x18 ((-1 + 36 x11 - 101 x11^2 + 66 x11^3) x16^2 x17^5 x19 + 
     3 (-2 + 43 x11 - 97 x11^2 + 38 x11^3) x16^2 x17^4 x20 - 
     3 (7 - 77 x11 + 120 x11^2 + 24 x11^3) x16^2 x17^3 x21 - 
     28 (2 - 6 x11 - 2 x11^2 + 21 x11^3) x16^2 x17^2 x22)}

The order of these two polynomials are third in x18 and sixth in x17, as can be seen from

Dimensions[CoefficientList[eq4, x18]]
(* {2, 4} *)
Dimensions[CoefficientList[eq4, x17]]
(* {2, 7} *)

The straightforward attempt to Solve them with

Solve[Thread[eq4 == 0], {x17,x18}] 

ran for some 18 hours without result. (Simplified problems I attempted to solve with Reduce and GroebnerBasis also failed to produce results in a reasonable amount of time.) Nonetheless, Mathematica can solve these equations without difficulty, if given some assistance. Define

tmplt = Thread[Flatten[{{a0, a1, a2, a3}, {b0, b1, b2, b3}}] -> 
    Flatten[CoefficientList[eq4, x18]]]

The eq4 can be represented by

eqab = {a3 z^3 + a2 z^2 + a1 z + a0 == 0, b3 z^3 + b2 z^2 + b1 z + b0 == 0}

where z is used instead of x18 for brevity. Applying Eliminate then gives

Subtract @@ Eliminate[{a3 z^3 + a2 z^2 + a1 z + a0 == 0, 
    b3 z^3 + b2 z^2 + b1 z + b0 == 0}, z] // Simplify
(* a0^3 b3^3 - a0^2 (b3 (-a2 b2^2 + 2 a2 b1 b3 + a1 b2 b3) + 
   a3 (b2^3 - 3 b1 b2 b3 + 3 b0 b3^2)) - 
   b0 (a3^3 b0^2 + a3^2 (-a2 b0 b1 + a1 (b1^2 - 2 b0 b2)) + 
   b3 (-a2^3 b0 + a1 a2^2 b1 - a1^2 a2 b2 + a1^3 b3) + 
   a3 (a2^2 b0 b2 + a1 a2 (-b1 b2 + 3 b0 b3) + a1^2 (b2^2 - 2 b1 b3))) + 
   a0 (a3^2 (b1^3 - 3 b0 b1 b2 + 3 b0^2 b3) + 
   b3 (a2^2 (b1^2 - 2 b0 b2) + a1^2 b1 b3 + a1 a2 (-b1 b2 + 3 b0 b3)) + 
   a3 (a2 (-b1^2 b2 + 2 b0 b2^2 + b0 b1 b3) + a1 (b1 b2^2 - 2 b1^2 b3 - b0 b2 b3))) *)

In other words, the two equations can be solved only if the consistency condition just given equals 0. Now, inserting values for the a and b parameters yields

FactorList[% /. tmplt][[-2 ;;]];
eq5 = Times @@ Power @@@ %;
Length[CoefficientList[eq5, x17]]
(* 12 *)

Only the last two of the 17 factors lead to solutions of interest.

Solve[%% == 0, x17] // Flatten

The solutions, Sqrt and Root functions, are far too lengthy to reproduce here. With x17 now evaluated, x18 can be obtained in principle by substituting each of the eleven solutions for x17 in turn into either of eq5 and solving the resulting cubic equations. I emphasize that the results presented in this answer merely are sample results. The original set of equations has hundreds, perhaps thousands of distinct solutions, because it is underdetermined and also nonlinear in some variables.

$\endgroup$

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.