C4:=proc() local P,x,Pu,a,b,c,d,dPu,ddPu,L,alpha,beta,u,v,x1,x2,p,q, Eq_resol,Delta,s,r,z1,solr,r1,r2,z2,sol1,sol2,sol3, bo1,bo2,p1,p2,p3,p4,z,A,B,lambda,Sol,LF; ## Argument testing if nargs<>1 then ERROR(`Argument should be a 4th degree polynomial`);fi: P:=args[1]: if not type(P,polynom) then ERROR(`Argument should be a 4th degree polynomial`);fi: P:=expand(P); if not degree(P)=4 then ERROR(`Argument should be a 4th degree polynomial`);fi: ## coefficient computation x:=op(indets(P));lambda:=lcoeff(P,x); if is(lambda<0) then ERROR(`coP is identically `, -infinity);fi; Pu:=P/lambda; a:=coeff(Pu,x,3);b:=coeff(Pu,x,2);c:=coeff(Pu,x,1);d:=coeff(Pu,x,0); dPu:=diff(Pu,x):dPu:=unapply(dPu,x);ddPu:=diff(dPu(x),x):ddPu:=unapply(ddPu,x); P:=unapply(P,x); #We solve X^3+p*X+q, with X=x+a/4; p:=1/2*b-3/16*a^2;q:=1/32*a^3-1/8*a*b+1/4*c; Eq_resol:=X^2+(q-s/4)*X-p^3/27; Delta:=(q-s/4)^2+4*p^3/27; assume(s,real);additionally(Delta>0); # There is a unique real root r1:=eval(1/2*(s/4-q+sqrt(Delta)));r2:=eval(1/2*(s/4-q-sqrt(Delta))); z1:=surd(r1,3);z2:=surd(r2,3); solr:=unapply(z1+z2,s)-a/4; ## Cardan's Formula if 3*a^2-8*b<=0 then lprint(`P is a convex polynomial`); Sol:=subs(s=ss/lambda,solr(s)):Sol:=unapply(Sol,ss); LF:=s*Sol(s)-P(Sol(s)); LF:=unapply(LF,s); [Sol,LF]; else u:=lambda*(1/8*a^3-1/2*a*b+c);v:=lambda*(1/64*a^4-1/8*b*a^2+1/4*b^2-d); L:=solve(ddPu(x),x);alpha:=min(L);beta:=max(L); x1:=-1/4*a-1/4*sqrt(3*a^2-8*b);x2:=-1/4*a+1/4*sqrt(3*a^2-8*b); assume(s,real);additionally(Delta<0); # There are 3 real roots r1:=eval(1/2*(s/4-q+I*sqrt(-Delta))); z:=surd(r1,3);A:=Re(z); sol1:=unapply(2*A,s)-a/4; assume(s,real); bo1:=simplify(lambda*min(dPu(alpha),dPu(beta))); bo2:=simplify(lambda*max(dPu(alpha),dPu(beta))); Sol:=piecewise(tbo2,solr(t/lambda)); Sol:=unapply(Sol,t); LF:=s*Sol(s)-P(Sol(s));LF:=unapply(LF,s); [Sol,LF,u,v,x1,x2,bo1,bo2]; fi; end: