[Date Index]
[Thread Index]
[Author Index]
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>
Prev by Date:
**Re: Re: drawing**
Next by Date:
**Re: I Need to Have These Equations Solved!**
Previous by thread:
**Re: Re: drawing**
Next by thread:
**Re: drawing**
| |