Re: Re: drawing
- To: mathgroup at smc.vnet.net
- Subject: [mg76773] Re: [mg76732] Re: drawing
- From: Murray Eisenberg <murray at math.umass.edu>
- Date: Sun, 27 May 2007 04:53:06 -0400 (EDT)
It doesn't look like that under Mathematica 6.0 on my Windows XP system: there's still a large white triangle (almost) inscribed in the curve towards the curve's right side. Also, as in the image you posted, there's a point (?) inside the arc from the tangent line to the normal. [The attached image is at http://smc.vnet.net/mgattach/murray2.png - moderator] Jean-Marc Gulliet wrote: > dimitris wrote: >> 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 > > Hi Dimitris, > > I believe that the following is very close to what you expect. I have > fixed the code for the arrow using the built-in function Arrow and > Arrowheads (note that the spelling is correct: the second word, head, is > not capitalized. I would have expected ArrowHeads). > > Note that by changing the order of the graphs in the last Show command, > in version 6.0, (Show[g3, g, g1, g2, ...] rather than Show[g, g1, g2, > g3, ...]) you get the normal vector correctly displayed. You do not need > to do that in version 5.2. > > You can see the resulting plot at > > http://homepages.nyu.edu/~jmg336/Dimitris%20Graphics.png > > (I have sent to you the notebook and a png picture.) > > Regards, > Jean-Marc > > P.S. Here is the code for version 6.0. > > Clear["Global`*"] > a*o + b /. o -> 2*Pi > a*o + b /. o -> 2*Pi - d > Solve[ { b + 2*a*Pi == - ( Pi/2), b + a* ( -d + 2*Pi) == Pi/2}, { a, b}] > 1/2 + ( 1/2)* Sin[ ( -o)* ( Pi/d) - ( d*Pi - 4* Pi^2)/ ( 2*d)] > FullSimplify[%] > 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}}] > Plot[ BesselJ[ 5, x], { x, 5, 18}, Frame -> True] > Solve[ { ( a*o + b /. o -> 0) == 5, ( a*o + b /. o -> 2*Pi) == 18}] > radius[d_][o_] := 1 + 1.5* partitionfunction[d][o]* > BesselJ[ 5, ( 13/ ( 2*Pi))*o + 5] > Plot[ radius[1][o], { o, 0, 2*Pi}, Frame -> True, PlotRange -> All, > Axes -> False] > curve[d_][o_] := radius[d][o]* { Cos[o], Sin[o]} > tangent[t_] = N[ curve[1][ 45*Degree] + > t* Derivative[1][ curve[1]][ 45*Degree]] > normal[t_] = N[ curve[1][ 45*Degree] + > t* Reverse[ Derivative[1][ curve[1]][ 45*Degree]]* { 1, -1}] > n = { 1.127382730502271, 1.037382730502271}; > 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.004], PlotPoints -> 50]; > g3 = Graphics[ { Thickness[0.007], Arrowheads[ > { { 0.06, 1., Graphics[ Polygon[ { { 0, 0}, { -1, -1/3}, { -1/3, 0}, > { -1, 1/3}}], ImageSize -> { 38., Automatic}]}}], > Arrow[ { normal[0], normal[0.3]}]}]; > 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[ g3, g, g1, g2, tex1, tex2, tex3, cir, po, > AspectRatio -> Automatic, TextStyle -> { FontSize -> 17, > FontFamily -> "Times", FontWeight -> "Bold"}] > -- 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
