Re: drawing with Mathematica
- To: mathgroup at smc.vnet.net
- Subject: [mg74206] Re: drawing with Mathematica
- From: "dimitris" <dimmechan at yahoo.com>
- Date: Wed, 14 Mar 2007 03:51:39 -0500 (EST)
- References: <et5tal$ljm$1@smc.vnet.net>
On Mar 13, 12:10=C2=A0pm, "dimitris" <dimmec... at yahoo.com> wrote:
> Hello.
>
> Until now for papers drawing, I use two specialized drawing programs.
> For a forthcoming publication (alnong with my Supervisor Professor)
> I want to use my knowledge in Mathematica (...which I think I have
> gained!...)
> than hanging around with two programs I must admit I am not very fond
> of!
>
> So below are two draws.
>
> The first shows the cleavage stress on a (mathematical) crack.
> The second (attempts to) show a (so called) cusp-like (mathematical)
> crack.
> I would like any comments regarding anything you think can be useful!
>
> (Further, ) I know that this subject has been completely covered (and
> actually one of my very first queries was in the same vein), but as
> regards the procedure of Copy/Paste to a Word File which procedure
> offers the least (if possibly!) declination in the quality of these
> graphs?
>
> Lastly, I wanted to draw a bounded region as that encountered in any
> elementary text
> in Vector Analysis (for example in the proof of the Green-Gauss
> Theorem).
> I can draw circles, ellipses and the stuff but I really need a
> (smooth!) bounded region which shape is not so "canonical" as circle
> or ellipse.
>
> FIRST DRAW
>
> << "Graphics`Arrow`"
>
> lin1 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
> 0}, {4.5, 0}}]}];
> lin2 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
> 0}, {0, 3}}]}];
> ar1 = Graphics[{Arrow[{4.5, 0.0095}, {4.5 + 1/8, 0.0095}]}];
> ar2 = Graphics[{Arrow[{-0.01, 3}, {-0.01, 3 + 1/8}]}];
> tex1 = Graphics[Text[StyleForm["0", FontSize -> 16, FontWeight ->
> "Bold",
> FontFamily -> "Times"], {0, -3/8}]];
> tex2 = Graphics[Text[StyleForm["x", FontSize -> 16, FontWeight ->
> "Bold",
> FontFamily -> "Times"], {4.5 + 1/8, -3^(-1)}]];
> tex3 = Graphics[Text[StyleForm["cleavage\n =C2=A0stress", FontSize -> 1=
6,
> FontWeight -> "Bold", FontFamily -> "Times"], {3.2, 2.4}]];
> cr1 = Graphics[{Thickness[0.009], Line[{{-0, 0.05}, {-3, 0.05}}]}];
> cr2 = Graphics[{Thickness[0.009], Line[{{-0, -0.05}, {-3, -0.05}}]}];
> lin3 =Graphics[{Thickness[0.009], Line[{{0, -0.05}, {0, 0.05}}]}];
> ar3 = Graphics[{Thickness[0.0055], Arrow[{2.7, 2.35}, {1.95, 1.9},
> HeadLength -> 0.035]}];
> Block[{$DisplayFunction=Identity},g = Plot[5*x*Exp[-x] + x/5, {x,
> 0.01, 4}, Axes -> False, PlotStyle -> Thickness[0.01]]];
>
> Show[{g, lin1, lin2, lin3, tex1, tex2, tex3, cr1, cr2, ar1, ar3},
> PlotRange -> {-1, 2.7},
> AspectRatio -> 1/GoldenRatio, ImageSize -> 400];
>
> SECOND DRAW
>
> Clear["Global`*"]
>
> lin1 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
> 0}, {3.5, 0}}]}];
> lin2 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
> 0}, {0, 2.6}}]}];
> ar1 = Graphics[{Arrow[{3.5, 0.0095}, {3.5 + 1/8, 0.0095}]}];
> ar2 = Graphics[{Arrow[{-0.005, 2.6}, {-0.005, 2.6 + 1/8}]}];
> tex1 = Graphics[Text[StyleForm["0", FontSize -> 16, FontWeight ->
> "Bold",
> FontFamily -> "Times"], {0, -3/8}]];
> tex2 = Graphics[Text[StyleForm["x", FontSize -> 16, FontWeight ->
> "Bold",
> FontFamily -> "Times"], {3.5 + 1/8, -3^(-1)}]];
> tex3 = Graphics[Text[StyleForm["y", FontSize -> 16, FontWeight ->
> "Bold",
> FontFamily -> "Times"], {-3^(-1), 2.55}]];
> cr1 = Graphics[{Thickness[0.009], Line[{{0, 0.07}, {-0.13, 0.07}}]}];
> cr2 = Graphics[{Thickness[0.009], Line[{{0, -0.07}, {-0.13,
> -0.07}}]}];
> lin3 = Graphics[{Thickness[0.009], Line[{{0, -0.07}, {0, 0.07}}]}];
> Block[{$DisplayFunction = Identity}, Plot[x^(3/2), {x, 0.18, 1.}, Axes
> -> False,
> PlotStyle -> Thickness[0.009]]];
> g1 = % /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, y};
> g2 = %% /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, -y};
> Block[{$DisplayFunction = Identity}, Plot[x^(1/2), {x, 1, 2}, Axes ->
> False,
> PlotStyle -> Thickness[0.009]]];
> g3 = % /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, y};
> g4 = %% /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, -y};
> Block[{$DisplayFunction = Identity}, Plot[x^(1/3) - (2^(1/3) -
> Sqrt[2]), {x, 2, 3},
> Axes -> False, PlotStyle -> Thickness[0.009]]];
> g5 = % /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, y};
> g6 = %% /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, -y};
>
> Show[{g1, g2, g3, g4, g5, g6, lin1, lin2, lin3, tex1, tex2, tex3, cr1,
> cr2, ar1, ar2}, AspectRatio -> 1/GoldenRatio, ImageSize -> 400,
> PlotRange -> {{-3, 4}, {-2.7, 2.7}}];
>
> Thanks in advance for any replies!
>
> Dimitris
I aplogize for the appearance of the somehow confused drawings
questions.
I have sent them almost a week ago but I think because of the
mentioned problems by the
moderator, they appeared after the more informative drawing with
mathematica post.
Anyway after one week of attempts and thanks to the invaluable help of
someone outside
the forum I got the following three drawings.
<< "Graphics`"
(*a quantitative description of the cleavage stress on a
(mathematical) crack *)
The first shows the cleavage stress on a (mathematical) crack.
lin1 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}],
Line[{{0, 0}, {4.5, 0}}]}];
lin2 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}],
Line[{{0, 0}, {0, 3}}]}];
ar1 = Graphics[{Arrow[{4.5, 0}, {4.5 + 1/8, 0}, HeadCenter -> 0.7]}];
tex1 = Graphics[Text["0", {0, -3/8}]];
tex2 = Graphics[Text["x", {4.5 + 1/8, -3^(-1)}]];
tex3 = Graphics[Text["cleavage\n stress", {3.2, 2.4}]];
cr1 = Graphics[{Thickness[0.009], Line[{{0, 0.05}, {-3, 0.05}}]}];
cr2 = Graphics[{Thickness[0.009], Line[{{0, -0.05}, {-3, -0.05}}]}];
lin3 = Graphics[{Thickness[0.009], Line[{{0, -0.05}, {0, 0.05}}]}];
ar3 = Graphics[{Thickness[0.004], Arrow[{2.7, 2.35}, {1.95, 1.9},
HeadLength -> 0.035]}];
Block[{$DisplayFunction = Identity},
g = Plot[5*x*Exp[-x] + x/5, {x, 0.01, 4}, Axes -> False,
PlotStyle -> {Thickness[0.01]}, PlotPoints -> 100]];
Show[{g, lin1, lin2, lin3, tex1, tex2, tex3, cr1, cr2, ar1, ar3},
PlotRange -> {-1, 2.7}, TextStyle -> {FontSize -> 16,
FontWeight -> "Bold", FontFamily -> "Times"},
AspectRatio -> 1/GoldenRatio, ImageSize -> 400];
(*the cusp-like curve*)
Clear["Global`*"]
yvalue[x_] := Piecewise[{{1.1*x^(3/2) - 0.021, Inequality[0, Less, x,
LessEqual, 0.95]},
{Sqrt[x], Inequality[0.95, Less, x, LessEqual, 2]}, {x^(1/4) -
(2^(1/4) - Sqrt[2]), x > 2}}]
lin1 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
0}, {2.9, 0}}]}];
lin2 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
0}, {0, 2.4}}]}];
ar1 = Graphics[{Arrow[{2.9, 0}, {2.9 + 1/8, 0}, HeadCenter -> 0.7]}];
ar2 = Graphics[{Arrow[{0, 2.4}, {0, 2.4 + 1/8}, HeadCenter -> 0.7]}];
tex1 = Graphics[Text["0", {0, -3/8}]];
tex2 = Graphics[Text["x", {2.9 + 1/8, -3^(-1)}]];
tex3 = Graphics[Text["y", {-3^(-1), 2.45}]];
g1 = Graphics[{Thickness[0.01], Spline[Table[{-x, yvalue[x]}, {x, 0,
3, 0.3}], Cubic, SplinePoints -> 50]}];
g2 = Graphics[{Thickness[0.01], Spline[Table[{-x, -yvalue[x]}, {x, 0,
3, 0.3}], Cubic, SplinePoints -> 50]}];
Show[{g1, g2, lin1, lin2, tex1, tex2, tex3, ar1, ar2}, TextStyle ->
{FontSize -> 16, FontWeight -> "Bold",
FontFamily -> "Times"}, AspectRatio -> 1/GoldenRatio, ImageSize -
> 400, PlotRange -> {{-3, 4}, {-2.7, 2.7}}];
(*the smooth bounded region*)
Clear["Global`*"]
partitionfunction[d_][=CE=B8_] := Piecewise[{{Sin[(Pi*=CE=B8)/(2*d)]^2,
Inequality[0, LessEqual, =CE=B8, Less, d]},
{1, Inequality[d, LessEqual, =CE=B8, Less, 2*Pi - d]}, {Sin[(Pi*(2*Pi -
=CE=B8))/(2*d)]^2, 2*Pi - d <= =CE=B8 <= 2*Pi}}]
radius[d_][=CE=B8_] := 1 + 1.5*partitionfunction[d][=CE=B8]*BesselJ[5, (1=
3/
(2*Pi))*=CE=B8 + 5]
curve[d_][=CE=B8_] := radius[d][=CE=B8]{Cos[=CE=B8], Sin[=CE=B8]}
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};
Block[{$DisplayFunction = Identity}, g = ParametricPlot[curve[1][=CE=B8=
],
{=CE=B8, 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"}];
Anyway, thanks in advance for anyone dealt with my questions.
> (Further, ) I know that this subject has been completely covered (and
> actually one of my very first queries was in the same vein), but as
> regards the procedure of Copy/Paste to a Word File which procedure
> offers the least (if possibly!) declination in the quality of these
> graphs?
This question appeared to my original post. I still look forward to
seeing your replies!
Best Regards
Dimitris