MathGroup Archive 2012

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

Search the Archive

Re: Slow plotting of reflected parametric "butterflies"

  • To: mathgroup at smc.vnet.net
  • Subject: [mg124493] Re: Slow plotting of reflected parametric "butterflies"
  • From: Chris Young <cy56 at comcast.net>
  • Date: Sat, 21 Jan 2012 05:19:44 -0500 (EST)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com
  • References: <jf8ql4$3pl$1@smc.vnet.net> <jfb2qn$hl4$1@smc.vnet.net>

By rewriting the function more simply, taking out the "C" and "D", and
reducing PlotPoints and MaxRecursion, I've got a decent response from
the butterfly plot. I'm also using Set instead of SetDelayed in the
defition for MSeg2.

I'm wondering if doing the reflections via the matrix multiplication is
slowing things down a lot. I want to have the reflections, but I'm
wondering if there's a faster way of doing them in this case, such as
by taking parts of the 3D vector and just multiplying each part by -1
or 1 and forming a table that way.

http://home.comcast.net/~cy56/Mma/ReflectedButterflies2.nb
http://home.comcast.net/~cy56/Mma/ReflectedButterfliesPic1.png
http://home.comcast.net/~cy56/Mma/ReflectedButterfliesPic2.png


Chris Young
cy56 at comcast.net



In[64]:= \[HorizontalLine]MSeg2[\[ScriptCapitalA]_, \
\[ScriptCapitalB]_, k_, t_] = (\[ScriptCapitalA] + \[ScriptCapitalB])/
   2 + k (t - 1/2) (\[ScriptCapitalB] - \[ScriptCapitalA]);

In[88]:= Manipulate[
 Module[
  {
   \[ScriptCapitalA] = {Ax, Ay, Az}, \[ScriptCapitalB] = {Bx, By,
     Bz}, \[ScriptCapitalC] = {Cx, Cy, Cz}, \[ScriptCapitalD] = {Dx,
     Dy, Dz},
   \[ScriptCapitalP], \[ScriptCapitalQ]
   },

  (* points riding along the "rails" \[ScriptCapitalA]\
\[ScriptCapitalC] and \[ScriptCapitalB]\[ScriptCapitalD]: *)
  \
\[ScriptCapitalP][n_] = (1 - n) \[ScriptCapitalA] +
    n \[ScriptCapitalC];
  \[ScriptCapitalQ][n_] = (1 - n) \[ScriptCapitalB] +
    n \[ScriptCapitalD];

  (* reflections of the "butterfly" across all the coordinate planes *)

    Show[
   ParametricPlot3D[
    Table[
     ( {
        {\[ScriptI], 0, 0},
        {0, \[ScriptJ], 0},
        {0, 0, \[ScriptK]}
       } ). \[HorizontalLine]MSeg2[\[ScriptCapitalP][
        u], \[ScriptCapitalQ][u], 2 u - 1, v],
     {\[ScriptI], {-1, 1}}, {\[ScriptJ], {-1, 1}}, {\[ScriptK], {-1,
       1}}
     ],
    {u, 0, 1}, {v, 0, 1},
    PlotPoints -> plotPts,
    Mesh -> mesh,
    MeshStyle -> Tube[tubeR],
    MeshFunctions -> {{x, y, z, u, v} \[Function] v},
    MeshShading -> {Lighter[Blue, .5], Yellow, Orange, Yellow,
      Lighter[Blue, .5]},
    MaxRecursion -> maxRecurs
    ],

   (* the corners of the twisted sheet *)

   With[{pts = {\[ScriptCapitalA], \[ScriptCapitalB], \
\[ScriptCapitalC], \[ScriptCapitalD]}},
    Graphics3D[
     {Table[{Hue[(k - 1)/4], Sphere[pts[[k]], ptRad]}, {k, 1, 4}],
      Gray, Sphere[Plus @@ pts/4, ptRad]}]
    ],
   Lighting -> "Neutral",
   PlotRange -> 4,
   Axes -> True,
   AxesLabel -> {"x", "y", "z"}
   ]
  ],
 {{Ax, -4}, -4, 4, .125},
 {{Ay, -4}, -4, 4, .125},
 {{Az, -4}, -4, 4, .125},

 {{Bx, -4}, -4, 4, .125},
 {{By, 0}, -4, 4, .125},
 {{Bz, -4}, -4, 4, .125},

 {{Cx, 0}, -4, 4, .125},
 {{Cy, 0}, -4, 4, .125},
 {{Cz, -2}, -4, 4, .125},

 {{Dx, -4}, -4, 4, .125},
 {{Dy, -2}, -4, 4, .125},
 {{Dz, 0}, -4, 4, .125},

 {{mesh, 4}, 0, 9},
 {{tubeR, 0.01}, 0, 0.1, 0.01},
 {{plotPts, 6}, 2, 30, 1},
 {{maxRecurs, 1}, 0, 4, 1},
 {{ptRad, .1}, 0, 0.5, 0.01},
 {{tubeR, .03}, 0, 0.5, 0.01}
 ]

Out[88]= Manipulate[Module[{\[ScriptCapitalA]$ = {Ax, Ay, Az}, \
\[ScriptCapitalB]$ = {Bx, By, Bz},
    \[ScriptCapitalC]$ = {Cx, Cy, Cz}, \[ScriptCapitalD]$ = {Dx, Dy, =
\
Dz}, \[ScriptCapitalP]$, \[ScriptCapitalQ]$},
   \[ScriptCapitalP]$[n$_] = (1 - n$)*\[ScriptCapitalA]$ + n$*\
\[ScriptCapitalC]$;
    \[ScriptCapitalQ]$[n$_] = (1 - n$)*\[ScriptCapitalB]$ + n$*\
\[ScriptCapitalD]$;
    Show[ParametricPlot3D[Table[{{\[ScriptI], 0, 0}, {0, \[ScriptJ], \
0},
         {0, 0, \[ScriptK]}} . \[HorizontalLine]MSeg2[\
\[ScriptCapitalP]$[u], \[ScriptCapitalQ]$[u], 2*u - 1, v],
       {\[ScriptI], {-1, 1}}, {\[ScriptJ], {-1, 1}}, {\[ScriptK], \
{-1, 1}}],
      {u, 0, 1}, {v, 0, 1}, PlotPoints -> plotPts, Mesh -> mesh,
      MeshStyle -> Tube[tubeR], MeshFunctions ->
       {Function[{x, y, z, u, v}, v]}, MeshShading ->
       {Lighter[Blue, 0.5], Yellow, Orange, Yellow,
        Lighter[Blue, 0.5]}, MaxRecursion -> maxRecurs],
     With[{pts$ = {\[ScriptCapitalA]$, \[ScriptCapitalB]$, \
\[ScriptCapitalC]$, \[ScriptCapitalD]$}},
      Graphics3D[{Table[{Hue[(k - 1)/4], Sphere[pts$[[k]],
           ptRad]}, {k, 1, 4}], Gray, Sphere[Plus @@ pts$/4,
         ptRad]}]], Lighting -> "Neutral", PlotRange -> 4,
     Axes -> True, AxesLabel -> {"x", "y", "z"}]],
  {{Ax, -4}, -4, 4, 0.125}, {{Ay, -4}, -4, 4, 0.125},
  {{Az, -4}, -4, 4, 0.125}, {{Bx, -4}, -4, 4, 0.125},
  {{By, 0}, -4, 4, 0.125}, {{Bz, -4}, -4, 4, 0.125},
  {{Cx, 0}, -4, 4, 0.125}, {{Cy, 0}, -4, 4, 0.125},
  {{Cz, -2}, -4, 4, 0.125}, {{Dx, -4}, -4, 4, 0.125},
  {{Dy, -2}, -4, 4, 0.125}, {{Dz, 0}, -4, 4, 0.125},
  {{mesh, 4}, 0, 9}, {{tubeR, 0.01}, 0, 0.1, 0.01},
  {{plotPts, 6}, 2, 30, 1}, {{maxRecurs, 1}, 0, 4, 1},
  {{ptRad, 0.1}, 0, 0.5, 0.01}, {{tubeR, 0.01}, 0, 0.5, 0.01}]




  • Prev by Date: Re: MatrixForm odd behaviour
  • Next by Date: Re: Simplification de formule/ Simplification of formula
  • Previous by thread: Re: Slow plotting of reflected parametric "butterflies"
  • Next by thread: Re: Slow plotting of reflected parametric "butterflies"