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>