Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2001

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: Peculiar behavior of DiscreteDelta
  • Next by Date: Re: Replacing Parts of a List
  • Previous by thread: Re: How to make curved arrows?
  • Next by thread: Re: How to make curved arrows?