Re: drawing
- To: mathgroup at smc.vnet.net
- Subject: [mg76757] Re: drawing
- From: dimitris <dimmechan at yahoo.com>
- Date: Sun, 27 May 2007 04:44:49 -0400 (EDT)
- References: <f36gu8$9tn$1@smc.vnet.net>
1)
This drawing has appeared many times in the forum as part of some threads.
In all the cases I have mentioned the name of the person behind the (amazing!)
modulation of the radius of the circle in order to obtain an arbitrary shape.
I do one more time because I don't want to take any acknowledgents I don't
deserve (except from having the inspiration of using Mathematica for a task
that someone would consult a drawing progarm for example!)
Anyway, the person is David Park.
2) I have yet to find the time to thank privately to so many helpful persons
that replied to all of my questions so I want from this position to thank
the following persons (the order is random!)
a) Szabolcs Horv=E1t for learning me (apart from answering my queries of course!) so many things about exporting that I had not known their existence.
After five messages of him (!) I have a complete tutorial of this issue in my hand.
b) Jean-Marc Gulliet (I don't have any trouble to access the attached files!)
c) Lev Bishop for doing more things than I have asked (fortunately
there is MathReader!)
d) John Fultz. It is very good to have someone so informative and
active like him (and other of course!) from the Wolfram Research posting in MathGroup.
e) David Park (I have seen DrawGraphics to do so amazing things; I
feel so same shame I have not purchased it yet even though it is among my needs!)
These are the persons that replied me directly to me. Persons like the
above make this forum so amazing!
I also thank anyone that possibly he/she chose to reply my questions
to the MathGroup thread. I apologize for not thanking him/her namely.
3) I have already understand the quantum step that Mathematica has
taken. I think I must
upgrade as soon as possible in order to keep up with the evolution (or
should I say Revolution?!)
of version 6.
4) And now something funny...
Exploring the (online) Documentation Center a couple of days before I
saw the built in symbol
Arrowheads. As I saw in the examples (of it and Arrow) is by far more
superior than the old relevant
package it replaces.
But from the first day I saw it something didn't look good. I realized
what was that:
It's very own name. "Its name contradicts one of the main principles
of Mathematica; capitalization of the first letter if the command
consists of two words", I thought. But after I looked on the
dictionary and I saw that arrowhead is one word (I have yet to see a
dictionary that plotlabel for example is one word!).
So I lived the issue. Until yesterday I received a private
communication from someone that stated he would have waited ArrowHeads
instead!
The issue is not so important, I know. But what is your opinion?
5)
You want 5...you are not tired?
6)
Woe to you, Oh Earth and Sea, for the Devil sends the
beast with wrath, because he knows the time is short...
Let him who hath understanding reckon the number of the
beast for it is a human number, its number is (Mathematica...) 6
hundred and sixty six!
Best Regards
Dimitrios Anagnostou
/ dimitris :
> 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
