14
$\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$
6
$\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,
      Thickness@.004, 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$
  • $\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 '14 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 '14 at 9:10
  • $\begingroup$ Yes am on version 9, and now it works! $\endgroup$ – gogoolplex Jun 30 '14 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 '14 at 10:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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