[Date Index]
[Thread Index]
[Author Index]
drawing
 To: mathgroup at smc.vnet.net
 Subject: [mg76681] drawing
 From: dimitris <dimmechan at yahoo.com>
 Date: Fri, 25 May 2007 06:50:09 0400 (EDT)
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
Prev by Date:
Re: Re: Re: Weird result in Mathematica 6
Next by Date:
Re: Re: Re: Compatibility woes
Previous by thread:
Re: matrices with arbitrary dimensionality
Next by thread:
Re: drawing
 