34
$\begingroup$ 
fun[p_] :=
 Module[{per, bd, dd},
  per = Interpreter["Person"][p];
  bd = DateValue[PersonData[per, "BirthDate"], "Year"];
  dd = DateValue[PersonData[per, "DeathDate"], "Year"];
  Range[bd, dd]]

names = 
 {"Napoleon Bonaparte", "Jane Austen", "Hegel", "Marx", "Gauss", "Madame de Stael", "Lenin"};

res = fun /@ names;
par = Partition[#, 2] & /@ Table[Riffle[res[[n]], n] ~ Join ~ {n}, {n, 1, Length @ res}];

ListLinePlot[par,
 ColorFunction -> "Rainbow",
 Ticks -> {Range[1750, 1980, 10], Automatic},
 GridLines -> {Range[1750, 1920, 10], None},
 PlotLegends -> 
  SwatchLegend["Rainbow", names, LegendLayout -> "ReversedColumn", LegendMarkerSize -> {{10, 10}}],
 PlotStyle -> Thickness[0.02],
 ImageSize -> 600]

enter image description here

How can I align the legend to their lifespan bars?

Improve this question
$\endgroup$
9
  • $\begingroup$ I suspect that this is going to be difficult if you use standard legending. (I might be wrong.) I would build the legend by hand as a Graphics objects and specify the coordinates to match the plot. Then the task is to align the legend with the plot, which can be accomplished either by using Row and setting the ImageMargin on the top and bottom by hand (to make sure they're the same on the legend and the plot) or I would use a package like SciDraw. SciDraw is great but takes time to learn. I do hope someone will post an easier solution though ... $\endgroup$
    – Szabolcs
    Oct 25, 2014 at 22:02
  • 4
    $\begingroup$ Lenin was a poet?? $\endgroup$
    – Jens
    Oct 25, 2014 at 22:34
  • 2
    $\begingroup$ @Jens: 'Ode to a large shotgun' immediately springs to mind. $\endgroup$
    – DumpsterDoofus
    Oct 26, 2014 at 0:52
  • 2
    $\begingroup$ You missed Ио́сиф Виссарио́нович Ста́лин $\endgroup$
    – Dr. belisarius
    Oct 26, 2014 at 4:05
  • 1
    $\begingroup$ @m_goldberg His work was atemporal $\endgroup$
    – Dr. belisarius
    Oct 26, 2014 at 13:55

2 Answers 2

Reset to default
43
$\begingroup$

Use the individual legends as tick labels:

dates = Through[{First, Last}@#] & /@ res

{{1769, 1821}, {1775, 1817}, {1770, 1831}, {1818, 1883}, {1777, 1855}, {1766, 1817}, {1870, 1924}}

llpd = MapIndexed[Thread@{#, First@#2} &, dates];

legends = MapIndexed[SwatchLegend[{ColorData[{"Rainbow", {1, 7}}][## & @@ #2]}, {#},
                     LegendMarkerSize -> {{10, 10}}] &, names];

ListLinePlot[llpd, Joined -> True, ColorFunction -> "Rainbow",
  Frame -> True, 
  FrameTicks -> {{None,Thread[{Range[7], legends}]}, {Range[1750, 1930,20], Automatic}},
  GridLines -> {Range[1750, 1920, 10], None},
  AxesOrigin -> {1750, 0}, PlotRange -> {{1750, 1930}, {0, 8}},
  PlotStyle -> Directive[Thickness[0.05], CapForm["Butt"]], ImageSize -> 600]

enter image description here

Label the bars with names:

ListPlot[llpd, Joined -> True, ColorFunction -> "Rainbow",
  Frame -> True,
  FrameTicks -> {{None, None}, {Range[1750, 1930,20], Automatic}},
  GridLines -> {Range[1750, 1920, 10], None},
  Epilog -> (Text[Style[#2, 12, Bold], Mean@#1] & @@@ Transpose[{llpd, names}]),
  AxesOrigin -> {1750, 0}, PlotRange -> {{1750, 1930}, {0, 8}},
  PlotStyle -> Directive[Thickness[0.05], CapForm["Butt"]], ImageSize -> 600]

enter image description here

Use the option PlotLabels

In versions 10.4+, we can also use the option PlotLabels:

ListLinePlot[llpd, Joined -> True, 
 PlotLabels -> legends, 
 ColorFunction -> "Rainbow", Frame -> True, 
 GridLines -> {Range[1750, 1920, 10], None}, AxesOrigin -> {1750, 0}, 
 PlotRange -> {{1750, 1930}, {0, 8}}, 
 PlotStyle -> Directive[Thickness[0.05], CapForm["Butt"]], ImageSize -> 600]

enter image description here

To remove the callout curves, use

% /. _BSplineCurve -> {}

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ Thank you very much for the two excellent solutions :) $\endgroup$
    – eldo
    Oct 26, 2014 at 14:03
  • $\begingroup$ @eldo my pleasure.. and thank you indeed for a great question. $\endgroup$
    – kglr
    Oct 26, 2014 at 14:05
10
$\begingroup$

Borrowing from kguler the legends

    legends = 
 MapIndexed[
  SwatchLegend[{ColorData[{"Rainbow", {1, 7}}][## & @@ #2]}, {#}, 
    LegendMarkerSize -> {{10, 10}}] &, names]; 
p1 = 
 ListLinePlot[par, ColorFunction -> "Rainbow", 
  Ticks -> {Range[1750, 1980, 10], Automatic}, 
  PlotRangePadding -> {{5, 50}, {0, 1}}, 
  GridLines -> {Range[1750, 1920, 10], None}, 
  PlotStyle -> Thickness[0.02], ImageSize -> 600];
 p2 = 
 Graphics[Inset[
     legends[[#]], {1940 + StringLength[names[[#]]], #}] & /@ 
   Range[7]]; Show[p1, p2]

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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