0
$\begingroup$

As I'm only interested in real solutions. I've tried restricting the Solve to Reals but it never solves it. Leaving out the Solve[_,Reals] can get a solution, but it ends up with (sometimes vanishingly small) complex components. Maybe it's just too many [if a>b's and c<=d's grandmothers and b<h's second cousins scenarios] for it to solve?

Also my approach may not be the most elegant here, so any help would be greatly appreciated! (I do need to "functionalize" any Real solutions as I'll likely be using this in some other program)

Print["function"]
y[a_, b_, c_, d_, e_, f_, g_, h_, x_] := 
  a*Log[1 - e*x] + b*Log[1 - f*x] + c*Log[1 + g*x] + d*Log[1 + h*x];
y[a, b, c, d, e, f, g, h, x]

Print["derivative"]
(*dEV1[b,Subscript[p, 1],x]=D[EV1[b,Subscript[p, 1] ,x],x]*)
yprime[a_, b_, c_, d_, e_, f_, g_, h_, x_] := 
  D[y[a, b, c, d, e, f, g, h, x], x];
(*dEV1[b_,p1_,x_]:=D[EV1[b,Subscript[p, 1] ,x],x];*)
yprime[a, b, c, d, e, f, g, h, x]

Print["solve"]
sol1 = Solve[yprime[a, b, c, d, e, f, g, h, x] == 0, x]
sol2 = Refine[
  Reduce[yprime[a_, b_, c_, d_, e_, f_, g_, h_, x_] == 0, {a, b, c, d,
     e, f, g, h, x}], 
  Assumptions -> 
   a > 0 && b > 0 && c > 0 && d > 0 && e > 0 && f > 0 && g > 0 && 
    h > 0]

Print["Functionalize solution rules"]
z1 = x /. sol1[[1]];
z2 = x /. sol1[[2]];
fsol11[a_, b_, c_, d_, e_, f_, g_, h_] = 
 z1 /. {a -> a, b -> b, c -> c, d -> d, e -> e, f -> f, g -> g, h -> h}
fsol12[a_, b_, c_, d_, e_, f_, g_, h_] = 
 z2 /. {a -> a, b -> b, c -> c, d -> d, e -> e, f -> f, g -> g, h -> h}

Print["Example"]
fsol11[1, 2, 3, 4, 5, 6, 7, 8]
fsol12[1, 2, 3, 4, 5, 6, 7, 8]
$\endgroup$

1 Answer 1

3
$\begingroup$

This is a bit hard to follow. One thing to note is that without knowing more about ranges for parameters, it is impossible to say whether one or three roots will be real, and, if one, which one it will be. Also with eight parameters, getting a careful description of what roots are real in what part of parameter space will be both slow and memory intensive (uses variants of quantifier elimination).

As for small imaginary parts, those are artifacts of numerically evaluating Cardano-Tartaglia formulas in cases where all roots are actually real. A way to bypass that is to avoid those formulas in the solution set. Also note that Reduce[yprime[a_, b_, c_, d_, e_, f_, g_, h_, x_] == 0... gives error messages due to (mis) use of pattern variables a_ instead of a and the like.

Here is a simplified version of the setup and solution process.

yprimeExpr = (a*e)/(1 - e*x) - (b*f)/(1 - f*x) + (c*g)/(1 + g*x) + (d*
      h)/(1 + h*x);
params = {a, b, c, d, e, f, g, h};
solVals = x /. Solve[yprimeExpr == 0, x, Cubics -> False]

(* Out[142]= {Root[-a e + b f - c g - 
    d h + (a e f - b e f - a e g + c e g + b f g + c f g - a e h + 
       d e h + b f h + d f h - c g h - d g h) #1 + (a e f g - 
       b e f g - c e f g + a e f h - b e f h - d e f h - a e g h + 
       c e g h + d e g h + b f g h + c f g h + 
       d f g h) #1^2 + (a e f g h - b e f g h - c e f g h - 
       d e f g h) #1^3 &, 1], 
 Root[-a e + b f - c g - 
    d h + (a e f - b e f - a e g + c e g + b f g + c f g - a e h + 
       d e h + b f h + d f h - c g h - d g h) #1 + (a e f g - 
       b e f g - c e f g + a e f h - b e f h - d e f h - a e g h + 
       c e g h + d e g h + b f g h + c f g h + 
       d f g h) #1^2 + (a e f g h - b e f g h - c e f g h - 
       d e f g h) #1^3 &, 2], 
 Root[-a e + b f - c g - 
    d h + (a e f - b e f - a e g + c e g + b f g + c f g - a e h + 
       d e h + b f h + d f h - c g h - d g h) #1 + (a e f g - 
       b e f g - c e f g + a e f h - b e f h - d e f h - a e g h + 
       c e g h + d e g h + b f g h + c f g h + 
       d f g h) #1^2 + (a e f g h - b e f g h - c e f g h - 
       d e f g h) #1^3 &, 3]} *)

numVals = solVals /. Thread[params -> Range[8]]

(* Out[143]= {Root[23 - 133 #1 - 1332 #1^2 + 6720 #1^3 &, 1], 
 Root[23 - 133 #1 - 1332 #1^2 + 6720 #1^3 &, 2], 
 Root[23 - 133 #1 - 1332 #1^2 + 6720 #1^3 &, 3]} *)

N[numVals]

(* Out[144]= {-0.135244652481, 0.116811092527, 0.216647845668} *)
$\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.