Re: Re: Graphics3D of the official "arbitrary surface"
- To: mathgroup at smc.vnet.net
- Subject: [mg76278] Re: [mg76152] Re: Graphics3D of the official "arbitrary surface"
- From: Murray Eisenberg <murray at math.umass.edu>
- Date: Fri, 18 May 2007 06:36:06 -0400 (EDT)
- Organization: Mathematics & Statistics, Univ. of Mass./Amherst
- References: <f2em3g$2oo$1@smc.vnet.net> <200705170949.FAA00802@smc.vnet.net>
- Reply-to: murray at math.umass.edu
Could you repost your code but without all the "=E8" artifacts?
dimitris wrote:
> 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
>
>
--
Murray Eisenberg murray at math.umass.edu
Mathematics & Statistics Dept.
Lederle Graduate Research Tower phone 413 549-1020 (H)
University of Massachusetts 413 545-2859 (W)
710 North Pleasant Street fax 413 545-1801
Amherst, MA 01003-9305
- References:
- Re: Graphics3D of the official "arbitrary surface"
- From: dimitris <dimmechan@yahoo.com>
- Re: Graphics3D of the official "arbitrary surface"