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.

Improve this question
$\endgroup$
5
  • 1
    $\begingroup$ Select[FreeQ[_Missing]]@ds? $\endgroup$ Commented Jun 17, 2021 at 0:00
  • 1
    $\begingroup$ .. or DeleteMissing[ds, 1, Infinity]? $\endgroup$ Commented 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$ Commented 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$ Commented 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$ Commented Jun 17, 2021 at 1:39

1 Answer 1

Reset to default
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

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.