Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Graphics3D of the official "arbitrary surface"

• To: mathgroup at smc.vnet.net
• Subject: [mg76152] Re: Graphics3D of the official "arbitrary surface"
• From: dimitris <dimmechan at yahoo.com>
• Date: Thu, 17 May 2007 05:49:26 -0400 (EDT)
• References: <f2em3g$2oo$1@smc.vnet.net>

I don't understand exactly wan you want!

I suppose you want to draw a bounded region as that encountered in any
elementary text in Vector Analysis (for example in the proof of the
Green-Gauss Theorem). I will use some code (and explanation as well!)
that appeared some time ago in private communication with David Park.
Note that David used his package DrawGraphics in order to make the
drawing. Instead me (having been unable yet to purchase his amazing
package unfortunately) I make pure use of Mathematica. Using David's
package the following appears noticeably better!

Anyway...

In[2]:=
Clear["Global`*"]

In[1]:=
<< "Graphics`Arrow`"

We want to take a circle and add an arbitrary modulation to the radius
to obtain an irregular shape. However, we need a smooth join at =E8\
[Equal]0 and =E8\[Equal]2=F0. So we need a partition function. I am going
to make a function that is 1 over most of the domain 0 to 2=F0, but
smoothly transistions to zero at the end points and has zero slope at
the end points. The following was just used to calculate arguments for
the function.

In[3]:=
a*=E8 + b /. =E8 -> 2*Pi

Out[3]=
b + 2*a*Pi

In[4]:=
a*=E8 + b /. =E8 -> 2*Pi - d

Out[4]=
b + a*(-d + 2*Pi)

In[5]:=
Solve[{b + 2*a*Pi == -Pi/2, b + a*(-d + 2*Pi) == Pi/2}, {a, b}]

Out[5]=
{{a -> -(Pi/d), b -> -((d*Pi - 4*Pi^2)/(2*d))}}

In[6]:=
1/2 + (1/2)*Sin[(-=E8)*(Pi/d) - (d*Pi - 4*Pi^2)/(2*d)]
FullSimplify[%]

Out[6]=
1/2 - (1/2)*Sin[(d*Pi - 4*Pi^2)/(2*d) + (Pi*=E8)/d]

Out[7]=
Sin[(Pi*(2*Pi - =E8))/(2*d)]^2

So this gives us a partition function. d gives the width of the
transistion region at each end of the =E8 domain.

In[19]:=
partitionfunction[d_][=E8_] := Piecewise[{{Sin[(Pi*=E8)/(2*d)]^2,
Inequality[0, LessEqual, =E8, Less, d]},
    {1, Inequality[d, LessEqual, =E8, Less, 2*Pi - d]}, {Sin[(Pi*(2*Pi -
=E8))/(2*d)]^2, 2*Pi - d <= =E8 <= 2*Pi}}]

Let's use a piece of a Bessel function to modulate the radius.

In[9]:=
Plot[BesselJ[5, x], {x, 5, 18}, Frame -> True];

In[10]:=
Solve[{(a*=E8 + b /. =E8 -> 0) == 5, (a*=E8 + b /. =E8 -> 2*Pi) == =
18}]

Out[10]=
{{a -> 13/(2*Pi), b -> 5}}

So now we can make a smooth modulating function for the radius.

In[11]:=
radius[d_][=E8_] := 1 + 1.5*partitionfunction[d][=E8]*BesselJ[5, (13/
(2*Pi))*=E8 + 5]

In[12]:=
Plot[radius[1][=E8], {=E8, 0, 2*Pi}, Frame -> True, PlotRange -> All, Axes
-> False];

Now we can parametrize the curve.

In[13]:=
curve[d_][=E8_] := radius[d][=E8]*{Cos[=E8], Sin[=E8]}

For d\[Equal]1 and =E8\[Equal]45=B0 we can calculate the tangent line and
normal line.

In[14]:=
tangent[t_] = N[curve[1][45*Degree] + t*Derivative[1][curve[1]]
[45*Degree]]

Out[14]=
{1.05738\[InvisibleSpace]-0.733591 t,1.05738\[InvisibleSpace]+1.38117
t}

In[15]:=
normal[t_] = N[curve[1][45*Degree] + t*Reverse[Derivative[1][curve[1]]
[45*Degree]]*{1, -1}]

Out[15]=
{1.05738\[InvisibleSpace]+1.38117 t,1.05738\[InvisibleSpace]+0.733591
t}

In[20]:=
n={1.127382730502271`,1.037382730502271`};

In[21]:=
Block[{$DisplayFunction = Identity}, g = ParametricPlot[curve[1][=E8],
{=E8, 0, 2*Pi}, Axes -> False, PlotPoints -> 50,
     PlotStyle -> Thickness[0.007]]; g1 = g /. Line[x_] ->
{GrayLevel[0.8], Polygon[x]};
   g2 = ParametricPlot[tangent[t], {t, -0.2, 0.2}, PlotStyle ->
Thickness[0.006], PlotPoints -> 50];
   g3 = Graphics[{Thickness[0.007], Arrow[normal[0], normal[0.3],
HeadLength -> 0.06, HeadCenter -> 0.7]}];
   cir = Graphics[{Circle[normal[0], 0.1, {3.3*(Pi/2), 2.15*Pi}]}]; po
= Graphics[{PointSize[0.01], Point[n]}];
   tex1 = Graphics[Text["V", {0.0532359, -0.0138103}]]; tex2 =
Graphics[Text["S", {0.470751, -1.08655}]];
   tex3 = Graphics[Text[StyleForm["n", FontSize -> 17, FontFamily ->
"Times", FontColor -> Black, FontWeight -> "Bold"],
      {1.7, 1.2}]]; ]
Show[g, g1, g2, g3, tex1, tex2, tex3, cir, po, AspectRatio ->
Automatic,
   TextStyle -> {FontSize -> 17, FontFamily -> "Times", FontWeight ->
"Bold"}];

 Dimitris

=CF/=C7 Hatto von Aquitanien =DD=E3=F1=E1=F8=E5:
> In virtually every math book which deals with multivariable/multi-valued
> functions, there are diagrams showing an "arbitrary surface".  Often there
> is a vector and/or a curve drawn on that surface.  The surface itself is
> the kind of thing we get from Plot3D or ParametricPlot3D.  I know I can
> coble together a surface from polygons, but seems reasonable that there
> should be a way of using what's already built in.  Is the way to do this
> simply to use Plot3D or ParametricPlot3D, and pull the graphics data out =
of
> the resulting object?
>
> I'd like to be able to simply create a surface "in place" rather than hav=
ing
> to transform some externally generated object into place.  If I want to
> create the surface directly without using Plot3D, etc., does that mean I
> have to roll my own from scratch?
> --
> http://www.dailymotion.com/video/x1ek5w_wtc7-the-smoking-gun-of-911-updat=
ed
> http://911research.wtc7.net
> http://vehme.blogspot.com
> Virtus Tutissima Cassis

• Follow-Ups:
  • Re: Re: Graphics3D of the official "arbitrary surface"
    • From: Murray Eisenberg <murray@math.umass.edu>