1
$\begingroup$

Is there a Mathematica command that is a combination of Contour3D and ParametricPlot3D?

It would be something like this:

ParaContour3D[f==0, g==0, h==0, {t,0,1}, {x,-3,3}, {y,-3,3}, {z,-3,3}]

f, g, h are implicit equations for x, y, and z in terms of t. For example, we may have f = t^2 x^2 + t x + 2x - 1, g = t^2 y^3 + t y^2 + 2y - 1, h = 2t^2 z^3 + t z + 3z - t^2. The answer is a curve in space, or maybe several curves.

$\endgroup$
2
$\begingroup$

You could use NDSolveValue to create interpolating functions which you can then plot. Your equations:

f[x_, t_] := t^2 x^2 + t x + 2x - 1 == 0
g[y_, t_] := t^2 y^3 + t y^2 + 2y - 1 == 0
h[z_, t_] := 2t^2 z^3 + t z + 3z - t^2 == 0

To use NDSolveValue we need initial conditions:

x0 = x /. First @ Solve[f[x, 0], x]
y0 = y /. First @ Solve[g[y, 0], y]
z0 = z /. First @ Solve[h[z, 0], z]

1/2

1/2

0

Now for the NDSolveValue call:

sol = NDSolveValue[
    {
    D[f[x[t], t], t], D[g[y[t], t], t], D[h[z[t], t], t],
    x[0]==x0, y[0]==y0, z[0]==z0
    },
    {x[t], y[t], z[t]},
    {t, 0, 1}
];

Finally, the requested visualization:

ParametricPlot3D[sol, {t, 0, 1}]

enter image description here

$\endgroup$
  • $\begingroup$ Thanks! It works just as you say. Now I'll try it on the more complicated real examples I really want. $\endgroup$ – rfermat Feb 17 '18 at 15:14
  • $\begingroup$ Having now read about NDSolveValue, which I never knew about before, I see your method creates differential equations and solves those. This seems rather roundabout. Is there a more direct method? (My original problem does not involve differential equations.) $\endgroup$ – rfermat Feb 18 '18 at 13:49
0
$\begingroup$
f = t^2 x^2 + t x + 2 x - 1;
g = t^2 y^3 + t y^2 + 2 y - 1;
h = 2 t^2 z^3 + t z + 3 z - t^2;

TraditionalForm /@ (sol[t_] = {x, y, z} /. 
      Solve[{f == 0, g == 0, h == 0}, {x, y, z}, Reals] // 
     ToRadicals // FullSimplify[#, Element[t, Reals]] &)

enter image description here

Manipulate[
 Row[ParametricPlot3D[
     #, {t, -tmax, tmax},
     PlotRange -> {{-50, 10}, {0, 1}, {0, 1}},
     PlotPoints -> 100,
     PlotStyle -> AbsoluteThickness[4],
     BoxRatios -> {1, 1, 1},
     ImageSize -> 324,
     ColorFunction -> Function[{x, y, z, t},
       Blend[{Red, Green}, t]]] & /@ sol[t]],
 {{tmax, 50, Subscript["t", max]}, 5, 60, 5, 
  Appearance -> "Labeled"},
 SynchronousUpdating -> False]

enter image description here

$\endgroup$
  • $\begingroup$ Thank you, but the real examples will be of degree > 4, in part. $\endgroup$ – rfermat Feb 20 '18 at 3:20
  • $\begingroup$ @rfermat - for higher degree or transcendental expressions, don't use ToRadicals and just use the Root objects. You could also just use the Root objects in this case. $\endgroup$ – Bob Hanlon Feb 20 '18 at 20:50
0
$\begingroup$

The OP asks in a comment whether it is necessary to use NDSolve to integrate an implicitly defined curve. Usually, yes, or at least it yields better results and is often faster. However, we might get excited by this result:

ClearAll[f, g, h, cc, x, y, z];
f[x_, t_] := t^2 x^2 + t x + 2 x - 1 == 0;
g[y_, t_] := t^2 y^3 + t y^2 + 2 y - 1 == 0;
h[z_, t_] := 2 t^2 z^3 + t z + 3 z - t^2 == 0;

cc[t_?NumericQ] := {x, y, z} /. 
   NSolve[{f[x, t], g[y, t], h[z, t]}, {x, y, z}, Reals];
ParametricPlot3D[cc[t], {t, -3, 3}, BoxRatios -> {1, 1, 1}, 
 PlotStyle -> AbsoluteThickness[4]]

Mathematica graphics

There seem to be three curves, although it might be that the two that are cut off join up (actually they just approach each other asymptotically). The problem with this approach is that there are multiple points for each t:

cc[2.]
(*  {{-1.20711, 0.325315, 0.543346}, {0.207107, 0.325315, 0.543346}}  *)

The problem is how to integrate them into curves. The above does it solely on the order they come out of NDSolve. Luckily the x coordinates stay in order and the points are joined correctly. For curves that swirl around, this won't happen. However, NDSolve keeps things sorted by following the gradient from point to point.

One can apply Carl's method to seed points for each curve:

sols = NDSolveValue[
     {D[f[x[t], t], t], D[g[y[t], t], t], D[h[z[t], t], t],
      {x[Last@#], y[Last@#], z[Last@#]} == Most@#,
      WhenEvent[Norm[{x[t], y[t], z[t]}] > 10, "StopIntegration"]}, (* optional *)
     {x[t], y[t], z[t]}, {t, -10, 10},
     "ExtrapolationHandler" -> {Indeterminate &, "WarningMessage" -> False}] & /@ 
   Append[Append[-2] /@ cc[-2], Append[First@cc[2], 2]]; (* seed points plus times *)

ParametricPlot3D[Evaluate@sols, {t, -10, 10},
 BoxRatios -> {1, 1, 1}, PlotStyle -> AbsoluteThickness[4], 
 PlotRange -> All]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thank you very much. $\endgroup$ – rfermat Feb 18 '18 at 21:00
  • $\begingroup$ f[x_, t_] := 25*t^8*x^4 + 44*t^6*x^4 + 14*t^4*x^4 - 4*t^2*x^4 + x^4 + 80*t^8*x^3 - 32*t^6*x^3 - 64*t^4*x^3 + 32*t^2*x^3 - 16*x^3 + 160*t^8*x^2 - 256*t^6*x^2 + 128*t^4*x^2 - 128*t^2*x^2 + 96*x^2 + 256*t^8*x - 512*t^6*x + 512*t^2*x - 256*x + 256*t^8 - 1024*t^6 + 1536*t^4 - 1024*t^2 + 256 == 0 g[y_, t_] := 25*t^8*y^4 + 44*t^6*y^4 + 14*t^4*y^4 - 4*t^2*y^4 + y^4 - 160*t^7*y^3 - 96*t^5*y^3 + 32*t^3*y^3 - 32*t*y^3 + 640*t^6*y^2 + 256*t^4*y^2 + 384*t^2*y^2 - 2048*t^5*y - 2048*t^3*y + 4096*t^4 == 0 $\endgroup$ – rfermat Feb 18 '18 at 21:11
  • $\begingroup$ Sorry this comment has become garbled. First, here are g and h to finish the simplest interesting example (f above). g[y_, t_] := 25t^8y^4 + 44t^6y^4 + 14t^4y^4 - 4t^2y^4 + y^4 - 160t^7y^3 - 96t^5y^3 + 32t^3y^3 - 32ty^3 + 640t^6y^2 + 256t^4y^2 + 384t^2y^2 - 2048t^5y - 2048t^3y + 4096t^4 == 0 h[z_, t_] := 25*t^4*z^4 - 6*t^2*z^4 + z^4 - 160*t^4*z^3 - 32*t^2*z^3 + 760*t^4*z^2 + 176*t^2*z^2 - 8*z^2 - 1408*t^4*z + 128*t^2*z + 1680*t^4 - 608*t^2 + 16 == 0 $\endgroup$ – rfermat Feb 18 '18 at 21:13
  • $\begingroup$ This should have appeared first: Thank you for the Solve method. It produces a reasonable, if flawed result. The NDSolve method produces errors like: Power::infy: Infinite expression 1/0 encountered. Infinity::indet: Indeterminate expression 0 ComplexInfinity encountered. $\endgroup$ – rfermat Feb 18 '18 at 21:15
  • $\begingroup$ @rfermat I'm not sure what's giving 1/0 errors for you. If I run the NDSolve method on the three starting points in my post, or on the f, g, h from your comments, I get no error. For the example in the comments, I get this: i.stack.imgur.com/dZnlW.png But those sorts of issues are not unexpected when I attack willy-nilly a specific problem with a general approach. $\endgroup$ – Michael E2 Feb 19 '18 at 0:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.