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},
> 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
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},
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]
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],
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