3
$\begingroup$

I have a Barchart like this:

data = {{1995, 0.5, 0.2, 0.3}, {1996, 0.4, 0.3, 0.3}, {1997, 0.5, 0.1, 0.4}, {1998, 0.6, 0.1, 0.3}, {1999, 0.9, 0, 0.1}, {2000, 0.5, 0.2, 0.3}, {2001, 0.5, 0.5, 0}, {2002, 0.5, 0.5, 0}, {2003, 0.5, 0.5, 0}, {2004, 0.3, 0.7, 0}, {2005, 0.1, 0.9, 0}}; BarChart[data[[All, 2 ;; 4]], ChartLayout -> "Percentile", Frame -> {True, True, False, False}, PlotRange -> {{All, All}, {All, All}}, PlotRangePadding -> {{0, 0.3}, {0, 0}}, PlotLabel -> Style["Label", Black, 18], FrameLabel -> {None, Style["relative share [%]", 14]}, ChartLabels -> {Placed[IntegerPart[data[[All, 1]]], Axis, Rotate[#, Pi/2] &], None}, ChartLegends -> {"1", "2", "3"}, ChartStyle -> {Red, Blue, Green}, BarSpacing -> {0, 1}, LabelStyle -> {FontFamily -> "Arial", 12}, BaseStyle -> {FontFamily -> "Arial", 12}, ImageSize -> {700, 400}]

Now I have some events which occur in specific years like in this timeline:

timeline = TimelinePlot[{Labeled[DateObject[{1998}], "Event A"], Labeled[DateObject[{2001}], "Event B"], Labeled[DateObject[{2005}], "Event C"]}]

Now I want to combine theses two plots so that the timeline is under the barchart but it should be well aligned (years in the same position and the callouts below the time axis). Is there a way to do this? Or maybe there is a better solution instead of TimeLinePlot?

Improve this question
$\endgroup$

1 Answer 1

Reset to default
5
$\begingroup$
  1. To use DateHistogram instead of BarChart (so that the chart and the timeline plot share a common date axis) we construct a list of WeightedData objects: 

wd = WeightedData[data[[All, {1}]], data[[All, #]]] & /@ {2, 3, 4};
  1. To use the graphics primitives produced by TimelinePlot as Epilog in DateHistogram we need to modify the vertical scales and positions of primitives. The function translateScale does this job.

ClearAll[translateScale] translateScale[t_: - .07, s_: .05] := GeometricTransformation[#, TranslationTransform[{0, t}] @* ScalingTransform[{1, s}]] &;

Examples:

timeline = TimelinePlot[{Labeled[DateObject[{1998, 7, 15}], "Event A"], Labeled[DateObject[{2001, 7, 15}], "Event B"], Labeled[DateObject[{2005, 7, 15}], "Event C"]}, AxesOrigin -> Top, PerformanceGoal -> "Speed"]; dh = DateHistogram[wd, "Year", ChartLayout -> "Stacked", ChartStyle -> {Red, Green, Blue}, ImageSize -> Large, Ticks -> {AbsoluteTime /@ Thread[{data[[All, 1]], 7, 15}], Automatic}, DateTicksFormat -> {"Year"}, ChartBaseStyle -> Opacity[1], PlotRangeClipping -> False, ImagePadding -> {{Automatic, 50}, {120, 10}}, Epilog -> translateScale[][First @ timeline]]

enter image description here

Add the option PlotLayout -> "Grouped" in timeline and re-evaluate dh to get:

enter image description here

Post-process dh to add spacing between groups:

dh /. RectangleBox[{a_, b_}, {c_, d_}, e_] :> RectangleBox[{a + (c - a)/6, b}, {c - (c - a)/6, d}, e]

enter image description here

$Version

11.3 .0 for Microsoft Windows (64 - bit) (March 7, 2018)

Note: In Version 12.0, change RectangleBox to Rectangle in the replacement rule for modifying spacings.

Update: To rotate date labels, you can use

Ticks -> {{#, Rotate[DateString[#, "Year"], 90 Degree]} & /@ AbsoluteTime /@ Thread[{data[[All, 1]], 7, 15}], Automatic}

and Epilog -> translateScale[-.1][First @ timeline] to get

enter image description here

Improve this answer
$\endgroup$
6
  • $\begingroup$ that is brilliant, thx! However, after replicating your code, the last row (add spacing between the bars) does not seem to work... $\endgroup$ Commented Jan 31, 2020 at 6:55
  • $\begingroup$ @M.A., can you post a small example where the replacement rule to change spacings doesn't work? $\endgroup$ Commented Jan 31, 2020 at 7:37
  • $\begingroup$ @M.A., it could be version/OS-related. I am using version 11.3 (windows 10-64bit). $\endgroup$ Commented Jan 31, 2020 at 8:48
  • 1
    $\begingroup$ @M.A., just tried the same example in v12.0 (wolfram cloud). It seems that the only change needed is to replace RectangleBox with Rectangle. $\endgroup$ Commented Jan 31, 2020 at 8:58
  • $\begingroup$ I tried to combine insights form this post here (mathematica.stackexchange.com/questions/183528/…) in order to rotate the ticks. It works but the years are not centered in the middle of the bars but on left side. any idea? $\endgroup$ Commented Jan 31, 2020 at 13:59

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.