15
$\begingroup$

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

IPCC plot

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

test2

$\endgroup$

1 Answer 1

7
$\begingroup$

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

Mathematica graphics


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).

$\endgroup$
4
  • $\begingroup$ thanks, I like the colouring! Although I get an error in the reference= ... operation. something with 'Thread' and unequal length. $\endgroup$
    – gogoolplex
    Jun 30, 2014 at 7:42
  • $\begingroup$ @gogoolplex Are you on version 9? If so take [[1 ;;]] (or just remove it) instead of [[2 ;;]] :) $\endgroup$
    – Öskå
    Jun 30, 2014 at 9:10
  • $\begingroup$ Yes am on version 9, and now it works! $\endgroup$
    – gogoolplex
    Jun 30, 2014 at 10:02
  • $\begingroup$ @gogoolplex I'm glad it does :) The most important parts are, like I said, Frame/FrameStyle/ImagePadding in order to hide or not the axes and to make everything aligned. $\endgroup$
    – Öskå
    Jun 30, 2014 at 10:03

Your Answer

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

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