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

MathGroup Archive 2008

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

Search the Archive

Re: Cropping a surface to a sphere (fun Manipulate example)

  • To: mathgroup at smc.vnet.net
  • Subject: [mg88278] Re: Cropping a surface to a sphere (fun Manipulate example)
  • From: Szabolcs Horvát <szhorvat at gmail.com>
  • Date: Wed, 30 Apr 2008 04:26:03 -0400 (EDT)
  • Organization: University of Bergen
  • References: <fv42mu$624$1@smc.vnet.net> <fv6uk6$rmf$1@smc.vnet.net>

David Park wrote:
> This is nice Craig, but unfortunately ContourPlot3D is not the fastest of 
> routines. So, on my machine at least, the response is quite slow.
> 
> But, looking at the plot, there is obvious symmetry. There appears to be 
> only one fundamental surface which is present in 12 copies. So would it be 
> possible to use Reduce to obtain a parametrization of one of the surfaces 
> and use rotation/reflection geometric transformations to generate all the 
> other surfaces? This might then be much faster. For those who are experts in 
> group theory, how would one start with the polynomial and then generate the 
> set of transformations to create all the surfaces?
> 
> I put this forward as a challenge problem for those who might care to take 
> it up.
> 

Hello,

I don't think that it is possible to construct a formula that represents 
only one of the 12 surfaces because this is what the polynomial really 
looks like:

poly = -x^4 y^2 + x^2 y^4 + x^4 z^2 - y^4 z^2 - x^2 z^4 + y^2 z^4
Factor[poly]

-(x - y) (x + y) (x - z) (y - z) (x + z) (y + z)

I tried generating only one surface with Plot3D, and then transforming 
it, but unfortunately it is still quite slow.  I believe that the 
bottleneck is Plot3D, so if someone could find a better way to generate 
a single surface, it might be possible to make this run faster.

We can rotate the whole thing by Pi/4 (variable change (x,y) -> (a,b)) 
to make it suitable for plotting with Plot3D:

Solve[poly == u &&
   (x - y)/Sqrt[2] == -a && (x + y)/Sqrt[2] == b, z, {x, y}]

We shall use the following solution:

sol[a_, b_, u_] =
   Sqrt[a^2/2 + b^2/2 + Sqrt[2 a^4 b^4 + a b u]/(Sqrt[2] a b)]

Here's what this surface looks like:

Manipulate[
  Plot3D[
   sol[a, b, u],
   {a, 0.002, 3 Sqrt[2]}, {b, 0.002, 3 Sqrt[2]},
   RegionFunction -> Function[{x, y, z}, x^2 + y^2 + z^2 < 9],
   PlotRange -> All,
   BoxRatios -> Automatic],
  {u, 0, 1}]

(This is not a very good way to plot it because it goes to infinity at a 
== 0 and b == 0.  Perhaps it would be better to tilt it before plotting 
to avoid this.)

Let us generate the rotations:

cp = Composition; (* I just don't like to type much *)

{t1, t2, t3} =
   Table[RotationTransform[Pi/2, axis],
     {axis, {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}}}];

(* These transformations will generate the group that we need: *)

base = {cp[t2, t1], cp[t3, t2], cp[t1, t3]}

(* Generate all rotations with brute-force method: *)

group = FixedPoint[Union@Flatten[{#, Outer[cp, base, #]}] &, base]


And finally assemble everything:

Manipulate[
  With[
   {gg = GeometricTransformation[
      First @ Plot3D[
        sol[a, b, u] // Evaluate,
        {a, 0.002, 3 Sqrt[2]}, {b, 0.002, 3 Sqrt[2]}, PlotRange -> All,
        Mesh -> False,
        RegionFunction -> Function[{x, y, z}, x^2 + y^2 + z^2 < 9]
        (*, PerformanceGoal -> "Quality" *)],
      RotationTransform[Pi/4, {0, 0, 1}]
     ]},
   Graphics3D[GeometricTransformation[gg, #] & /@ group,
    Boxed -> False, SphericalRegion -> True]
   ],
  {u, 0, 1}]

One might want to uncomment PerformanceGoal -> "Quality", but it will be 
terribly slow.

Compare with the original version:

Manipulate[
  ContourPlot3D[poly == u, {x, -3, 3}, {y, -3, 3}, {z, -3, 3},
   RegionFunction -> Function[{x, y, z}, x^2 + y^2 + z^2 < 9],
   Mesh -> False, Axes -> False, Boxed -> False,
   SphericalRegion -> True],
  {u, 0, 1}]

Szabolcs


  • Prev by Date: Re: Does Mathematica really need more printed, introductory documentation?
  • Next by Date: Re: Re: Does Mathematica really need more printed,
  • Previous by thread: Re: Cropping a surface to a sphere (fun Manipulate example)
  • Next by thread: Common Multiple Value Question