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}]
