7
$\begingroup$

The following code (thanks to @Jagra):

ClearAll["Global`*"];
data = {{1, 2, 3, -4, -5, -6, 3}};
ndata = DecimalForm[(data[[1]]/Total@Abs[data[[1]]])*100 // N, 2];

Column[{
  TextCell["GDP Per Capital", "Section", FontColor -> White],
  TextCell["This is a scenario parameter set", FontSize -> 12, 
   FontColor -> White], "",
  TextCell["WorldGDP in 2020", FontWeight -> Bold, FontSize -> 20],
  TextCell["parameter domain:{1,2,3}", FontWeight -> Bold, 
   FontSize -> 12], "",
  TextCell["% Difference from baseline and contributions in % pts", 
   "TI"],
  BarChart[
   data,
   PlotTheme -> "Business",
   BarOrigin -> Left,
   BarSpacing -> Medium,
   ChartLabels -> {{None}, {"Asia", "South Asia", "South East Asia", 
      "East Asia", "Oceania", "Central Asia", "North Asia"}},
   ChartLegends -> {{ndata}, {None}},
   ChartStyle -> {Red, None},
   ImageSize -> 500
   ]
  },
 Alignment -> Center,
 Background -> {Automatic, {1 -> Darker[Red], 2 -> Darker[Red]}}
 ]

generates:

enter image description here

As seen, ChartLegends is not placed properly. I want to create a bar chart as shown in the following example:

enter image description here

where ndata should be inside green circles as shown below, with a title of "% total tax shares". Furthermore, the X-axis line should be removed from the bar chart.

$\endgroup$

3 Answers 3

8
$\begingroup$
data = {{1, 2, 3, -4, -5, -6, 3}};

normalized =  Round[N @ Normalize[data[[1]], Total@*Abs], .001];

labels = {"Asia", "South Asia", "South East Asia", "East Asia", 
      "Oceania", "Central Asia", "North Asia"};

colors = {RGBColor[0.4, 0, 0.2], RGBColor[0.4, 0.7, 1], RGBColor[0.5, 0.7, 0.1]};

cF = If[Positive @ #, colors[[1]], colors[[2]]] &;

Construct custom ticks with desired glyphs as labels:

rightframeticks = MapIndexed[{First @ #2, #} &, 
   Graphics[{Last @ colors, Disk[], 
       Text[Style[PercentForm @ #, White, FontSize -> 10]]}, 
     ImageSize -> 40] & /@ normalized];

Specify Frame and FrameTicks options in BarChart using rightframeticks to override option values set by plot themes:

BarChart[data[[1]], 
    PlotTheme -> "Business", 
    Frame -> {{True, True}, {True, False}}, 
    FrameTicks -> {{Automatic, rightframeticks}, {Automatic, Automatic}},
    BarOrigin -> Left, 
    ImageSize -> 700, 
    BarSpacing -> Medium,
    ColorFunction -> cF, 
    ColorFunctionScaling -> False, 
    ChartLabels -> {{None}, labels}]  

enter image description here

$\endgroup$
2
  • $\begingroup$ Is PercentForm a new function? Version 11.3 does not recognize it. With what can I substitute it? Thank you very much for the figure. $\endgroup$ May 28, 2021 at 21:39
  • 1
    $\begingroup$ @TugrulTemel, PercentForm is introduced in v 12.0. In v 11.3 you can replace it with Quantity[# 100. , "Percent"]. $\endgroup$
    – kglr
    May 28, 2021 at 21:50
4
$\begingroup$

Another option is to display the % on the bar

ndata = (data[[1]]/Total@Abs[data[[1]]])*100 // Reverse // N
lFun = Placed[Quantity[Round[ndata[[Last@#2]], 0.1], "Percent"], Center] &;


Column[{TextCell["GDP Per Capital", "Section", FontColor -> White], 
  TextCell["This is a scenario parameter set", FontSize -> 12, FontColor -> White], "", 
  TextCell["WorldGDP in 2020", FontWeight -> Bold, FontSize -> 20], 
  TextCell["parameter domain:{1,2,3}", FontWeight -> Bold, FontSize -> 12], "", 
  TextCell["% Difference from baseline and contributions in % pts", "TI"],
  BarChart[data,
   PlotTheme -> "Business",
   BarOrigin -> Left,
   BarSpacing -> Medium,
   ChartLabels -> {{"Asia", "South Asia", "South East Asia", 
      "East Asia", "Oceania", "Central Asia", "North Asia"}}, 
   ChartStyle -> {Red, None},
   ImageSize -> 500, LabelingFunction -> lFun]},
 Alignment -> Center,
 Background -> {Automatic, {1 -> Darker[Red], 2 -> Darker[Red]}}]

enter image description here

$\endgroup$
2
  • $\begingroup$ @Rahit Namjoshi: It is a good option, and maybe better than what I thought previously. Is there a way to also show the percentages as a separate column in green circles? Somehow green circles look more appealing to me. Thanks. $\endgroup$ May 28, 2021 at 20:07
  • $\begingroup$ Do you know why there is a very thin white stripe at the very, very top unless you e.g. , CellFrame -> False? $\endgroup$
    – Alan
    May 28, 2021 at 20:56
3
$\begingroup$

This gets you part of the way...

data = {1, 2, 3, -4, -5, -6, 3};
ndata = PercentForm[#*1.0, 2] & /@ (data / Total@Abs[data]);
labels = {"Asia", "South Asia", "South East Asia", "East Asia","Oceania", "Central Asia", "North Asia"};    

Column[{
  TextCell["GDP Per Capital", "Section", FontColor -> White],
  TextCell["This is a scenario parameter set", FontSize -> 12, 
   FontColor -> White], "", 
  TextCell["WorldGDP in 2020", FontWeight -> Bold, FontSize -> 20],
  TextCell["parameter domain:{1,2,3}", FontWeight -> Bold, 
   FontSize -> 12], "", 
  TextCell["% Difference from baseline and contributions in % pts", 
   "TI"],
  Row[{
    BarChart[
     data,
     PlotTheme -> "Business",
     BarOrigin -> Left,
     BarSpacing -> Medium,
     ChartLabels -> labels,
     ChartLegends -> None,
     ChartStyle -> Red,
     ImageSize -> 500],
    Column[ndata, Spacings -> 1.9, Alignment -> Right]
    }]
  },
 Alignment -> Center,
 Background -> {Automatic, {1 -> Darker[Red], 2 -> Darker[Red]}}]

enter image description here

$\endgroup$
3
  • $\begingroup$ Do you know why that little white stripe at the top shows up unless you e.g. , CellFrame -> False? $\endgroup$
    – Alan
    May 28, 2021 at 18:46
  • $\begingroup$ @Alan -- I don't see it in my output. $\endgroup$
    – Jagra
    May 28, 2021 at 18:57
  • $\begingroup$ Look closely at your posted image, right above the main title, almost to the border. $\endgroup$
    – Alan
    May 28, 2021 at 18:59

Your Answer

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

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