Services & ResourcesWolfram ForumsMathGroup Archive

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

Drawing a bounded smooth region with Mathematica

• To: mathgroup at smc.vnet.net
• Subject: [mg76290] Drawing a bounded smooth region with Mathematica
• From: dimitris <dimmechan at yahoo.com>
• Date: Sat, 19 May 2007 04:34:46 -0400 (EDT)
• References: <f2em3g$2oo$1@smc.vnet.net><f2h8hr$q5$1@smc.vnet.net>

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

• Follow-Ups:
  • Re: Drawing a bounded smooth region with Mathematica
    • From: Murray Eisenberg <murray@math.umass.edu>