5
$\begingroup$

The following code extracts COVID data of Germany and gives the time series of confirmed cases, deaths and recoveries:

ResourceRemove[ResourceObject["Epidemic Data for Novel Coronavirus COVID-19"]];
covid = ResourceData["Epidemic Data for Novel Coronavirus COVID-19", "WorldCountries"];
casesGer =covid[Select[MatchQ[Entity["Country", "Germany"], #Country] &]][All, {#ConfirmedCases, #RecoveredCases, #Deaths} &][Total];
DateListLogPlot[casesGer, PlotTheme -> "Detailed"]

I wanted to apply the above code for the following sub-regions:

cAsia = {"Kazakhstan", "Kyrgyzstan", "Tajikistan", "Turkmenistan", 
   "Uzbekistan"};
eAsia = {"China", "Japan", "Mongolia", "NorthKorea", "SouthKorea"};
seAsia = {"Brunei", "Cambodia", "Indonesia", "Laos", "Malaysia", 
   "Myanmar", "Philippines", "Singapore", "Thailand", "EastTimor", 
   "Vietnam"};
sAsia = {"Afghanistan", "Bangladesh", "Bhutan", "India", "Iran", 
   "Maldives", "Nepal", "Pakistan", "SriLanka"};
wAsia = {"Armenia", "Azerbaijan", "Bahrain", "Cyprus", "Georgia", 
   "Iraq", "Israel", "Jordan", "Kuwait", "Lebanon", "Oman", "Qatar", 
   "SaudiArabia", "Syria", "Turkey", "UnitedArabEmirates", "WestBank",
    "GazaStrip", "Yemen"};

and produce a single time-series graph of confirmed cases, deaths, recoveries for each sub-region above. Using Manipulate is preferred.

$\endgroup$
3
$\begingroup$

For this kind of presentation which data and graphic are static (doesn't change), I suggest TabView:

enter image description here

Initials:

covid = ResourceData["Epidemic Data for Novel Coronavirus COVID-19", 
   "WorldCountries"];

cAsia = {"Kazakhstan", "Kyrgyzstan", "Tajikistan", "Turkmenistan", "Uzbekistan"};
eAsia = {"China", "Japan", "Mongolia", "NorthKorea", "SouthKorea"};
seAsia = {"Brunei", "Cambodia", "Indonesia", "Laos", "Malaysia", "Myanmar", "Philippines", "Singapore", "Thailand", "EastTimor", "Vietnam"};
sAsia = {"Afghanistan", "Bangladesh", "Bhutan", "India", "Iran", "Maldives", "Nepal", "Pakistan", "SriLanka"};
wAsia = {"Armenia", "Azerbaijan", "Bahrain", "Cyprus", "Georgia", "Iraq", "Israel", "Jordan", "Kuwait", "Lebanon", "Oman", "Qatar", "SaudiArabia", "Syria", "Turkey", "UnitedArabEmirates", "WestBank", "GazaStrip", "Yemen"};

Code:

ClearAll[fn, groups, data];
fn[countries_List] := 
 With[{result = 
    Transpose@Normal@covid[
        Select[MemberQ[countries, #Country] &], {2, 4, 5, 6}][All, 
       Values]
 }, 
  Column[{GraphicsRow[
     MapIndexed[
      DateListLogPlot[#1, PerformanceGoal -> "Speed", 
        PlotLabel -> {"Confirmed Cases", "Recovered Cases", "Deaths"}[[First@#2]]] &, result[[2 ;;]]]
 ], 
    LineLegend[ColorData[97, "ColorList"], 
     Intersection[countries, First@result], LegendLayout -> "Row"], 
    Row[{Text@"Missing: ", Complement[countries, First@result]}]}]]

groups = {"cAsia", "eAsia", "seAsia", "sAsia", "wAsia"};
data = AssociationThread[groups, 
   MapAt[Entity["Country", #] &, {cAsia, eAsia, seAsia, sAsia, 
     wAsia}, {All, All}]];

TabView[fn /@ data]

Update - Population-scaled

For dividing cases by population, we could use a fixed number to divide, or use a model that reflects the real-world data. This solution uses Extrapolation of the data extracted through CountryData. It's not accurate but is better than a fixed number. You can change it by redefining the populations variable (should be an Association which connects every country as Entity to a function that gets time as input and outputs the population at that time).

1- We extract the population of all the countries that exist in the list from 2015 to 2021 (data for GazaStrip and WestBank was missing for both Covid-cases and Population):

populationsRaw = 
  Map[# -> CountryData[#, {"Population", {2015, 2021}}] &, 
   Entity["Country", #] & /@ 
    Flatten[{cAsia, eAsia, seAsia, sAsia, wAsia}]];

2- Apply Association and drop GazaStrip and WestBank, then map Interpolation:

populations = 
  Interpolation /@ 
   KeyDrop[Association@
     populationsRaw, {Entity["Country", "GazaStrip"], 
     Entity["Country", "WestBank"]}];

3- Now define a function in which will be applied to TimeSeries and give us the desired output:

dividePopulation[row_] := 
 Quiet[With[{popFn = populations[First@row]}, 
   MapAt[TimeSeriesMapThread[#2/popFn[#1] &, QuantityMagnitude@#] &, 
    row, {{2}, {3}, {4}}]], {InterpolatingFunction::dmval}]

4- The rest is the same, only map the defined function to each row:

fnPopulationScaled[countries_List] := 
 With[{result = 
    Transpose[
     dividePopulation /@ 
      Normal@covid[
         Select[MemberQ[countries, #Country] &], {2, 4, 5, 6}][All, 
        Values]]}, 
  Column[{GraphicsRow[
     MapIndexed[
      DateListLogPlot[#1, PerformanceGoal -> "Speed", 
        PlotLabel -> {"Confirmed Cases", "Recovered Cases", 
           "Deaths"}[[First@#2]]] &, result[[2 ;;]]]], 
    LineLegend[ColorData[97, "ColorList"], 
     Intersection[countries, First@result], LegendLayout -> "Row"], 
    Row[{Text@"Missing: ", Complement[countries, First@result]}]}]]

groups = {"cAsia", "eAsia", "seAsia", "sAsia", "wAsia"};
data = AssociationThread[groups, 
   MapAt[Entity["Country", #] &, {cAsia, eAsia, seAsia, sAsia, 
     wAsia}, {All, All}]];

TabView[fnPopulationScaled /@ data]

Result:

enter image description here

Update 2 - sub-regions

The only difference with first update is replacing DateListLogPlot[TimeSeriesThread[Total, #1] ... in fnPopulationScaled with DateListLogPlot[#1 ...:

Result:

enter image description here

$\endgroup$
6
  • $\begingroup$ It is a nice presentation, and I did not know TabView (thanks for this). One more request from you: Currently, your code uses Cumulative Numbers. Actually, I just realized that Population-scaled cumulative numbers will be useful for country-comparison or region comparison. Can you scale the currently running code with country population? Thanks a lot. $\endgroup$ – Tugrul Temel Jun 1 at 14:05
  • $\begingroup$ @TugrulTemel Do you mean each category gets divided by population? $\endgroup$ – Ben Izd Jun 2 at 12:40
  • $\begingroup$ Yes, the division of each category to population will allow for the comparison of countries across categories. $\endgroup$ – Tugrul Temel Jun 2 at 14:51
  • $\begingroup$ Very very clear explanation and thanks for the answer. Excellent... $\endgroup$ – Tugrul Temel Jun 2 at 19:52
  • 1
    $\begingroup$ @TugrulTemel post updated. $\endgroup$ – Ben Izd Jun 14 at 18:24

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.