How to solve cubic equation analytically (exact solution) in R? - r

Question

I'm trying to get solution of cubic equations analytically in R, not numerically.
I looked up on the internet and get the formula for cubic roots and wrote the following code:
The link is: http://www.math.vanderbilt.edu/~schectex/courses/cubic/
cub <- function(a,b,c,d) {
p <- -b/3/a
q <- p^3 + (b*c-3*a*(d))/(6*a^2)
r <- c/3/a
x <- (q+(q^2+(r-p^2)^3)^0.5)^(1/3)+(q-(q^2+(r-p^2)^3)^0.5)^(1/3)+p
x
}
However this function doesn't work in most cases and I guess it's because of the power of negative numbers inside the formula, for example I noticed R cannot get the real root of (-8)^(1/3) which is -2. But Im not sure how I could fix my code so that it can be used to solve for exact cubic solutions in general.
Thanks.

Answer 1

I'd use polyroot(). See here for more details.
polyroot(z = c(8,0,0,1))
# [1] 1+1.732051i -2+0.000000i 1-1.732051i

Answer 2

Try this:
# calcaulate -8 as a complex number
z <- as.complex(-8) # or z <- -8 + 0i
# find all three cube roots
zroot3 <- z^(1/3) * exp(2*c(0:2)*1i*pi/3)
zroot3
## [1] 1+1.732051i -2+0.000000i 1-1.732051i
# check that all three cube roots cube to original
zroot3^3
## [1] -8+0i -8+0i -8-0i

Answer 3

If you only want the real root then here is another option:
> x <- c( -8,8 )
> sign(x) * abs(x)^(1/3)
[1] -2 2
Or you may be interested in the Ryacas package or the polynom package for other options.

Answer 4

Here is a function to compute all the analytical solutions: 'cubsol' . Any comments would be most welcome. One question - at the moment the code searches rather inefficiently for which the real solution is amongst the three complex ones produced by ... s2 = cuberoot(q-s0^0.5); xtemp[1:3] <- s1+ s2 +p; Is there a more efficient way of knowing which one it would be before calculating it?
# - - - - - - - - - - - - - - - - - - - -
# Return all the complex cube roots of a number
cuberoot <- function(x){
return( as.complex(x)^(1/3)*exp(c(0,2,4)*1i*pi/3) );
}
# - - - - - - - - - - - - - - - - - - - -
# cubsol solves analytically the cubic equation and
# returns a list whose first element is the real roots and the
# second element the complex roots.
# test with :
#a = -1; b=-10; c=0; d=50; x=0.01*(-1000:1500); plot(x,a*x^3+b*x^2+c*x+d,t='l'); abline(h=0)
# coefs = c(a,b,c,d)
cubsol <- function(coeffs) {
if (!(length(coeffs) == 4)){
stop('Please provide cubsol with a 4-vector of coefficients')
}
a = coeffs[1]; b=coeffs[2]; c=coeffs[3]; d=coeffs[4];
rts = list();
p <- -b/3/a
q <- p^3 + (b*c-3*a*(d))/(6*a^2)
r <- c/3/a
s0 = q^2+(r-p^2)^3;
xtemp = as.complex(rep(0,9));
if (s0 >= 0){ nReRts=1; } else {nReRts=3; }
# Now find all the roots in complex space:
s0 = as.complex(s0);
s1 = cuberoot(q+s0^0.5)
s2 = cuberoot(q-s0^0.5);
xtemp[1:3] <- s1+ s2 +p; # I think this is meant to always contain
# the sure real soln.
# Second and third solution;
iSqr3 = sqrt(3)*1i;
xtemp[4:6] = p - 0.5*(s1+s2 + iSqr3*(s1-s2));
xtemp[7:9] = p - 0.5*(s1+s2 - iSqr3*(s1-s2));
ind1 = which.min(abs(a*xtemp[1:3]^3 + b*xtemp[1:3]^2 +c*xtemp[1:3] +d))
ind2 = 3+which.min(abs(a*xtemp[4:6]^3 + b*xtemp[4:6]^2 +c*xtemp[4:6] +d))
ind3 = 6+which.min(abs(a*xtemp[7:9]^3 + b*xtemp[7:9]^2 +c*xtemp[7:9] +d))
if (nReRts == 1){
rts[[1]] = c(Re(xtemp[ind1]));
rts[[2]] = xtemp[c(ind2,ind3)]
} else { # three real roots
rts[[1]] = Re(xtemp[c(ind1,ind2,ind3)]);
rts[[2]] = numeric();
}
return(rts)
} # end of function cubsol