2
$\begingroup$

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

enter image description here

(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?

$\endgroup$
4
$\begingroup$

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

Mathematica graphics

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, 
 PlotRangePadding -> .1]

Mathematica graphics

$\endgroup$
  • $\begingroup$ 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$. $\endgroup$ – Vaggelis_Z Apr 28 '16 at 12:15
  • $\begingroup$ So the labels should go as {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11}? $\endgroup$ – Jason B. Apr 28 '16 at 12:17
  • $\begingroup$ The labels should be {x_0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, x_f}. $\endgroup$ – Vaggelis_Z Apr 28 '16 at 12:18
  • $\begingroup$ Excellent! Many thanks :) $\endgroup$ – Vaggelis_Z Apr 28 '16 at 12:26
  • $\begingroup$ In Mathematica v9 I cannot reproduce the second plot. The code is not being evaluated. $\endgroup$ – Vaggelis_Z Apr 28 '16 at 12:30
3
$\begingroup$
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]

enter image description here

$\endgroup$
  • $\begingroup$ Nice, but the last arrow after $P_f$ is not needed! $\endgroup$ – Vaggelis_Z Apr 28 '16 at 12:58
  • $\begingroup$ @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 $\endgroup$ – Jason B. Apr 28 '16 at 13:08
  • $\begingroup$ @Vaggelis_Z Edited $\endgroup$ – Hubble07 Apr 28 '16 at 14:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.