Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

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>
  • Prev by Date: Re: Sierpinski's thing
  • Next by Date: Re: Re: What to do in v. 6 in place of Miscellaneous`RealOnly
  • Previous by thread: Re: drawing
  • Next by thread: Re: Re: drawing