Combining BarChart and Grid - IPCC style

Question

I would like to combine a plot with a table. Something like this famous plot/table from IPCC:

So after reading Combining graphics & lists / tables I tried an approach using Grid. Pretty close but it feels quite hacked, especially the frame-ticks. The IPCC plot/table looks much nicer. Maybe they just used a graphics program and made it look nice. I wonder if it can be done nicely in Mathematica?

t1 = Table[BarChart[{{0, -0.2}, {0, 0.3}, {0, -0.1}}[[i]],
Frame -> False, PlotRange -> {{-0.45, 0.45}, {1.5, 2.5}}, 
BarOrigin -> Left, FrameTicks -> {Automatic, None}, 
GridLines -> {{0, {0.2, Dashed}, {-0.2, Dashed}}, None}], {i, 
3}];
f1 = BarChart[{0, 1},
  Frame -> {{False, False}, {True, False}}, 
  PlotRange -> {{-0.45, 0.45}, {0, 0.1}}, Axes -> False, 
  BarOrigin -> Left, FrameTicks -> {Automatic, None}, 
  AspectRatio -> 0.05]
reference = {"Sepp 2013", "Hans 2000", "Franz 1999"};
t2 = Thread@{{"c1", "c2", "c2"}, t1, reference};
PrependTo[t2, {"", "Plot", "Ref"}];
AppendTo[t2, {"", f1, ""}];
Style[Grid[t2, Frame -> All, 
  Background -> {None, {None, LightYellow, None, LightYellow, None}}, 
  Spacings -> {Automatic, 0}], FontFamily -> "Helvetica"]

Answer 1

Here is an idea, I'm a bit lazy to make it look as great as the IPCC one since it's mostly about tweaking the Grid and adding some text. The tricks here are: ImagePadding, Frame and its Opacity.

(* data from the original figure *)
num = {{1.66}, {0.48, 0.16, 0.34}, {-0.05, 0.35}, {-0.2}, {0.1}, {-0.7}};
err = {{1.49, 1.83}, {0.31 + 0.48 + 0.16, 0.37 + 0.48 + 0.16}, {-0.15, 0.65}, 
       {-0.4, 0.0}, {0.0, 0.2}, {-1.8, -0.3}};
list = ({Rule[#, #2]} & @@@ Thread@{num, err});

(* errorBar modified from Documentation *)
errorBarLeft[type_: "Rectangle"][{{x0_, x1_}, {y0_, y1_}}, value_, meta_] :=
 Block[{error}, error = Flatten[meta];
  If[error === {}, 
   ChartElementData[type][{{x0, x1}, {y0, y1}}, value, meta],
   {ChartElementData[type][{{x0, x1}, {y0, y1}}, value, meta], {Black,
      [email protected], Line[{
       {{First@error, (y0 + y1)/2}, {Last@error, (y0 + y1)/2}},
       {{First@error, (y0 + y1)/1.5}, {First@error, (y0 - y1)/-1.5}},
       {{Last@error, (y0 + y1)/1.5}, {Last@error, (y0 - y1)/-1.5}}}]}}]]

barChart[lst_, {top_, bottom_}, op_, pad_] := 
 BarChart[lst, ChartElementFunction -> errorBarLeft["Rectangle"], 
  Axes -> False, GridLines -> {{#, Dashed} & /@ Range[-2, 2], None},
  Method -> {"GridLinesInFront" -> True}, BarOrigin -> Left,
  PlotRange -> {{-2, 2}, {.3, 1.6}}, AspectRatio -> 1/5, ChartLayout -> "Stacked", 
  ColorFunction -> If[First@First@First@lst > 0, 
    (Blend[{Red, Yellow}, #] &), (Blend[{Blue, Red}, #] &)], 
  Frame -> {{False, False}, {bottom, top}}, 
  FrameTicks -> {{False, False}, {All, All}}, FrameStyle -> Opacity@op, 
  ImagePadding -> {{Automatic, Automatic}, pad}]

(* Taken from OP's question *)

plots = Flatten@{barChart[First@list, {True, False}, 1, {0, Automatic}], 
    barChart[#, {True, True}, 0, {0, 0}] & /@ list[[2 ;; -2]], 
    barChart[Last@list, {False, True}, 1, {Automatic, 0}]};
(* Version 8 *)
reference = 
  Rule[#, #2] & @@@ Thread[{Column /@ 
      Table[Style[num[[i, #1]], #2, Bold] & @@@ 
        Thread[{Range@Length@num[[i]], 
          Cases[plots[[i]], RGBColor[__], Infinity][[2 ;;]]}], {i, Length@num}], err}];
(* Version 9 *)
(*
reference = 
  Rule[#, #2] & @@@ Thread[{Column /@ 
      Table[Style[num[[i, #1]], #2, Bold] & @@@ 
        Thread[{Range@Length@num[[i]], 
          Cases[plots[[i]], RGBColor[__], Infinity]}], {i, Length@num}], err}];*)
t2 = Thread@{StringForm["c``", #] & /@ Range@Length@list, plots, reference};
PrependTo[t2, {"", "Plot", "Ref"}];

Grid[t2, Frame -> {All, True}, 
 Background -> {None, Riffle[Array[None &, Ceiling[Length@list/2] + 1], LightYellow]}, 
 Spacings -> {Automatic, 0}]

---

Main problem, errorBarLeft should be tweaked so one can have a negative and a positive one (see the BarChart number 3 with its single error bar).