drawing

*To*: mathgroup at smc.vnet.net*Subject*: [mg76681] drawing*From*: dimitris <dimmechan at yahoo.com>*Date*: Fri, 25 May 2007 06:50:09 -0400 (EDT)

The following produce a bounded region like those encountered in any elementary vector analysis book. In[41]:= Clear["Global`*"] In[42]:= << "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 o=0 and o=2Pi. So we need a partition function. I am going to make a function that is a over most of the domain 0 to 2 , 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[43]:= a*o + b /. o -> 2*Pi Out[43]= b + 2*a*Pi In[45]:= a*o + b /. o -> 2*Pi - d Out[45]= b + a*(-d + 2*Pi) In[46]:= Solve[{b + 2*a*Pi == -(Pi/2), b + a*(-d + 2*Pi) == Pi/2}, {a, b}] Out[46]= {{a -> -(Pi/d), b -> -((d*Pi - 4*Pi^2)/(2*d))}} In[49]:= 1/2 + (1/2)*Sin[(-o)*(Pi/d) - (d*Pi - 4*Pi^2)/(2*d)] FullSimplify[%] Out[49]= 1/2 - (1/2)*Sin[(o*Pi)/d + (d*Pi - 4*Pi^2)/(2*d)] Out[50]= Sin[((o - 2*Pi)*Pi)/(2*d)]^2 So this gives us a partition function. d gives the width of the transistion region at each end of the o domain. In[51]:= partitionfunction[d_][o_] := Piecewise[{{Sin[(Pi*o)/(2*d)]^2, Inequality[0, LessEqual, o, Less, d]}, {1, Inequality[d, LessEqual, o, Less, 2*Pi - d]}, {Sin[(Pi*(2*Pi - o))/(2*d)]^2, 2*Pi - d <= o <= 2*Pi}}] Let's use a piece of a Bessel function to modulate the radius. In[52]:= Plot[BesselJ[5, x], {x, 5, 18}, Frame -> True]; In[53]:= Solve[{(a*o + b /. o -> 0) == 5, (a*o + b /. o -> 2*Pi) == 18}] Out[53]= {{a -> 13/(2*Pi), b -> 5}} In[54]:= radius[d_][o_] := 1 + 1.5*partitionfunction[d][o]*BesselJ[5, (13/ (2*Pi))*o + 5] In[55]:= Plot[radius[1][o], {o, 0, 2*Pi}, Frame -> True, PlotRange -> All, Axes -> False]; Now we can parametrize the curve. In[58]:= curve[d_][o_] := radius[d][o]*{Cos[o], Sin[o]} For d=1 and o=45=B0 we can calculate the tangent line and normal line. In[59]:= tangent[t_] = N[curve[1][45*Degree] + t*Derivative[1][curve[1]] [45*Degree]] Out[59]= {1.057382730502271 - 0.7335911589691905*t, 1.057382730502271 + 1=2E3811743020353515*t} In[61]:= normal[t_] = N[curve[1][45*Degree] + t*Reverse[Derivative[1] [curve[1]] [45*Degree]]*{1, -1}] Out[61]= {1.057382730502271 + 1.3811743020353515*t, 1.057382730502271 + 0=2E7335911589691905*t} In[83]:= n = {1.127382730502271, 1.037382730502271}; Finnally In[81]:= Block[{$DisplayFunction = Identity}, g = ParametricPlot[curve[1][o1], {o1, 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"}]; Murray Eisenberg has tried this code in Mathematica 6 and after made the proper modifications (Arrow package is obsolete in the new version for example) he got a very unpleasant graph. See here http://smc.vnet.net/mgattach/curve.png Any ideas what is going one? I would very appreciate if someone could modify the code to work in version 6 and put the resulting graphic in some link page. The antialiasing makes the quality of the graphics objects by far more superior and "cleaner" in version 6 but unfortunately I don't have it yet! Thanks Dimitris

**Follow-Ups**:**Re: drawing***From:*"Lev Bishop" <lev.bishop@gmail.com>