Re: How to make curved arrows?
- To: mathgroup at smc.vnet.net
- Subject: [mg28756] Re: How to make curved arrows?
- From: Tom Burton <tburton at cts.com>
- Date: Fri, 11 May 2001 20:00:34 -0400 (EDT)
- References: <9dg5d0$j3c@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Hello,
Paste the notebook expression below into Mathematica and then evaluate the notebook to see and try out my extension of Graphics`Arrow.
Tom
On 11 May 2001 03:46:40 -0400, in comp.soft-sys.math.mathematica you wrote:
>Dear NG,
>
>I wish to draw a figure in Mathematica that involves indicating the angle of
>some triangle. I thought that the only way to do it is to make acurved arrow (I
>hope you know what I mean), please advise me on how I can do this. Thanks in
>advance
>
>Sincerely,
>Jose Capco
Notebook[{
Cell[CellGroupData[{
Cell["Extended Graphics`Arrow`Arrow", "Section"],
Cell["\<\
The package Graphics`Arrow` provides the form Arrow[start,finish], \
creating a straight line with an arrow at the end. This section \
extends the form to circular and elliptical arcs, analogous to the \
two-dimension Graphics primitive Circle. The Graphics`Arrow` package \
should be loaded before this section's definitions are executed.\
\>", "Text"],
Cell[BoxData[
\(Needs["\<Graphics`Arrow`\>"]\)], "Input",
InitializationCell->True],
Cell[TextData[{
"The following should be evaluated ",
StyleBox["before",
FontSlant->"Italic"],
" the function Arrow is updated."
}], "Text"],
Cell[CellGroupData[{
Cell[BoxData[
\(\(?Arrow\)\)], "Input",
Evaluatable->False],
Cell[BoxData[
RowBox[{"\<\"Arrow[start, finish, (opts)] is a graphics primitive \
representing an arrow starting at start and ending at finish.\"\>",
" ",
ButtonBox[
StyleBox["More\[Ellipsis]",
"SR"],
ButtonData:>"Graphics`Arrow`",
Active->True,
ButtonStyle->"AddOnsLink"]}]], "Print",
CellTags->"Info3198545537-9629944"]
}, Open ]],
Cell["\<\
The purpose of this development is to extend the Graphics`Arrow`Arrow \
function from straight-lines to arcs.\
\>", "Text"],
Cell[BoxData[
\(\(?Circle\)\)], "Input"],
Cell[CellGroupData[{
Cell["Usage", "Subsection"],
Cell["Update the usage message:", "Text"],
Cell[BoxData[
\(\(Graphics`Arrow`Arrow::usage = \*"\"\<Arrow[{\!\(x\_1\), \!\(y\
\_1\)}, {\!\(x\_2\), \!\(y\_2\)} (, opts)] \[LongRightArrow] line \
arrowed at {\!\(x\_2\), \!\(y\_2\)}.\\nArrow[{\!\(x\_0\), \
\!\(y\_0\)}, r, {\!\(\[Theta]\_1\), \!\(\[Theta]\_2\)} (, opts)] \
\[LongRightArrow] circular arc arrowed at \
\!\(\[Theta]\_2\).\\nArrow[{\!\(x\_0\), \!\(y\_0\)}, {\!\(r\_1\), \
\!\(r\_2\)}, {\!\(\[Theta]\_1\), \!\(\[Theta]\_2\)} (, opts)] \
\[LongRightArrow] elliptical arc arrowed at \
\!\(\[Theta]\_2\).\\nResembles the Circle primitive, except that \!\(\
\[Theta]\_2\)<\!\(\[Theta]\_1\) is permitted.\\nArrow accepts only a \
sequence of options, not lists or embedded lists or \
options.\>\"";\)\)], "Input",
InitializationCell->True],
Cell[BoxData[
\(\(?Arrow\)\)], "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell["Development", "Subsection"],
Cell["\<\
The basic idea is to draw an arc and then put a very short arrowed \
line at the second end of it. The following issues must be resolved:
\t1. The size of the arrowhead, if relative, must relate to the \
length of the arc rather than the length of the short segment at the \
end of the arc to which the arrow is attached.
\t2. The position and orientation of the short arrowed segment must \
be correct.\
\>", "Text"],
Cell[CellGroupData[{
Cell["Parametric form of the elliptical arc", "Subsubsection"],
Cell[BoxData[
\(\(SetOptions[Graphics, Axes \[Rule] True,
PlotRange \[Rule] {{\(-1\), 1}, {\(-1\), 1}},
AspectRatio \[Rule] 1];\)\)], "Input"],
Cell[BoxData[
\(\(arc1 =
Show[Graphics[{Circle[{0, 0}, { .3, .7}, {0, \[Pi]/2}],
Circle[{0, 0}, { .7, .3}, {\[Pi], 5 \[Pi]/4}],
Line[{{\(-1\), \(-1\)}, {1, 1}}]}]];\)\)], "Input"],
Cell["\<\
The angle in the Circle is that of the following parametric form,\
\>", "Text"],
Cell[BoxData[
\(\(ellipse =
ParametricPlot[{0.7\ Cos[\[Theta]],
0.3\ Sin[\[Theta]]}, {\[Theta], 5 \[Pi]/4, 2 \[Pi]},
PlotStyle \[Rule] {Thickness[0.007],
Dashing[{ .02, .03}]},
PlotRange \[Rule] {{\(-1\), 1}, {\(-1\), 1}},
AspectRatio \[Rule] 1];\)\)], "Input"],
Cell["as can be seen by overlaying the two plots:", "Text"],
Cell[BoxData[
\(\(Show[arc1, ellipse];\)\)], "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell["1. Size of the arrowhead", "Subsubsection"],
Cell["The length of an arc is", "Text"],
Cell[BoxData[
\(Clear[\[Theta], L]\)], "Input"],
Cell[BoxData[
\(TraditionalForm\`L[\[Theta]_] = \[Integral]\((\((r\_1\ \(cos(\
\[Theta])\))\)\^2 + \((r\_2\ \(sin(\[Theta])\))\)\^2)\) \
\[DifferentialD]\[Theta]\)], "Input"],
Cell[TextData[{
"so the length of a segment from ",
Cell[BoxData[
\(TraditionalForm\`\[Theta]\_1\)]],
" to ",
Cell[BoxData[
\(TraditionalForm\`\[Theta]\_2\)]],
" is ",
Cell[BoxData[
\(TraditionalForm\`L[\[Theta]\_2] - L[\[Theta]\_1]\)]],
"."
}], "Text"],
Cell["\<\
What is an appropriate length for the short segment? The longest \
acceptable segment depends upon the resolution of the plot and \
thickness of the line. I don't know these things. So let's just take \
a very small number compared to the maximum radius:\
\>", "Text"],
Cell[BoxData[
\(\[Delta] = 1\/100\ Max[r\_1, r\_2]\)], "Input"]
}, Closed]],
Cell[CellGroupData[{
Cell["2. Position and direction of the arrowhead", "Subsubsection"],
Cell["The position and direction at the second end of an arc are", \
"Text"],
Cell[BoxData[
\(p[\[Theta]_] = {\(r\_1\) Cos[\[Theta]], \(r\_2\)
Sin[\[Theta]]}; p[\[Theta]\_2]\)], "Input"],
Cell[BoxData[
\(\(#\/\@\(# . #\) &\)[\[PartialD]\_\[Theta]
p[\[Theta]]] /. \[Theta] \[Rule] \[Theta]\_2\)], "Input"]
}, Closed]]
}, Closed]],
Cell[CellGroupData[{
Cell["Code", "Subsection"],
Cell["Overload for a circular arc: only one radius is supplied:", \
"Text"],
Cell[BoxData[
\(Graphics`Arrow`Arrow[{x0_, y0_},
r_?NumericQ, {\[Theta]1_?NumericQ, \[Theta]2_?NumericQ},
opts___?OptionQ] :=
Graphics`Arrow`Arrow[{x0, y0}, {r, r}, {\[Theta]1, \[Theta]2},
opts]\)], "Input",
InitializationCell->True],
Cell["Main overload: elliptical arc", "Text"],
Cell[BoxData[
\(Graphics`Arrow`Arrow[{x0_, y0_}, {r1_,
r2_}, {\[Theta]1_?NumericQ, \[Theta]2_?NumericQ},
opts___?OptionQ] := \[IndentingNewLine]Module[{r, x,
y, \[Theta], L, \[Delta], \[CapitalDelta], a, p, s,
rev = Identity, sg = \(+1\), myOpts}, \[IndentingNewLine]x /:
x\_0 = x0; y /: y\_0 = y0; r /: r\_1 = r1;
r /: r\_2 =
r2; \[Theta] /: \[Theta]\_1 = \[Theta]1; \[Theta] /: \
\[Theta]\_2 = \[Theta]2; \[IndentingNewLine]L[\[Theta]_] =
1\/4\ Sin[2\ \[Theta]]\ \((r\_1\%2 - r\_2\%2)\) +
1\/2\ \[Theta]\ \((r\_1\%2 +
r\_2\%2)\); \[CapitalDelta] =
Abs[L[\[Theta]\_2] - L[\[Theta]\_1]]; \[Delta] =
1\/100\ Max[r\_1, r\_2]; a = \[CapitalDelta]/\[Delta];
p /: p\_2 = {x\_0, y\_0} + {Cos[\[Theta]\_2]\ r\_1,
Sin[\[Theta]\_2]\ r\_2};
s /: s\_2 = {\(-Sin[\[Theta]\_2]\)\ r\_1, Cos[\[Theta]\_2]\ r\
\_2}\/\@\(Sin[\[Theta]\_2]\^2\ r\_1\%2 + Cos[\[Theta]\_2]\^2\ r\_2\%2\
\); \[IndentingNewLine]If[\[Theta]\_1 > \[Theta]\_2, \
\[IndentingNewLine]sg = \(-1\);
rev = Reverse\[IndentingNewLine]]; \
\[IndentingNewLine]If[\((\(HeadScaling /. Flatten[{opts}]\) /.
Options[Arrow])\) ===
Relative, \[IndentingNewLine]myOpts =
Flatten[{opts}] /. \((HeadLength \[Rule]
h_)\) \[RuleDelayed] \((HeadLength \[Rule]
a\ h)\), \[IndentingNewLine]myOpts =
Flatten[{opts}]\[IndentingNewLine]]; \
\[IndentingNewLine]{Circle[{x\_0, y\_0}, {r\_1, r\_2},
rev[{\[Theta]\_1, \[Theta]\_2}]],
Arrow[p\_2 - \[Delta]\ sg\ s\_2, p\_2,
Sequence @@ myOpts]}\[IndentingNewLine]]\)], "Input",
InitializationCell->True]
}, Closed]],
Cell[CellGroupData[{
Cell["Local tests", "Subsection"],
Cell[BoxData[
\(\(SetOptions[Graphics, Axes \[Rule] True,
PlotRange \[Rule] Automatic,
AspectRatio \[Rule] 1];\)\)], "Input"],
Cell[BoxData[
\(\(Show[
Graphics[{Arrow[{0, 0}, {1, 1}], Arrow[{0, 0}, 1, {0, 1}],
Arrow[{0, 0}, 0.7, {1, 0}],
Arrow[{0, 0}, 1, {\[Pi], \[Pi] + 1}],
Arrow[{0, 0}, 0.7, {\[Pi] + 1, \[Pi]}],
Arrow[{0, 0}, .85, {130 \[Degree], 110 \[Degree]}],
Arrow[{0, 0}, .85, {130 \[Degree],
150 \[Degree]}]}]];\)\)], "Input"],
Cell[BoxData[
\(\(Show[
Graphics[{Thickness[0.01], Arrow[{0, 0}, {1, 1}],
Arrow[{0, 0}, 1, {0, 1}]}]];\)\)], "Input"],
Cell[BoxData[
\(SetOptions[Arrow, HeadCenter \[Rule] 0.5]\)], "Input"],
Cell[BoxData[
\(\(Show[
Graphics[{Thickness[0.01],
Arrow[{0, 0}, {1, 1}, HeadScaling \[Rule] Relative,
HeadLength \[Rule] .1],
Arrow[{0, 0}, 1, {0, 1}, HeadScaling \[Rule] Relative,
HeadLength \[Rule] .1]}]];\)\)], "Input"]
}, Closed]]
}, Open ]]
},
FrontEndVersion->"4.1 for Microsoft Windows",
ScreenRectangle->{{0, 1280}, {0, 979}},
WindowSize->{724, 740},
WindowMargins->{{36, Automatic}, {Automatic, 46}}
]
Tom Burton