Re: Re: drawing
- To: mathgroup at smc.vnet.net
- Subject: [mg76785] Re: [mg76732] Re: drawing
- From: Murray Eisenberg <murray at math.umass.edu>
- Date: Sun, 27 May 2007 04:59:20 -0400 (EDT)
- Organization: Mathematics & Statistics, Univ. of Mass./Amherst
- References: <f36gu8$9tn$1@smc.vnet.net> <200705260842.EAA18750@smc.vnet.net> <46585439.3030803@math.umass.edu> <22d35c5a0705261032k6aeddcfdu999f7084c68e094d@mail.gmail.com>
- Reply-to: murray at math.umass.edu
Using the Exclusions->None option for the ParametricPlot got rid of the triangular region artifact. Jean-Marc Gulliet wrote: > On 5/26/07, Murray Eisenberg <murray at math.umass.edu> wrote: >> 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. > > I am puzzled because I got the white triangle you mention for a while > yesterday (while I was toying with the new Arrow function). At some > point of my experiment, the white triangle vanished, and finally I got > the desired result with the normal vector and posted the code and > uploaded the picture on my web site. > > Now, using the same notebook as yesterday but with a fresh kernel, I > get the white triangle again! I have no idea about what is going on. > > For whom who might be interested, I have uploaded the notebook, a copy > of it as a pdf file and the picture on my web site. > > http://homepages.nyu.edu/~jmg336/mathematica/DimitrisGraphics.nb > http://homepages.nyu.edu/~jmg336/mathematica/DimitrisGraphics.pdf > http://homepages.nyu.edu/~jmg336/mathematica/DimitrisGraphics.png > >> Also, as in the image you posted, there's a point (?) inside the arc >> from the tangent line to the normal. > > This point is expected indeed: it is drawn by the function po. > > Regards, > Jean-Marc > >> 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 >> >> > -- 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: drawing
- From: Jean-Marc Gulliet <jeanmarc.gulliet@gmail.com>
- Re: drawing