Poets of the 19th century

Question

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?

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 ... — Szabolcs, Oct 25 '14 at 22:02
@Jens: 'Ode to a large shotgun' immediately springs to mind. — DumpsterDoofus, Oct 26 '14 at 00:52
If I were you I'd just put the name of the person on the bar itself. — , Oct 26 '14 at 02:30
You missed Ио́сиф Виссарио́нович Ста́лин — Dr. belisarius, Oct 26 '14 at 04:05
@belisarius. Don't think Joe Stalin qualifies. His poetic work was confined to the 20th century. — m_goldberg, Oct 26 '14 at 05:41

kglr · Accepted Answer · 2021-06-09T19:22:11.753

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]

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]

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]

To remove the callout curves, use

% /. _BSplineCurve -> {}

@eldo my pleasure.. and thank you indeed for a great question. — kglr, Oct 26 '14 at 14:05

Basheer Algohi · Answer 2 · 2014-10-26T05:03:36.357

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

Poets of the 19th century

2 Answers2

Linked