13
$\begingroup$

The help for ContourPlot3D starts with this example

ContourPlot3D[x^3 + y^2 - z^2 == 0, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}]

This returns a Plots of the surface $x^2 + y^2 - z^2 = 0$:

Surface.

Now I have a function, and I would like to know how this function behaves on this surface. For example, take

f[x_,y_,z_] := {x^3 - 2 x y + z^2 x - 5 z^2 y^2 - 4 x y z, 
                Sin[10x] + Cos[5y] + Cos[20z]}

I was thinking of making a list with some of the point that lie on this surface. Then it is easy to evaluate the function on these points. The way I would like to generate the list is to click with the mouse on a few points that I think are interesting. Is that possible?

What are the alternatives to using the mouse? There most be some list available with all points that were used to draw this graph. How can I take some point of that list and add them as point to the 3D plot to visualize them?

Update

The methods of Szabolcs and Heike work fine on the example $x^3 + y^2 - z^2 =0$. Now I try to apply the same to

$$ 2316 a^{12} c^6+500 a^{11} b c^5+10296 a^{10} b^2 c^4+1624 a^{10} c^5+656 a^9 b^3 c^3- \\ - 3856 a^9 b c^4+41 a^8 b^4 c^2+808 a^8 b^2 c^3+784 a^8 c^4+a^7 b^5 c+24 a^7 b^3 c^2- \\ - 176 a^7 b c^3+2 a^6 b^4 c+16 a^6 b^2 c^2+32 a^6 c^3 = 0 $$

f[a_, b_, c_] := 2 a^6 b^4 c + a^7 b^5 c + 16 a^6 b^2 c^2 + 24 a^7 b^3 c^2 
+ 41 a^8 b^4 c^2 + 32 a^6 c^3 - 176 a^7 b c^3 + 808 a^8 b^2 c^3 
+ 656 a^9 b^3 c^3 + 784 a^8 c^4 - 3856 a^9 b c^4 
+ 10296 a^10 b^2 c^4 + 1624 a^10 c^5 + 500 a^11 b c^5 + 2316 a^12 c^6
pts = {};

Substituting this function into Heike's solution does not work. Clicking does not result in points on the surface. Also Szabolcs's FindInstance does not work. What goes wrong here?

Surface 2.

$\endgroup$
2
  • $\begingroup$ The more general question is how to interact with three dimensional graphics objects using the mouse. Tooltip does work, so there's some support. But the mouse coordinates can only be retrieved in 2D while this time you want the coordinates in 3D, on the surface. +1. $\endgroup$
    – Szabolcs
    Mar 15, 2012 at 9:52
  • 2
    $\begingroup$ Why not use built-in visualization capabilities like the MeshFunctions and ColorFunction options? (MeshFunctions works well to show contours of the first component of f while ColorFunction does a better job with its second component, which is rapidly varying; using PlotPoints -> 20 helps.) $\endgroup$
    – whuber
    Mar 15, 2012 at 16:25

2 Answers 2

11
$\begingroup$

The location that the mouse is pointing to on a 3D surface can be found by starting with MousePosition["Graphics3DBoxIntercepts"]. This will give you the two points where the line perpendicular to the screen at the mouse pointer intersects the three-dimensional bounding box.

We can calculate the intersection of this line with the surface to find a point. Here is a simple implementation to track that point dynamically:

fun defines the surface:

fun[{x_, y_, z_}] := x^3 + y^2 - z^2

Let's plot it:

plot = ContourPlot3D[
   fun[{x, y, z}] == 0, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}]

Now let's try to find the intersection of the mouse pointer with the surface using FindRoot. There might be several intersections, so I specified the box intersection point closer to the viewer as a starting point for FindRoot (t == 0 in the code). This does not guarantee that the closest (i.e. visible) point will be found, but it makes it more likely.

Show[plot,
 Graphics3D[{
   Red,
   Dynamic@Quiet@Check[
      Sphere[#, Scaled[0.01]]& @ Module[{p1, p2, t},
        {p1, p2} = MousePosition[{"Graphics3DBoxIntercepts", Graphics3D}];
        (p2 - p1) t + p1 /. FindRoot[fun[(p2 - p1) t + p1], {t, 0, 0, 1}]
        ],
      {}]}]
 ]

Mathematica graphics

Now that we have the point on the surface, you can do with it whatever you want (calculate another functions, etc.) You can use EventHandler to just record clicks instead of tracking values dynamically.


To address your other question about how to get a number of points on the surface. One way is to use FindInstance.

FindInstance[
 fun[{x, y, z}] == 0 && Thread[-2 < And[x, y, z] < 2, And], {x, y, 
  z}, Reals, 10]

This will give you 10 points that are precisely on the surface (this uses exact calculations). Let's show them:

Show[plot, Graphics3D[{Red, Sphere[{x, y, z}, Scaled[0.01]] /. %}]]

To get the points generated by ContourPlot3D, extract them from the GraphicsComplex object is creates. These coordinates will not be quite as precise as they are meant for visualization only.

First@Cases[plot, GraphicsComplex[points_, ___] :> points, Infinity]

Let's show those points:

Graphics3D@Point[%]

Mathematica graphics

$\endgroup$
1
  • $\begingroup$ And you can use Deploy to prevent rotating the plot. $\endgroup$ Mar 15, 2012 at 12:54
11
$\begingroup$

This solution is pretty similar to Szabolcs's solution. I've added an EventHandler to make it easier to select points in the plot. Here f[x,y,z]==0 is the equation of the surface, and pts contains a list of selected points on this surface. You can add points to the list by right-clicking somewhere on the plot.

f[x_, y_, z_] := x^3 + y^2 - z^2;
pts = {};

plot = ContourPlot3D[
   f[x, y, z] == 0, {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
   Mesh -> False, ColorFunctionScaling -> False, 
   BoundaryStyle -> None];
Dynamic@EventHandler[
  Show[plot, Graphics3D[{Red, Sphere[#, .05] & /@ pts}]],
  {{"MouseClicked", 2} :> Module[{p, sol, pt},
     p = CurrentValue[{"MousePosition", "Graphics3DBoxIntercepts"}];
     If[p =!= None, 
      sol = Quiet@
        Check[FindRoot[
          f[x, y, z] /. Thread[{x, y, z} -> l p[[1]] + (1 - l) p[[2]]],
          {l, .5, 0, 1}], None];
      If[sol =!= None, 
       AppendTo[pts, l p[[1]] + (1 - l) p[[2]] /. sol]]]]}]

Mathematica graphics

$\endgroup$
9
  • $\begingroup$ If you use PassEventsDown -> True, then you can use button-1 clicks while keeping the graphics rotatable (no need for button 2). Button 2 might still be more comfortable for some people. $\endgroup$
    – Szabolcs
    Mar 15, 2012 at 13:19
  • $\begingroup$ For the Sphere[] radius, you could use Scaled coordinates to make this independent of the plot range. $\endgroup$
    – Szabolcs
    Mar 15, 2012 at 13:21
  • $\begingroup$ Sorry about a third comment... as you can see, I've been playing with this for a while. I suggest using 1 as the starting value for FindRoot instead of 0.5. This will make it much more likely that the solution will be on the side of the surface closer to the viewer. If you use for example a sphere, many of the points will be on the other (invisible) side of the sphere. A starting value of 1 brings it to the viewer's side while a starting point of 0 will push it to the opposite side. You can also localize l. $\endgroup$
    – Szabolcs
    Mar 15, 2012 at 13:45
  • $\begingroup$ @Szabolcs Since I restricted the search domain for FindRoot to {0, 1} I thought it safer to use a starting value somewhere in the middle of the domain than near x == 1. $\endgroup$
    – Heike
    Mar 15, 2012 at 14:03
  • $\begingroup$ That is a good point---I just tried FindRoot[Sin[x], {x, 4, 3.3, 7}] to make sure. But we could use NSolve instead, which will usually find all roots with good performance if there's a bound on the solution (which there is). Then we can select the largest value of l. Did you know that even Reduce can handle these equations in a semi-numerical way, returning Root objects which can be evaluated to arbitrary precision? $\endgroup$
    – Szabolcs
    Mar 15, 2012 at 14:14

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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