Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2012

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

Search the Archive

Slow plotting of reflected parametric "butterflies"

  • To: mathgroup at smc.vnet.net
  • Subject: [mg124430] Slow plotting of reflected parametric "butterflies"
  • From: Chris Young <cy56 at comcast.net>
  • Date: Thu, 19 Jan 2012 05:13:25 -0500 (EST)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com

I'm wondering if there's anyway I can speed this up. It's basically
just some sections of a parabolic hyperboloid, with the outer edges
curves. I'm porting it from another program, where it ran much faster.
I had to chop it up into parts for that program, but maybe this isn't
the best way to do it in Mathematica.

http://home.comcast.net/~cy56/Mma/ReflectedButterflies.nb
http://home.comcast.net/~cy56/Mma/ReflectedButterfliesPic.png

Chris Young
cy56 at comcast.net


\[HorizontalLine]CurvedButterfly[A_, B_, C_, D_, u_,
  v_, \[ScriptC]_] :=

 Table[
    (A + B + C + D)/4 +
     j Sqrt[1 - \[ScriptC] v] u/2 ((A + C)/2 - (B + D)/2) +
     k u/2 v (((C + D)/2 + j u (C - D)/2) - ((A + B)/2 +
          j u (A - B)/2)),
    {j, {-1, 1}}, {k, {-1, 1}}
    ] // FullSimplify  // Flatten[#, 1] &
Putting Butterfly into a Manipulate module:
Manipulate[
 With[
  {
   A = {Ax, Ay, Az},
   B = {Bx, By, Bz},
   C = {Cx, Cy, Cz},
   D = {Dx, Dy, Dz}
   },
  Show[
   ParametricPlot3D[
    Table[
     ( {
          {\[ScriptI], 0, 0},
          {0, \[ScriptJ], 0},
          {0, 0, \[ScriptK]}
         } ). # &  /@  \[HorizontalLine]CurvedButterfly[A, B, C, D, u,
        v, wingCurve],
     {\[ScriptI], {-1, 1}}, {\[ScriptJ], {-1, 1}}, {\[ScriptK], {-1,
       1}}],
    {u, 0, 1}, {v, 0, 1},

    PlotRange -> 2.5,
    Lighting -> "Neutral",
    ColorFunctionScaling -> False,
    ColorFunction -> ({x, y, z, u, v} \[Function]
       Hue[\[LeftFloor]5 v\[RightFloor]/10]),
    Mesh -> None,
    PlotPoints -> plotPts,
    AxesLabel -> {"x", "y", "z"}
    ],
   Graphics3D[
    {
     With[{pts = {A, B, C, D}},
      Table[{Hue[(k - 1)/4], Sphere[pts[[k]], ptRad]}, {k, 1, 4}]
      ]
     }
    ]
   ]
  ],
 {{Ax, 1.25}, -2.5, 2.5, 0.03125},
 {{Ay, 2}, -2.5, 2.5, 0.03125},
 {{Az, 0.75}, -2.5, 2.5, 0.03125},

 {{Bx, 1.75}, -2.5, 2.5, 0.03125},
 {{By, 0.5}, -2.5, 2.5, 0.03125},
 {{Bz, 0.125}, -2.5, 2.5, 0.03125},

 {{Cx, 0.5}, -2.5, 2.5, 0.03125},
 {{Cy, 0.375}, -2.5, 2.5, 0.03125},
 {{Cz, 0.25}, -2.5, 2.5, 0.03125},

 {{Dx, 0.375}, -2.5, 2.5, 0.03125},
 {{Dy, 0.125}, -2.5, 2.5, 0.03125},
 {{Dz, 1.25}, -2.5, 2.5, 0.03125},

 {{plotPts, 4}, 2, 30, 1},
 {{ptRad, 0.1}, 0, 0.3},
 {{wingCurve, 0}, 0, 1}
 ]




  • Prev by Date: Re: Is there any efficient easy way to compare two lists with the same length with Mathematica?
  • Next by Date: Re: without individual scaling?
  • Previous by thread: Re: MatrixForm odd behaviour
  • Next by thread: Re: Slow plotting of reflected parametric "butterflies"