Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

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

Search the Archive

Re: Intersection of line and a surface of revolution - a

  • To: mathgroup at smc.vnet.net
  • Subject: [mg102594] Re: [mg102577] Intersection of line and a surface of revolution - a
  • From: Bob Hanlon <hanlonr at cox.net>
  • Date: Sun, 16 Aug 2009 06:40:11 -0400 (EDT)
  • Reply-to: hanlonr at cox.net

The parameter in RevolutionPlot3D is the radius, not x

pts = Select[{x, y, z} /. Solve[
     {z == 1/2 - r^2 + r^4/2,
      r^2 == x^2 + y^2,
      z == 4 x - 1, y == -x},
     {x, y, z}, r], FreeQ[N[#], Complex] &];

sr3 = Show[
  RevolutionPlot3D[1/2 - r^2 + r^4/2,
   {r, 0, 2.4},
   PlotStyle -> Opacity[0.5],
   Mesh -> False],
  ParametricPlot3D[{x, -x, 4*x - 1}, {x, -3, 3},
   PlotStyle -> {AbsoluteThickness[2], Red}],
  Graphics3D[{AbsolutePointSize[5], Point[pts]}],
  Axes -> True,
  AxesLabel -> {"x", "y", "z"},
  BoxRatios -> {1, 1, 1},
  PlotRange -> {{-4, 4}, {-4, 4}, {0, 8}},
  AspectRatio -> 1]


Bob Hanlon

---- Bob F <deepyogurt at gmail.com> wrote: 

=============
Can someone explain why there is such a difference in the observed
intersection points of a line and a surface of resolution and the
calculated intersections? Here is some code that should illustrate the
issue (especially the second plot).

Clear[sr3, l, nsol3, sol3, ip3, ip4, nip3, nip4, x, y, z, t];

sr3 = RevolutionPlot3D[1/2 - x^2 + x^4/2, {x, 0.05, 2.4},

  PlotStyle -> Opacity[0.4], Axes -> True,
  AxesLabel -> {"x", "y", "z"}, Mesh -> False,
  BoxRatios -> {1, 1, 1},
  PlotRange -> {{-4., 4.}, {-4., 4.}, {0., 8.0}}, AspectRatio -> 1];

l = ParametricPlot3D[{t, -t, 4*t - 1}, {t, -3, 3},
  PlotStyle -> {Thickness[0.01], Red}];

nsol3 = NSolve[{z == 1/2 - x^2 + x^4/2, x == t, y == -t,

  z == 4*t - 1}, {x, y, z, t}]

sol3 = Solve[{z == 1/2 - x^2 + x^4/2, x == t, y == -t,

  z == 4*t - 1}, {x, y, z, t}]

ip3 = Show[
  Graphics3D[{{AbsolutePointSize[10],
  Point[{x, y, z} /. sol3[[3]]]}}]];
nip3 = Show[
  Graphics3D[{{AbsolutePointSize[10],
  Point[{x, y, z} /. nsol3[[3]]]}}]];
ip4 = Show[
  Graphics3D[{{AbsolutePointSize[10],
  Point[{x, y, z} /. sol3[[4]]]}}]];
nip4 = Show[
  Graphics3D[{{AbsolutePointSize[10],
  Point[{x, y, z} /. nsol3[[4]]]}}]];


Show[sr3, l, ip3, ip4, ViewPoint -> {1.333, 1.765, 0.3479}]
Show[sr3, l, nip3, nip4, ViewPoint -> {1.333, 1.765, 0.3479}]

Both "Show[]" commands have both intersection points as large black
points - one of them isn't even close to being on the surface, and the
other is closer but still obviously not on the surface itself (you
might need to zoom in (use the Option key on the Mac version of
Mathematica) and/or rotate the surface around to get a better look at
how close the point isn't to the surface. The difference between the
two surfaces is the first shows the exact solutions from Solve[] and
the second shows the numerical solutions from NSolve[].

Thanks for any help or suggestion as to what might be the cause of the
difference.

-Bob



  • Prev by Date: Logarithmic Axes for ListPlot3D
  • Next by Date: Imported Image In Manipulate Resizing in 7
  • Previous by thread: Re: Logarithmic Axes for ListPlot3D
  • Next by thread: A Question about Combinatorica