1
$\begingroup$

I have Dataset;

jexample = {<|"country" -> "Bhutan", "subregion" -> "South Asia", 
"status" -> "LDC", "indicator" -> "GDP", "time" -> 2011.`, 
"data" -> 5.`|>, <|"country" -> "Bhutan", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2015.`, 
"data" -> 7.`|>, <|"country" -> "Bhutan", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2011.`, 
"data" -> 11.`|>, <|"country" -> "Bhutan", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2015.`, 
"data" -> 7.`|>, <|"country" -> "Angola", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2011.`, 
"data" -> 3.`|>, <|"country" -> "Angola", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2015.`, 
"data" -> 7.`|>, <|"country" -> "Angola", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2011.`, 
"data" -> 10.`|>, <|"country" -> "Angola", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2015.`, 
"data" -> 5.`|>, <|"country" -> "Bangladesh", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2011.`, 
"data" -> 2.`|>, <|"country" -> "Bangladesh", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2015.`, 
"data" -> 6.`|>, <|"country" -> "Bangladesh", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2011.`, 
"data" -> 7.`|>, <|"country" -> "Bangladesh", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2015.`, 
"data" -> 9.`|>, <|"country" -> "Cambodia", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2011.`, 
"data" -> 6.`|>, <|"country" -> "Cambodia", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2015.`, 
"data" -> 3.`|>, <|"country" -> "Cambodia", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2011.`, 
"data" -> 5.`|>, <|"country" -> "Cambodia", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2015.`, 
"data" -> 6.`|>, <|"country" -> "Nepal", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2011.`, 
"data" -> 7.`|>, <|"country" -> "Nepal", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "GDP", "time" -> 2015.`, 
"data" -> 9.`|>, <|"country" -> "Nepal", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2011.`, 
"data" -> 8.`|>, <|"country" -> "Nepal", 
"subregion" -> "South Asia", "status" -> "LDC", 
"indicator" -> "EVI", "time" -> 2015.`, 
"data" -> 5.`|>, <|"country" -> "S. Islands", 
"subregion" -> "SIDS", "status" -> "LDC", "indicator" -> "GDP", 
"time" -> 2011.`, "data" -> 3.`|>, <|"country" -> "S. Islands", 
"subregion" -> "SIDS", "status" -> "LDC", "indicator" -> "GDP", 
"time" -> 2015.`, "data" -> 9.`|>, <|"country" -> "S. Islands", 
"subregion" -> "SIDS", "status" -> "LDC", "indicator" -> "EVI", 
"time" -> 2011.`, "data" -> 4.`|>, <|"country" -> "S. Islands", 
"subregion" -> "SIDS", "status" -> "LDC", "indicator" -> "EVI", 
"time" -> 2015.`, "data" -> 7.`|>, <|"country" -> "Kiribati", 
"subregion" -> "SIDS", "status" -> "LDC", "indicator" -> "GDP", 
"time" -> 2011.`, "data" -> 4.`|>, <|"country" -> "Kiribati", 
"subregion" -> "SIDS", "status" -> "LDC", "indicator" -> "GDP", 
"time" -> 2015.`, "data" -> 5.`|>, <|"country" -> "Kiribati", 
"subregion" -> "SIDS", "status" -> "LDC", "indicator" -> "EVI", 
"time" -> 2011.`, "data" -> 8.`|>, <|"country" -> "Kiribati", 
"subregion" -> "SIDS", "status" -> "LDC", "indicator" -> "EVI", 
"time" -> 2015.`, "data" -> 1.`|>, <|"country" -> "Vanuatu", 
"subregion" -> "SIDS", "status" -> "ODC", "indicator" -> "GDP", 
"time" -> 2011.`, "data" -> 6.`|>, <|"country" -> "Vanuatu", 
"subregion" -> "SIDS", "status" -> "ODC", "indicator" -> "GDP", 
"time" -> 2015.`, "data" -> 6.`|>, <|"country" -> "Vanuatu", 
"subregion" -> "SIDS", "status" -> "ODC", "indicator" -> "EVI", 
"time" -> 2011.`, "data" -> 3.`|>, <|"country" -> "Vanuatu", 
"subregion" -> "SIDS", "status" -> "ODC", "indicator" -> "EVI", 
"time" -> 2015.`, "data" -> 3.`|>};

(* Restructure "jexample" to create a new dataset "ds" *)

  (*By @kglr*)
  ClearAll[reOrg, ds, indicatorList, dsgrouped];
  reOrg = Query[GroupBy[{#"time", #"country"} &] /* Values /* KeyUnion, 
  Apply[Join], <|KeyDrop[{"indicator", "data"}]@#, #indicator -> #data|> &]; 
  ds = reOrg@jexample;
  indicatorList = Normal[Query[First /* Keys]@ds][[5 ;;]];
  dsgrouped =ds[GroupBy[#country &], GroupBy[#time &], All, indicatorList];

 ClearAll[barChart, bcQ];
 barChart[opts : OptionsPattern[]] := 
 BarChart[#, opts, ChartLegends -> Automatic, 
 ChartLabels -> Automatic] &;
 bcQ[opts : OptionsPattern[]][var_String, countryslices_: All, 
  timeslices_: All, f_: Identity] := 
  Query[(countryslices /. {All -> Identity, 
  x_List :> KeyTake[x]}) /* (barChart[opts, PlotLabel -> var][
  f[#]] &), timeslices /. x_List :> KeyTake[x], 
  First@*First@*Values@*KeyTake[var]]
 bcQ[opts : OptionsPattern[]][var_List, rest___] := 
 Row[Append[#[[All, 1]], #[[1, -1, 1, 1]]] &@
 Through[(bcQ[opts][#, rest] & /@ var)@#], Spacer[10]] &

ClearAll[timeList, countryList];
timeList = Normal[Query[First /* Keys]@dsgrouped];
countryList = Normal@Keys@dsgrouped;

Manipulate[
 bcQ[
    ImageSize -> 350,
    Joined -> ({Mean@#[[1]], Max@#[[2]]} &),
    ChartStyle -> "Rainbow",
    PlotTheme -> "Business",
    AspectRatio -> 1/2.75
    ][Sort@vars, countries, times, gorder]@dsgrouped,
 {{vars, indicatorList[[{1}]], "measures"}, indicatorList, TogglerBar},
 {{countries, countryList[[{1}]], "countries"}, countryList, 
  TogglerBar},
 {{times, timeList, "times"}, timeList, TogglerBar},
 {{gorder, Identity, 
   "grouping order"}, {Identity -> 
    Column[{"country", "time"}, Alignment -> Center], 
   Transpose -> Column[{"time", "country"}, Alignment -> Center]}}
 ]

enter image description here

My purpose is to calculate Mean value of GDP across countries for the initial year 2011, associated with purple bars across countries, and draw a line on the bar chart. Similarly, I also want to draw a line at the mean value of the final year 2015, associated with the red bars, across the countries. To accomplish this task, I revised the above Manipulate as follows:

Manipulate[
aveInitial=Max[Normal@Mean[ds[GroupBy["country"], GroupBy["time"], All,vars][All,First]]];
aveFinal=Max[Normal@Mean[ds[GroupBy["country"], GroupBy["time"], All,vars][All,Last]]];
aveI = Max[ds[GroupBy["country"], GroupBy["time"], All, vars][All, First]];
aveF = Max[ds[GroupBy["country"], GroupBy["time"], All, vars][All, Last]];
bcQ[
ImageSize -> 350,
Joined -> ({Mean@#[[1]], Max@#[[2]]} &),
ChartStyle -> "Rainbow",
PlotTheme -> "Business",
AspectRatio -> 1/2.75,
Epilog -> {
  {Dashed, Red, 
   Tooltip[Line[{{0, aveInitial}, {0, Max[aveI] + 0.55}}], aveInitial], 
   Text["Average", {-1, aveInitial}, {-3, -1}]}, {Dashed, Blue, 
   Tooltip[Line[{{0, aveFinal}, {0, Max[aveF] + 0.55}}], 
    aveFinal], Text["Average", {-1, aveFinal}, {-3, -2}]}
  }
][Sort@vars, countries, times, gorder]@dsgrouped,
{{vars, indicatorList[[{1}]], "measures"}, indicatorList, TogglerBar},
{{countries, countryList[[{1}]], "countries"}, countryList,TogglerBar},
{{times, timeList, "times"}, timeList, TogglerBar},
{{gorder, Identity, "grouping order"}, {Identity -> 
Column[{"country", "time"}, Alignment -> Center], 
Transpose -> Column[{"time", "country"}, Alignment -> Center]}}
]

In the correctly formatted code, I should have two horizontal lines: one for the mean value of the 2011 average across countries and another for the 2015 average across countries. These averages would allow me to compare the average change over time across countries. Of course, when I switch to time/country dialogue box, then the two mean values should be calculated for the initial year over the list of countries, as well as over the final year across the list of countries.

However, there is an error in Epilog->... and I cannot find out what it is.

Improve this question
$\endgroup$

1 Answer 1

Reset to default
2
$\begingroup$

We modify bcQ (to prevent errors produced by the original bcQ for some input combinations) and wrap it with a function that processes rectangles produced by bcQ and add lines for means (over selected countries) for each date:

ClearAll[barChart, bcQ, rectAssoc, addMeanLines]
rectAssoc[f_] := Association[Join @@
    (Thread[#[[All, -1]] -> Mean@#[[All, -1, 2, -1]]] & /@ 
       Transpose[f@Cases[#, {{__, _Rectangle} ..}, All]])] &;

addMeanLines[f_] := DeleteCases[#, Line[{x_, x_}], All] & @*
   ReplaceAll[g_Graphics :> 
     Module[{y = rectAssoc[f][g]}, g /. {d___, r : Rectangle[a_, b_, c___]} :> 
       {d, FaceForm[Opacity[.6]], r, 
        CapForm["Butt"], Opacity[1], Darker@Darker@Cases[{d}, _?ColorQ, All], 
         AbsoluteThickness[2], Dashed, Line[Thread[{{a[[1]], b[[1]]}, y@r}]]}]];

barChart[opts : OptionsPattern[]] := BarChart[#, opts, 
    ChartLegends -> Automatic, ChartLabels -> Automatic] &;

bcQ[opts : OptionsPattern[]][var : (_String | {_String}), 
  countryslices_: All, timeslices_: All, f_: Identity] := 
 Query[(countryslices /. {All -> Identity, x_List :> KeyTake[x]}) /* 
   KeySort /* (barChart[opts, PlotLabel -> (var /. {x_} :> x)][f @ #] &), 
  timeslices /. x_List :> KeyTake[x], 
  First@*First@*Values@*KeyTake[var]]

bcQ[opts : OptionsPattern[]][var : {_String, __String}, rest___] := 
 Multicolumn[Append[Cases[#, _Graphics, All], FirstCase[#, _SwatchLegend, "", All]] &@
    Through[(bcQ[opts][#, rest] & /@ var)@#], 3, Appearance -> "Horizontal"] &

ClearAll[timeList, countryList];
timeList = Sort @ Normal[Query[First /* Keys] @ dsgrouped];
countryList = Sort @ Normal @ Keys @ dsgrouped;

Add TrackingFunctions to controls to avoid empty input data sets:

Manipulate[addMeanLines[gorder] @
  bcQ[ImageSize -> 350, Joined -> ({Mean@#[[1]], Max@#[[2]]} &), 
     ChartStyle -> "Rainbow", PlotTheme -> "Business", 
     AspectRatio -> 1/2.75, ImageSize -> Large][Sort@vars, countries, 
    times, gorder]@dsgrouped, 
 {{vars, indicatorList[[{1}]], "measures"}, indicatorList, TogglerBar, 
  TrackingFunction -> (vars = If[# === {}, indicatorList[[{1}]], Sort@#]; &)}, 
 {{countries, countryList[[{1}]], "countries"}, countryList, TogglerBar, 
  TrackingFunction -> (countries = If[# === {}, countryList[[{1}]], #]; 
     If[Length@# == 1, gorder = Identity]; &)}, 
 {{times, timeList, "times"}, timeList, TogglerBar, 
  TrackingFunction -> (times = If[# === {}, timeList[[{1}]], Sort@#]; 
     If[Length@# == 1, gorder = Transpose]; &)}, 
 {{gorder, Identity, "grouping order"}, 
   {Identity -> Column[{"country", "time"}, Alignment -> Center], 
   Transpose -> Column[{"time", "country"}, Alignment -> Center]}}]

enter image description here

enter image description here

enter image description here

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Everything works nicely for a dataset with no missing observation. However, when there is a missing observation for a given country, the average value line is not shown for the entire group of countries in the given year. For example, in your first Barchart above, if Kiribati has a missing observation in 2011 for the measure EVI, then the code does not give an average line for the group of three countries in 2011 and turns the bar chart color to RED. For me, it would be sufficient to have the current bar charts if I can avoid the RED color. Thank you very much. $\endgroup$
    – Tugrul Temel
    Commented Nov 23, 2021 at 20:28

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.