APMA0330

# Figures with Arrows

When one wants to plot a figure that is built from straight lines, it can be done as follows

 ListLinePlot[{3, 4, 1, -2, 0, 3, 4, 1, 2}, PlotStyle->Thick] LinePlot in action. Mathematica code

A directed graph can be plotted as well

 Graph[{1 -> 3, 1 -> 2, 2 -> 4, 4 -> 5, 5 -> 1}] Directed graph. Mathematica code

 With[{q = Pi/6}, Graphics[{Circle[{0, 0}, 1, {q, 2 Pi - q}], Arrowheads[{{.05, .8}}], Arrow[{{Cos[q] + 2, Sin[q]}, {Cos[q], Sin[q]}}], Arrow[{{Cos[q], Sin[-q]}, {Cos[q] + 2, Sin[-q]}}], FontSize -> Medium, Text["\[ScriptCapitalC]", {2, Sin[q]}, {0, -2}]}, Axes -> True, PlotRange -> {{-4, 6}, {-2, 2}}]] Traverse a cut. Mathematica code

If you want to plot the actual contour without arrows, then try something like the following:

 contour[t_, t0_: (5 Pi/6)] := Piecewise[{ {Exp[I (t + Pi)], -t0 < t < t0}, {t - t0 + Exp[I (t0 + Pi)], t >= t0}, {-t - t0 + Exp[-I (t0 + Pi)], t <= -t0}}] ParametricPlot[Through[{Re, Im}[contour[t]]], {t, -8, 8}, PlotPoints -> 30] Traverse a cut. Mathematica code

Another option:

 c = 0.5; t0 = ArcSin[c]; PolarPlot[If[Abs[t] < t0, Abs[Sin[t0]/Sin[t]], 1], {t, -\[Pi], \[Pi]}, Epilog -> { Arrow[{{2, c}, {1, c}}], Arrow[{{1, -c}, {2, -c}}], Arrow[{{-1, .1}, {-1, -.1}}], Text["C", {1.5, c + .1}], Text["C", {1.5, -(c + .1)}] }] Traverse a cut. Mathematica code

Now we show how to add arrows into the graph.

g1=Graphics[Line[{{0,0},{20,0}}]]
g2=Graphics[Line[{{0,0},{15,15}}]]
g3=Graphics[{Opacity[0.2],Brown,Rotate[Rectangle[{8,8},{12,12}], 45 Degree, {Left, Bottom}]}]
g4=Graphics[{Blue, Thickness[0.01], Arrow[{{8,10.8}, {8,2.8}}]}]
g5=Graphics[{Cyan, Thickness[0.01], Arrow[{{8,10.8}, {3.8,15}}]}]
g6=Graphics[{Green, Thickness[0.01], Arrow[{{2.4,5.2}, {6.6,9.4}}]}]
g7 = Graphics[ Text[StyleForm["Weight", FontSize -> 14, FontWeight -> "Bold", FontColor -> Blue], {9.4, 6.8}, {0.4, 1}, {0, -1}]]
g8=Graphics[ Text[StyleForm["Normal", FontSize -> 14, FontWeight -> "Bold", FontColor -> Cyan], {6, 13}, {0, -1}, {1, -1}]]
g9=Graphics[ Text[StyleForm["Friction", FontSize -> 14, FontWeight -> "Bold", FontColor -> Green], {4.5, 7.2}, {0, 1}, {1, 1}]]
Show[g1,g2,g3,g4,g5,g6,g7,g8,g9]
 ContourPlot[x^2 + y^2 == 9, {x, -2, 2}, {y, -2, -3.1}, AspectRatio -> 0.5] /. Line[x__] :> Sequence[Arrowheads[{-.04, .04}], Arrow[x]] Curve with arrows. Mathematica code

We can add arrows to multiple plots:

 rules = {GraphicsComplex[x_, y_] :> GraphicsComplex[SortBy[x, ArcTan[#[[1]], #[[2]]] + (\[Pi]/2) &], y /. Line[pts_] :> {Arrowheads[{{-0.05, 1/8}, {-0.05, 5/8}}], Arrow[pts]}]} Show @@ Table[ ContourPlot[x^2 + 2*y^2 == r^2, {x, -r, r}, {y, -r, r}, PlotPoints -> 100, ContourShading -> False, ContourStyle -> {Black, Thick}] /. rules, {r, 5, 1, -1}] Family of curves with arrows. Mathematica code

To add uniform arrows to the graph, we use Alexey Popkov's completePlotRange for computing the actual PlotRange of a plot.

completePlotRange[plot : (_Graphics | _Graphics3D | _Graph)] :=
Last@Last@
Reap[Rasterize[
Show[plot, Axes -> True, Frame -> False,
Ticks -> ((Sow[{##}]; Automatic) &),
DisplayFunction -> Identity, ImageSize -> 0],
ImageResolution -> 1]]
 Block[{f, f0, df0, ar, plot}, f = (0.9 - x^2)^(-0.5); f0 = Log[f] /. x -> x0; df0 = D[Log[f], x] /. x -> x0; plot = LogPlot[f, {x, 0, 1}, PlotRange -> {{0, 1.3}, {0.66, 20}}, Frame -> {{True, True}, {True, False}}, ImageSize -> 400, PlotStyle -> {Directive[Black, Thick], Automatic}, BaseStyle -> {FontSize -> 30}, RotateLabel -> False, AspectRatio -> 1]; ar = If[(AspectRatio /. Options[plot, AspectRatio]) === Automatic, 1, (AspectRatio /. Options[plot, AspectRatio])/ Ratios[Differences /@ completePlotRange@plot][[1, 1]]]; Show[plot, Graphics[{Red, Thick, Table[Arrow[{{x0, f0}, {x0, f0} + 0.5 {1, df0}/Norm[{1, df0*ar}]}], {x0, 0.1, 0.9, 0.2}]}]]] Demonstration of Popkov's block. Mathematica code

 Now we show how to plot figure when arrows are attached to curves/circles. Show[ParametricPlot[#[[1]]*{Cos[θ], Sin[θ]}, {θ, #[[2]], #[[3]]}, Axes -> False, PlotStyle -> #[[4]]] /. Line[x_] :> Sequence[Arrowheads[{-0.05, 0.05}], Arrow[x]] & /@ {{1, 0 Degree, 90 Degree, Red}, {1.25, 0 Degree, 270 Degree, Blue}, {1.5, 0 Degree, 180 Degree, Green}}, PlotRange -> All] Circles with arrows. Mathematica code

 Here is another block of codes with Manipulation option that allows you to change the size of arc. start = \[Pi]; Manipulate[ Graphics[{Arrow[{{Cos[\[Theta] + If[\[Theta] < start, .01, -.01]], Sin[\[Theta] + If[\[Theta] < start, .01, -.01]]}, {Cos[\[Theta]], Sin[\[Theta]]}}], Circle[{0, 0}, 1, {start, \[Theta]}]}, PlotRange -> 2], {{\[Theta], .7 start}, 0, 2 start}] An arc with an arrow. Mathematica code

 When you need to see the center of the circle, use the folloiwng code: Manipulate[ Graphics[{arcArrow[center, radius, {start, end}], PointSize[Large], Blue, If[showCenter, Point[center]]}, PlotRange -> p, ImageSize -> 250], {{start, \[Pi]/2}, -2 \[Pi], 2 \[Pi], ImageSize -> Small}, {{end, 0}, -2 \[Pi], 2 \[Pi], ImageSize -> Small}, {{radius, 1}, 1/2, 4, ImageSize -> Small}, {{center, {0, 0}}, {-p, -p}, {p, p}, Slider2D}, {showCenter, {True, False}}, Initialization :> {p = 3; arcArrow[a_, r_, {start_, end_}] := {Circle[a, r, {start, end}], Arrowheads[Medium], Arrow[{a + r {Cos[end + If[end < start, .01, -.01]], Sin[end + If[end < start, .01, -.01]]}, a + r {Cos[end], Sin[end]}}]}}] An arc with an arrow and the center. Mathematica code

Using Circle, define the function f (or whatever you want)
f[s_Circle] := s /. Circle[a_, r_, {start_, end_}] :> ({s, Arrow[{# - r/10^6 {-Sin@end, Cos@end}, #}]} &[ a + r {Cos@end, Sin@end}])
 Concave up: Graphics@{Thickness[0.005], f[Circle[{0, 0}, 1, {4 Pi/3, 2 Pi}]]}

 Concave down: Graphics@{Red, Thick, f[Circle[{0, 0}, 1, {- Pi/6, Pi}]]}

You can use Circle directly with anderfining procedure:
Unprotect[Circle]; Circle[a_: {0, 0}, r_: 1, {start_, end_}] := Block[{$inMsg = True}, {Circle[a, r, {start, end}], Circle[a, r, {start, end}] /. Circle[aa_, ar_, {astart_, aend_}] :> (Arrow[If[start < end, #, Reverse@#]] &@ {# - r/10^6 {-Sin@end, Cos@end}, #} & [aa + ar {Cos@aend, Sin@aend}])} ] /; ! TrueQ[$inMsg]; Protect[Circle];
Then plot two circle arcs in a row:
GraphicsGrid[{{Graphics@Circle[{0, 0}, 1, {2*Pi, 4*Pi/3}], Graphics@Circle[{0, 0}, 1, { 4*Pi/3, 2*Pi}]}}]
A function using a single ParametricPlot with multiple circles with arrows:
ClearAll[arcsWArrows];
arcsWArrows[args1 : {{_, {_, _}} ..},
dir_List: {Directive[GrayLevel[.3],
ParametricPlot[
Evaluate[#[[1]]*{Cos[Rescale[u, {0, 2 Pi}, Abs@#[[2]]]],
Sin[Rescale[u, {0, 2 Pi}, Abs@#[[2]]]]} & /@ args1], {u, 0,
2 Pi}, PlotStyle -> dir, Axes -> False, PlotRangePadding -> .2,
ImageSize -> 200] /. Line[x_, ___] :> Arrow[x]
Then we use this function:
dsAndAngls = {{1, {0, \[Pi]/
2}}, {1.25, {0, \[Pi]}}, {1.5, {0, (3 \[Pi])/2}}, {2, {\[Pi]/
4, (4 \[Pi])/2}}};
directives = {Directive[Red, Thick,
Directive[Blue, Dashed, Arrowheads[{{-0.05, 0}, {0.05, 1}}]],
Directive[Orange, Thickness[.02], Arrowheads[{{-0.07, 0}, {0.07, 1}}]]};

Row[{arcsWArrows[rdsAndAngls],
arcsWArrows[rdsAndAngls, {directives[[1]]}],
arcsWArrows[rdsAndAngls, directives],
arcsWArrows[rdsAndAngls, directives[[-1 ;; 2 ;; -1]]]}]
Another option gives Manipulate command:
Manipulate[ pts = N@Table[{Cos[k], Sin[k]}*r + o, {k, α Degree, β Degree, (β Degree - α Degree)/d}];
Show[
Graphics[{Lighter@Pink, AbsoluteThickness@10, Circle[o, r, {α Degree, β Degree}]}],
Graphics[{Arrow[pts, 0]}],
PlotRange -> {{-1.3, 1.3}, {-1.3, 1.3}}, AspectRatio -> 1,
Axes -> True, ImageSize -> 250 ],
{{d, 20, "res."}, 1, 100, Appearance -> "Labeled"},
{{α, 0, "α"}, 0, 360, Appearance -> "Labeled"},
{{β, 250, "β"}, 0, 360, Appearance -> "Labeled"},
{{r, 1, "r"}, 0.01, 2, Appearance -> "Labeled"},
{{o, {0, 0}, "origo"}, {-1, -1}, {1, 1}},
ControlPlacement -> Left ]
Next, we plot a simple curve that is generated by splines and is finished with arrow:
Graphics[Arrow[ BSplineCurve[Table[{Cos[x], Sin[x]}, {x, 0, Pi*3/4, Pi/20}]]]]

We plot a function that has the graph with ended arrows.

 f[x_] := Sin[12 x^2]; xmin = -1; xmax = 1; small = .01; Plot[f[x], {x, xmin, xmax}, PlotLabel -> y == f[x], AxesLabel -> {x, y}, Epilog -> {Blue, Arrow[{{xmin, f[xmin]}, {xmin - small, f[xmin - small]}}], Arrow[{{xmax, f[xmax]}, {xmax + small, f[xmax + small]}}]}] Graph ends with arrows. Mathematica code

Finally, we demontrate some examples of plotting with text and arrows.
 P1 = Plot[x, {x, 0, 2}, PlotStyle -> {Dashed, Red}, Filling -> Bottom]; P2 = Plot[6 x, {x, 0, 2}, PlotStyle -> {Dashed, Blue}]; Show[P1, P2, AspectRatio -> Automatic, Frame -> True, PlotRangePadding -> None, AxesOrigin -> {0, 0}, Axes -> None, FrameStyle -> Directive[Black], LabelStyle -> {18, Bold}, FrameLabel -> {{None, "T"}, {"w", None}}, ImageSize -> 500, Epilog -> { Arrow[{{.2, .2}, {.1, .1}}], Arrow[{.05 {1, 6}, {1, 6} .02}], Rotate[Text[Style["w=t", FontSize -> 20], {.95, 1.1}], Pi/4]}] Text with arrows using Plot Mathematica code

Another example:

 Plot[{3 Sin[x], 2*Cos[x]}, {x, -6, 6}, PlotStyle -> {{Thickness[0.007], Dashed, Red}, {Thickness[0.007], Orange}}, Epilog -> {{Arrow[{{5, 1.8}, {3, 1}}], Text["sin(x)", {5, 2}], Arrow[{{-3.5, 2.8}, {-1, 1}}], Text["Cos(x)", {-3.5, 3}]}}] Text with arrows using Plot Mathematica code

 arrowhead1 = Polygon[{{-1, 0.5}, {0, 0}, {-1, -0.5}}]; arrowhead2 = Polygon[{{-1.5833333333333333, 0.4166666666666667}, {-1.5410500000000003, 0.369283333333333}, {-1.448333333333333, 0.255583333333333}, {-1.3991000000000005, 0.18721666666666673}, {-1.3564666666666663, 0.11826666666666673}, {-1.3268499999999999, 0.05408333333333341}, {-1.3166666666666667, 0.}, {-1.3268499999999999, -0.048950000000000195}, \ {-1.3564666666666663, -0.11228333333333372}, {-1.3991000000000005, \ -0.18353333333333333}, {-1.448333333333333, -0.2562833333333335}, \ {-1.5410500000000003, -0.38048333333333345}, {-1.5833333333333333, \ -0.43333333333333335}, {0., 0.}, {-1.5833333333333333, 0.4166666666666667}, {-1.5833333333333333, 0.4166666666666667}}]; arrowhead3 = Polygon[{{-1, 0.5}, {0, 0}, {-1, -0.5}, {-0.6, 0}, {-1, 0.5}}]; arrowhead4 = {{FaceForm[GrayLevel[1]], Polygon[{{-0.6, 0}, {-1., 0.5}, {0., 0}, {-1., -0.5}, {-0.6, 0}}], Line[{{-0.6, 0}, {-1., 0.5}, {0., 0}, {-1., -0.5}, {-0.6, 0}}]}}; arrowhead5 = Polygon[{{-0.6582278481012658, -0.43037974683544306}, {0., 0.}, {0., 0.}, {0., 0.}, {0., 0.}, {0., 0.}, {-0.6455696202531646, 0.43037974683544306}, {-0.4810126582278481, 0.}, {-0.6582278481012658, -0.43037974683544306}, \ {-0.6582278481012658, -0.43037974683544306}}]; Plot[2*Sin[x] - Cos[x], {x, -2 \[Pi], 2 \[Pi]}, AxesStyle -> {Directive[{Red, Arrowheads[{{-0.06, 0.1(*Xleft*), {Graphics[{arrowhead}] /. arrowhead -> arrowhead2, 0.98}}, {0.05, 0.95(*Xright*), {Graphics[{arrowhead}], 0.98}}}] /. arrowhead -> arrowhead4}], Directive[{Blue, Arrowheads[{{-0.05, 0(*Ydown*), {Graphics[{arrowhead}] /. arrowhead -> arrowhead3, 0.98}}, {0.03, .8(*Yup*), {Graphics[{arrowhead}] /. arrowhead -> arrowhead1, 0.98}}}]}]}] Demonstration of arrows. Mathematica code

 axes[x_, y_, f_, a_] := Graphics[Join[{Arrowheads[a]}, Arrow[{{0, 0}, #}] & /@ {{x, 0}, {0, y}}, {Text[ Style["x", FontSize -> Scaled[f]], {0.9*x, 0.2*y}], Text[Style["y", FontSize -> Scaled[f]], {0.1 x, 0.95*y}]}]] Show[Plot[1/2*Sin[x] - Cos[x], {x, -\[Pi], \[Pi]}, Axes -> None, PlotRange -> {{-Pi, Pi}, {-1.5, 2.5}}], axes[3, 1.4, 0.05, 0.06]] Figure with coordinate arrows. Mathematica code

 h = Graphics[Line[{{-1, 1/2}, {0, 0}, {-1, -1/2}}]]; Plot[1/2*Sin[x] - Cos[x], {x, 0, 10}, PlotStyle -> Thick, AxesStyle -> Arrowheads[{{Automatic, Automatic, h}}]] Plot with custom arrowsheads. Mathematica code

 Plot[1/2*Sin[x] - Cos[x], {x, -2 \[Pi], 2 \[Pi]}, AxesStyle -> {Directive[{Red, Arrowheads[{{-0.06, 0(*Xleft*), {Graphics[{Polygon[{{-1, 0.5}, {0, 0}, {-1, -0.5}}]}], 0.98}}, {0.03, .9(*Xright*), {Graphics[{Polygon[{{-1, 0.5}, {0, 0}, {-1, -0.5}}]}], 0.98}}}]}], Directive[{Blue, Arrowheads[{{-0.05, 0(*Ydown*), {Graphics[{Polygon[{{-1, 0.5}, {0, 0}, {-1, -0.5}}]}], 0.98}}, {0.03, .8(*Yup*), {Graphics[{Polygon[{{-1, 0.5}, {0, 0}, {-1, -0.5}}]}], 0.98}}}]}]}] Plot with triangle arrowsheads. Mathematica code