[Date Index]
[Thread Index]
[Author Index]
Re: Re: drawing
*To*: mathgroup at smc.vnet.net
*Subject*: [mg76773] Re: [mg76732] Re: drawing
*From*: Murray Eisenberg <murray at math.umass.edu>
*Date*: Sun, 27 May 2007 04:53:06 -0400 (EDT)
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.
Also, as in the image you posted, there's a point (?) inside the arc
from the tangent line to the normal.
[The attached image is at http://smc.vnet.net/mgattach/murray2.png -
moderator]
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
Prev by Date:
**Re: Sierpinski's carpet**
Next by Date:
**Re: Re: drawing**
Previous by thread:
**Re: drawing**
Next by thread:
**Mathematica V6. ComplexMap**
| |