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: Drawing a bounded smooth region with Mathematica

  • To: mathgroup at smc.vnet.net
  • Subject: [mg76345] Re: [mg76290] Drawing a bounded smooth region with Mathematica
  • From: Murray Eisenberg <murray at math.umass.edu>
  • Date: Sun, 20 May 2007 02:26:19 -0400 (EDT)
  • Organization: Mathematics & Statistics, Univ. of Mass./Amherst
  • References: <f2em3g$2oo$1@smc.vnet.net><f2h8hr$q5$1@smc.vnet.net> <200705190834.EAA20921@smc.vnet.net>
  • Reply-to: murray at math.umass.edu

The final, Show, cell is causing errors in Mathematica 6.0.

Of course Graphics`Arrow` is obsolete in Mathematica 6.0, and 
accordingly the options HeadLength and HeadCenter are also obsolete.  So 
I omitted loading that package and deleted those two options.  And I 
changed the 5.2 StyleForm in the big Block to Style.

Although there's an error "+" symbol and a pink background with red 
border on the graphic indicating an error, I cannot get error messages 
by clicking on the "+".

The displayed graphic shows the smooth curve with the labels V and S. 
The tangent line segment is OK (but no arrow).  The normal is thin, 
short, and bent!  And no arrow.  And the letter "n" is reduced to nearly 
a dot.  There's a large blank triangular region (with pink background 
exposed) inside the curve .

See attached screenshot.

[Attachments are not sent to the group.  See the graphics file at
 http://smc.vnet.net/mgattach/curve.png - moderator]

dimitris wrote:
> The following code appeared in a recent post.
> But as Murray watched, it was not very easy to follow.
> 
> So...
> 
> Let make another attempt with the hope that everything
> will appear readable!
> 
> ---------------------------------------------------------------------------=
> ----------
> Drawing a bounded smooth region with Mathematica
> ---------------------------------------------------------------------------=
> ----------
> 
> 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"}];
> 
> ---------------------------------------------------------------------------=
> -------------------------------------------------------------------------
> 
> If everything works ok during the Copy/Paste process then it will
> appear a really nice
> drawing.
> 
> Who sent that Mathematica cannot be used as a drawing environement?
> Show them this drawing in order to change their mind!
> I did to my supervisor! With a little success I must admit! But this
> is
> another issue!
> 
> Using David Park's well known package previous drawing appears much
> nicer in the
> sense of aesthetic issues! I have seen it with my own eyes!
> 
> All acknowledgents regarding the process of modulation of the region
> must
> be given to the one and only Mr. David Park! I spent much time to
> figure out what
> is going! Simply amazing (the idea and David as well!).
> 
> I don't know about you, but speaking on behalf of myself and with all
> of my respect to the other forumists,
> I sadly missed his presence and contribution to the forum.
> 
> Dimtris
> 
> 

-- 
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



  • Prev by Date: Re: Re: A harmless and amusing bug
  • Next by Date: Pisot Numbers
  • Previous by thread: Drawing a bounded smooth region with Mathematica
  • Next by thread: Re: Drawing a bounded smooth region with Mathematica