Re: Re: drawing
- To: mathgroup at smc.vnet.net
- Subject: [mg76784] Re: [mg76732] Re: drawing
- From: "Jean-Marc Gulliet" <jeanmarc.gulliet at gmail.com>
- Date: Sun, 27 May 2007 04:58:48 -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: > 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 > >
- References:
- Re: drawing
- From: Jean-Marc Gulliet <jeanmarc.gulliet@gmail.com>
- Re: drawing