MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

Finding a continuous solution of a cubic

I am investigating the maxima and minima of the expression, e, below.
The expression is a quartic in x and has two parameters a and b which,
for my problem, are restricted to the range -1 < a < 1 and 0 < b (the
interesting part is 0<b<1).

I start with a simple approach and take the derivative with respect to
x and solve to find the three turning points. The solution is
complicated and not easy to examine. I work out the discriminant to
see when I will have three real roots or one and plot the region. I
work out three functions for the three roots r1, r2 and r3, and three
functions for the value of e at the roots, f1, f2, and f3. I am
expecting three real functions when within the region defined by the
discriminant and one outside this region. I plot the three roots and
the three functions (there are some artifacts where the functions turn
from real to complex, this is not a problem).

Now my problem. The function f3 is continuous in the region where
there are three solutions and this I like. Functions f1 and f2 are not
continuous but contain holes. If functions f1 and f2 are plotted
together then they each fill in the others holes. The holes makes my
life difficult because I do not have continuous functions.

Is it possible to make Solve find roots that will give rise to three
functions one corresponding to the maxima and two corresponding to
each minima without the functions crossing over and jumping between
the turning points?

I also notice, from the plots when shown together,  that my desired
functions are even with respect to the parameter a. Is this correct
and how would I show this if I can't assemble them as continuous


Hugh Goyder

e = ((1 - x)^2 + b*(-1 + a)^2)*((1 + x)^2 +
          b*(1 + a)^2);

d = Simplify[D[e, x]];

dis = Discriminant[d, x];

ContourPlot[dis, {a, -1, 1}, {b, 0, 1},
   ContourShading -> False, Contours -> {0},
   FrameLabel -> {"a", "b"}]

sol = Solve[d == 0, x];

ClearAll[x1, x2, x3, f1, f2, f3];
x1[a_, b_] := Evaluate[x /. sol[[1]]];
x2[a_, b_] := Evaluate[x /. sol[[2]]];
x3[a_, b_] := Evaluate[x /. sol[[3]]];
f1[a_, b_] := Evaluate[e /. sol[[1]]];
f2[a_, b_] := Evaluate[e /. sol[[2]]];
f3[a_, b_] := Evaluate[e /. sol[[3]]];

r1 = Plot3D[x1[a, b], {a, -1, 1}, {b, 0, 1}]

r2 = Plot3D[x2[a, b], {a, -1, 1}, {b, 0, 1}]

r3 = Plot3D[x3[a, b], {a, -1, 1}, {b, 0, 1}]

Show[r1, r2, r3, PlotRange -> All]

s1 = Plot3D[f1[a, b], {a, -1, 1}, {b, 0, 1}]

s2 = Plot3D[f2[a, b], {a, -1, 1}, {b, 0, 1}]

s3 = Plot3D[f3[a, b], {a, -1, 1}, {b, 0, 2}]

Show[s1, s2]

  • Prev by Date: Re: Re: Re: "Assuming"
  • Next by Date: Re: Re: Re: "Assuming"
  • Previous by thread: Re: Normalize a collection of arrays on a specific column
  • Next by thread: Re: Finding a continuous solution of a cubic