MaplePrimes - answers and comments on Question, Solve equation of 13th order with symbolic coefficient

degree too high

Axel Vogt — Wed, 20 Jun 2012 00:06:19 Z

Why do you expect a specific answer? You may try to search for solvable polynomial equations (Google, Wikipedia) and yours is not in a form, that I would expect something good.

Or as a rule of thumb: degree beyond 4 ---> forget it, impossible by theory. Or at least a bit more precise: one can not give explicit values using radicals (guessing that you expect such) in general

And thus a Computer system will reject the task, if it can not detect a special situation.

http://en.wikipedia.org/wiki/Polynomial#Solving_polynomial_equations says a bit more (and in the links there are 'cryptic' answers saying 'yes. we can', but actually that is *generally* useless, nobody knows how to handle that).

for what purpose

pagan — Wed, 20 Jun 2012 01:11:01 Z

What do you plan on doing with such an explicit set of 13 formulas for the roots? What if it were 100s of pages long?

Is it the case that, eventually, you will try and evaluate any of those formulas (or some mathematical function of them) at numeric values of theta?

Let's suppose that, eventually, you would try and use numeric root (as a function of real-values theta). Instead of explicitly inverting that degree 13 polynomial in q[b] you could construct a procedure that takes a numeric value of theta and returns the roots in q[b].

You could then pick off the smallest root, or do something else with them, for the given value of theta.

eg.

expr := 472392*q[b]^13+(-10392624*theta+12597120*theta^2)*q[b]^12+(90069408*theta^2+110697192*theta^4-207222624*theta^3)*q[b]^11+(318718800*theta^6-394931376*theta^3-1213796664*theta^5
+1269661392*theta^4)*q[b]^10+(-3766288752*theta^5+4657375260*theta^6
+957739788*theta^4-1782380376*theta^7+14700393*theta^8)*q[b]^9+(207696*theta^10
+6288766560*theta^6-36914598*theta^9-1374185736*theta^5
+4234180392*theta^8-9185729832*theta^7)*q[b]^8+(19428192*theta^10-5820095184*theta^9
+10977610320*theta^8-6491850624*theta^7-116480*theta^11+1225901952*theta^6)*q[b]^7
+(-8848975200*theta^9+5424037888*theta^10+4454542848*theta^8-709841664*theta^7
+12076160*theta^11+25600*theta^12)*q[b]^6+(284107776*theta^8-2169162752*theta^9
+5185955328*theta^10-14362624*theta^12-3764956416*theta^11)*q[b]^5+(819093504*theta^10+2011156480*theta^12-95922176*theta^9-2311908352*theta^11
+5013504*theta^13)*q[b]^4+(-818036736*theta^13-276840448*theta^11
+810954752*theta^12-655360*theta^14+36864000*theta^10)*q[b]^3
+(-221405184*theta^13+240451584*theta^14+78905344*theta^12
-10616832*theta^11)*q[b]^2+(-45088768*theta^15+39190528*theta^14
-9437184*theta^13)*q[b]-3670016*theta^15+4194304*theta^16:

getqb := proc(th)
local ans;
    ans := fsolve(eval(expr, theta = th), q[b], args[2 .. -1]);
    if type([ans], list(complex(numeric))) then ans else NULL end if
end proc:

expr:=convert(expr,'horner',q[b]):

getqb(7.2);

getqb(2.3);

getqb(2.3, q[b]=0..1);

getqb(2.3, complex);

plot(t->[getqb(t)][1],1..5); # 30-40 secs or so

Asymptotics

Markiyan Hirnyk — Thu, 21 Jun 2012 09:45:20 Z

We can solve it assigning theta:
> eq := 472392*q[b]^13+(-10392624*theta+12597120*theta^2)*q[b]^12+(90069408*theta^2+
110697192*theta^4-207222624*theta^3)*q[b]^11+(318718800*theta^6-394931376*theta^3-
1213796664*theta^5+1269661392*theta^4)*q[b]^10+(-3766288752*theta^5+
4657375260*theta^6+957739788*theta^4-1782380376*theta^7+
14700393*theta^8)*q[b]^9+(207696*theta^10+6288766560*theta^6-
36914598*theta^9-1374185736*theta^5+4234180392*theta^8-9185729832*theta^7)*q[b]^8+
(19428192*theta^10-5820095184*theta^9+10977610320*theta^8-6491850624*theta^7-
116480*theta^11+1225901952*theta^6)*q[b]^7+(-8848975200*theta^9+
5424037888*theta^10+4454542848*theta^8-709841664*theta^7+
12076160*theta^11+25600*theta^12)*q[b]^6+(284107776*theta^8-2169162752*theta^9+
5185955328*theta^10-14362624*theta^12-3764956416*theta^11)*q[b]^5+
(819093504*theta^10+2011156480*theta^12-95922176*theta^9-
2311908352*theta^11+5013504*theta^13)*q[b]^4+
(-818036736*theta^13-276840448*theta^11+
810954752*theta^12-655360*theta^14+36864000*theta^10)*q[b]^3+
(-221405184*theta^13+240451584*theta^14+78905344*theta^12-10616832*theta^11)*q[b]^2+
(-45088768*theta^15+39190528*theta^14-9437184*theta^13)*q[b]-
3670016*theta^15+4194304*theta^16;
> solve(eval(eq, theta = evalf((1/2)*Pi)), q[b]);# 13 roots
.3169642574, 1.811314241, 1.871481769+0.7720048819e-1*I, .9280360318+.5499794685*I,
.7108967030+.4834578213*I, .1114735171+1.175988673*I, -16.20152794+3.126680769*I,
-8.208842150, -16.20152794-3.126680769*I, .1114735171-1.175988673*I,
.7108967030-.4834578213*I, .9280360318-.5499794685*I, 1.871481769-0.7720048819e-1*I
Let's plot the zero level line of eq:
>plots:-implicitplot(eq = 0, theta = -6 .. 6, q[b] = -300 .. 10, numpoints = 10^6,
thickness = 2);

We see only one real root if abs(theta)>=2.5. In a larger scale the plot looks more
symmetric conserning the q[b]-axis for big theta.
Watching the plot, we make the suggestion that b[q]=a*theta^k asymptotically for big theta.
The numerical experiment gives the following.
> evalf(seq(log(-op(selectremove(c-> evalb(Im(c) <> 0), {solve(eval(eq, theta = evalf(10^j)),
q[b])})[2]))/(j*log(10)), j = 1 .. 20));
#We select the real zero and calculate the ratio of its logarithm to the logarithm of theta for
theta=10^j.

2.772058565, 2.401908740, 2.268958564, 2.201795099, 2.161442170, 2.134535650,

2.115316315, 2.100901780, 2.089690471, 2.080721424, 2.073383113,

2.067267853, 2.062093403, 2.057658160, 2.053814283, 2.050450890,

2.047483190, 2.044845236, 2.042484960, 2.040360712
For j=100 we obtain 2.008072142.
Assuming k=2, we find an approximate value of a as the ratio q[b](theta)/theta^2 for theta=10^j,
j=1..20.
> evalf(seq(op(selectremove(c-> evalb(Im(c) <> 0),
{solve(eval(eq, theta = evalf(10^j)), q[b])})[2])/10^(2*j), j = 1 .. 20));

-5.916414122, -6.365279527, -6.410260731, -6.414759778, -6.415209593,

    -6.415254624, -6.415259102, -6.415259633, -6.415259622, -6.415259619,

    -6.415259629, -6.415259629, -6.415259629, -6.415259629, -6.415259629,

    -6.415259629, -6.415259629, -6.415259629, -6.415259629, -6.415259629
In view of above we make a suggestion q[b] = -6.415259629*theta^2. The asympt command
fails to prove that both in Maple 13 (spinning) and Maple 16.01
(a very doubtful result a*theta^(2/3) with a positve value of the parameter a is produced).
Let us follow the usual way of asymptotic analysis:
>collect(eval(eq, q[b] = a*theta^2), theta);

> fsolve(110697192*a^11+318718800*a^10+207696*a^8+472392*a^13+14700393*a^9+

12597120*a^12);

-6.415259629, 0., 0., 0., 0., 0., 0., 0., 0.

degree.mw

thanks

dritsaev — Mon, 25 Jun 2012 13:35:55 Z

thank you all for your help and the work that you did for me!

the asymtotics idea is a great one-i haven't used it before. the problem is that the authors write that there exists a unique solution for q[a] and q[b]. i will try to contact them and ask them for a hint. again, thanks for your help, it will help me to solve my model-which is of higher degree.

purpose

dritsaev — Wed, 20 Jun 2012 11:31:19 Z

Thank you for your response.

I am trying to reproduce an economic model similar to mine. The purpose is to find the optimal q[a],q[b]. Thus, I have to solve the following 2x2 system (FOC):

They computed groebner bases, one of which-as they write- is the 12-order polynomial of q[b] which they solved and the result is: q[b]=0.418*theta. inserting it into the 1st equation gives q[a]=0.779*theta.

I used the groebner package but i have a 13-order polynomial in q[b] and i can't solve it. Note that all the parameters are real and positive.

Any ideas?

Proof of the asymptotics

Markiyan Hirnyk — Thu, 21 Jun 2012 15:08:46 Z

> A := collect(expand(eval(eq, q[b] = (a+r)*theta^2)), theta): #assumption q[b]=(a+r)*theta^2
> B := expand(simplify(A, {318718800*a^10+207696*a^8+472392*a^13+14700393*a^9+12597120*a^12+110697192*a^11 = 0})):

#simplification under the relation that a=-6.415259629

>limit(solve(B, r), theta = infinity);