Re: Re: drawing
- To: mathgroup at smc.vnet.net
- Subject: [mg76788] Re: [mg76732] Re: drawing
- From: "Jean-Marc Gulliet" <jeanmarc.gulliet at gmail.com>
- Date: Sun, 27 May 2007 05:00:53 -0400 (EDT)
- References: <f36gu8$9tn$1@smc.vnet.net> <200705260842.EAA18750@smc.vnet.net>
On 5/26/07, Murray Eisenberg <murray at math.umass.edu> wrote: > Using the Exclusions->None option for the ParametricPlot got rid of the > triangular region artifact. Great! I have updated the files on the 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 Regards, Jean-Marc > 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