1
$\begingroup$

I want to construct a bar char for the following data, but I am having a problem with Missing[]:

countries = {"Afghanistan", "Bangladesh", "Bhutan", "India", 
   "Maldives", "Nepal", "Pakistan", "Sri Lanka", "Brunei Darussalam", 
   "Cambodia", "Indonesia", "Laos", "Malaysia", "Myanmar", 
   "Philippines", "Singapore", "Thailand", "Timor-Leste", "Vietnam", 
   "China", "Japan", "Mongolia", "North Korea", "South Korea", 
   "American Samoa", "Fiji", "French Polynesia", "Guam", 
   "Hong Kong SAR, China", "Kiribati", "Marshall Islands", 
   "Micronesia", "Nauru", "New Caledonia", "Northern Mariana Islands",
    "Palau", "Papua New Guinea", "Samoa", "Solomon Islands", "Tonga", 
   "Tuvalu", "Vanuatu", "Australia", "New Zealand"};
sAsia = {"Afghanistan", "Bangladesh", "Bhutan", "India", "Maldives", 
   "Nepal", "Pakistan", "Sri Lanka"};
seAsia = {"Brunei Darussalam", "Cambodia", "Indonesia", "Laos", 
   "Malaysia", "Myanmar", "Philippines", "Singapore", "Thailand", 
   "Timor-Leste", "Vietnam"};
eAsia = {"China", "Japan", "Mongolia", "North Korea", "South Korea"};
SIDS = {"American Samoa", "Fiji", "French Polynesia", "Guam", 
   "Hong Kong SAR, China", "Kiribati", "Marshall Islands", 
   "Micronesia", "Nauru", "New Caledonia", "Northern Mariana Islands",
    "Palau", "Papua New Guinea", "Samoa", "Solomon Islands", "Tonga", 
   "Tuvalu", "Vanuatu"};
Pacific = {"Australia", "New Zealand"};

data19 = {2.55, 8.05, 4.05, 5.25, 7.55, 7.15, 3.7, 2.8, 2, 7.25, 5.1, 
  5.5, 4.55, 6.6, 6.15, 2.4, 3.25, 0.35, 7.05, 6.25, 0.45, 6.2, 
  Missing[], 2.45, Missing[], 1.7, Missing[], Missing[], 0.8, 3.85, 
  4.8, 0.7, 3.35, Missing[], Missing[], 2, 2.8, 0.75, 2.55, 0.5, 4.6,
  3.1, 2.35, 2.9};
data20 = {-5, 3.8, -0.8, -8, -32.2, -1.9, -0.4, -3.6, 
  1.2, -3.5, -2.1, -0.4, -5.6, 3.2, -9.5, -5.4, -6.1, -6.8, 2.9, 
  2.3, -4.8, -5.3, Missing[], -1, Missing[], -19, Missing[], 
  Missing[], -6.1, -0.5, -3.3, -1.6, 0.7, Missing[], 
  Missing[], -10.3, -3.9, -3.2, -4.3, -0.5, 0.5, -9.2, -2.4, -3};
data = {data19, data20};
names = {"2019", "2020"};
ds = Dataset@Map[AssociationThread[names, #] &]@Transpose[data]

I like to use the database ds in constructing special charts in: https://mathematica.stackexchange.com/a/249707/60365

Initially, I gave the data as a list of lists and I had no problem. But now because of the Missing[] observations in my data, I realized that using the database ds is more advantagous but then I am stuck with how touse ds in the code given in the above link.

$\endgroup$
5
  • 1
    $\begingroup$ Select[FreeQ[_Missing]]@ds? $\endgroup$
    – kglr
    Jun 17, 2021 at 0:00
  • 1
    $\begingroup$ .. or DeleteMissing[ds, 1, Infinity]? $\endgroup$
    – kglr
    Jun 17, 2021 at 0:03
  • $\begingroup$ @kglr: Your suggestion above works fine. But I wanted to use the new list of data (without Missing[]) in the chart by replacing data with DeleteMissing[ds, 1, Infinity]. When I do this, the predefined groups preProcess[{8, 11, 5, 18, 2}] may pose problems. I wanted to have no arrow bar (empty space) for the missing countries but keep the country names on the X-axis. This way I can control the countries with missing values. $\endgroup$ Jun 17, 2021 at 0:42
  • $\begingroup$ @kglr: Sorry, the title of the question is misleading. I wanted to delete the missing observations and then use the resulting database in a bar chart. $\endgroup$ Jun 17, 2021 at 0:52
  • $\begingroup$ There is no need to delete missing observations if we use a slightly modified version of arrowBar. $\endgroup$
    – kglr
    Jun 17, 2021 at 1:39

1 Answer 1

4
$\begingroup$

We can slightly modify the function arrowBar from the linked answer so that it returns {} for inputs with Missing elements.

ClearAll[arrowBarB]
arrowBarB[arrowwidth_: .5, boxwidth_: 1, arrowangle_: 120][
   colors_: ColorData[97, "ColorList"], dr_: 5] := 
  If[FreeQ[#3, _Missing], {colors[[#]], Opacity[.7], 
     ChartElementData["ArrowRectangle", {"ArrowheadAngle" -> arrowangle, 
        "ArrowWidth" -> arrowwidth}][{{-boxwidth, boxwidth}/2 + #2, #3}], 
     Opacity[1], EdgeForm[Gray], Disk[{#2, #3[[1]]}, Offset[dr]]}, {}] &;

We use preProcess and options from the linked answer as is and change the labels in legend:

ClearAll[preProcess]
preProcess[groupsizes_List, groupspacing_: 1] := 
  Join[Join @@ MapIndexed[
      Thread @ {#2[[1]], (#2[[1]] - 1) groupspacing + # - 1} &, 
      TakeList[Range[Length @ #], groupsizes]], List /@ #, 2] &;

options = Join[{ImageSize -> Large, Axes -> {True, False}, 
    AxesStyle -> Dashed, AspectRatio -> 1/2}, 
   FilterRules[Charting`ResolvePlotTheme["Business", Plot], Options[Graphics]]];

legend = Graphics[{arrowBarB[][{Gray}][1, -1/4, {1, -1}/2] /. 
     EdgeForm[_] -> EdgeForm[White],
    GrayLevel[.2], 
    Text[Style["2019", FontSize -> 11], Offset[{5, 0}, {1/8, 1/2}],  Left], 
    Text[Style["2020", FontSize -> 11], Offset[{5, 5}, {1/8, -1/2}], Left]}, 
    ImageSize -> 1 -> 40];

data3 = Normal @ Values[ds];

dt = preProcess[{8, 11, 5, 18, 2}, 3][data3];

groupnames = {"sAsia", "seAsia", "eAsia", "SIDS", "Pacific"};

groupcolors = ColorData[97] /@ Range[Length @ groupnames];

We color country labels red for countries with missing data:

missingpositions = Position[data3, _?(MatchQ[{_, _Missing} | {_Missing, _}])];

xticks = Thread[{dt[[All, 2]], Rotate[#, 90 Degree] & /@ 
     MapAt[Style[#, Red] &, countries, missingpositions]}];

We also add gridlines for each country to distinguish gaps due to missing elements from between-group gaps:

Legended[Graphics[arrowBarB[.1, .8, 120][groupcolors, 3] @@@ dt, 
  FrameTicks -> {{Automatic, Automatic}, {xticks,  Automatic}}, 
  ImageSize -> 800, 
  LabelStyle -> Medium,
  GridLines -> {dt[[All, 2]], Automatic}, 
  options], 
 Column[{SwatchLegend[groupcolors, groupnames], legend}]]

enter image description here

$\endgroup$

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.