# Creating a custom ListPlot of consecutive points

Here comes some sample data

data = {{0, 0.7, 0.4}, {1, 0.831177, 0.51854}, {2, 1.11106, 0.463533},
{3, 1.84226, -0.642571}, {4, 0.677049, -0.327877},
{5, 0.77886, -0.451322}, {6, 0.965874, -0.508772},
{7, 1.34397, -0.202473}, {8, 1.01761, -0.717013},
{9, -0.0507992, -1.3864}, {10, -0.102145, -0.957957},
{11, -0.00228078, -0.861489}}


The first integer is a counter, while the other two reals are the $(x,y)$ coordinates.

Let's plot these points

d0 = data[[All, {2, 3}]];
L0 = ListPlot[d0, Joined -> True, Mesh -> All,
PlotStyle -> {Black, Thickness[0.002], PointSize[0.012]},
Frame -> True, Axes -> False, PlotRange -> All, ImageSize -> 500]


Now I want the customize the plot as follows:

(a). Add arrows showing the evolution of the points, like

(b). The first point with counter 0 should be plotted in red, while the last point should be plotted in blue.

(c). Add labels near to the points indicating the corresponding counter (e.g, 2, 3, etc). The label of the first point should be $P_0$, instead of 0, while for the last point the label should be $P_f$.

Any suggestions?

Use a Graph with directed edges

labels = Thread[
Range[12] -> (Placed[#, Above] & /@
Join[{Subscript[x, 0]}, Range[10], {Subscript[x, f]}])];
Graph[# \[DirectedEdge] # + 1 & /@ Range[11], VertexCoordinates -> d0,
VertexLabels -> labels, VertexStyle -> {1 -> Red, 12 -> Blue}]


Or, if you need to have it look like the plot above,

labels = Thread[
Range[12] -> (Placed[#, Above] & /@
Join[{Subscript["x", 0]}, Range[10], {Subscript["x", "f"]}])];
labels = MapAt[Style[#, 15, FontFamily -> "Times New Roman"] &,
labels, {All, 2, 1}];
Show[
Graph[# \[DirectedEdge] # + 1 & /@ Range[11],
VertexCoordinates -> d0, VertexLabels -> labels,
VertexStyle -> {1 -> Red, 12 -> Blue}],
Frame -> True, FrameTicks -> Automatic, ImageSize -> 500,


• Nice work! a couple of issues: (a). the labels should be just 2,3,4,... not P_2, P_3, ..., (b). The last point should be blue and (c) the label of the first point should be $P_0$ instead of $P_f$. Commented Apr 28, 2016 at 12:15
• So the labels should go as {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11}? Commented Apr 28, 2016 at 12:17
• The labels should be {x_0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, x_f}. Commented Apr 28, 2016 at 12:18
• Excellent! Many thanks :) Commented Apr 28, 2016 at 12:26
• In Mathematica v9 I cannot reproduce the second plot. The code is not being evaluated. Commented Apr 28, 2016 at 12:30
r3 = AppendTo[Table[{Graphics[{Text[
Which[i == 1, Subscript[P, 0], i == Length[d0], Subscript[P, f],
True, ToString[i - 1]], Offset[{0, 10}, d0[[i]]]]}],
Graphics[{PointSize[Large], Which[i == 1, Red],
Which[i == Length[d0] - 1, {Point[d0[[i]]], Blue,
Point[d0[[i + 1]]]}, True, Point[d0[[i]]]]}],
Graphics[{Arrow[d0[[i ;; i + 1]]]}],
Graphics[{White, Point[{0.5, 0.6}]}]}, {i, 1, Length[d0] - 1}],
Graphics[{Text[Subscript[P, f], Offset[{0, 10}, Last@d0]]}]]

Show[r3, Frame -> Automatic]


• Nice, but the last arrow after $P_f$ is not needed! Commented Apr 28, 2016 at 12:58
• @Vaggelis_Z - I think the issue there is that the last point is omitted, since the table is iterated over {i, 1, Length[d0] - 1} the last point gets missed. A similar effect is had here but without the labeling concerns Commented Apr 28, 2016 at 13:08
• @Vaggelis_Z Edited Commented Apr 28, 2016 at 14:30