Zadanie

Zadanie

Zaliczenie wysyłać na adres mariusz.bodzioch@matman.uwm.edu.pl

Przygotowanie

library(kableExtra)
library(scales)
library(lubridate)
library(ggrepel)
library(readr)
library(tidyverse)

kable1 = function(data, digits=3) data %>% kable(digits = digits) %>% 
  kable_styling(bootstrap_options = 
                  c("striped", "hover", "condensed", "responsive"))

kable2 = function(data, digits=3, height="320px") data %>% 
  kable1(digits = digits) %>% 
  scroll_box(width = "100%", height = height)

1

Wczytać dane owid_covid_data.csv i zapisać je w ramce owid_covid_data, zapoznać się z opisem zmiennych, strukturą danych, zawartością zbioru,

owid_covid_data <- read_csv("owid_covid_data.csv", show_col_types = FALSE)

2

Wczytać dane excess_mortality.csv i zapisać je w ramce excess_mortality, zapoznać się z opisem zmiennych, strukturą danych, zawartością zbioru,

excess_mortality <- read_csv("excess_mortality.csv", show_col_types = FALSE)

3

Utworzyć ramkę continents zawierającą nazwy wszystkich kontynentów występujących w ramce owid_covid_data w kolumnie continent (każda nazwa ma występować w ramce tylko raz), Wskazówka: wykorzystać funkcję unique()

continents = owid_covid_data %>% filter(!is.na(continent)) %>% distinct(continent) 

4

Utworzyć ramkę locations zawierającą nazwy wszystkich krajów występujących w ramce owid_covid_data w kolumnie location (każda nazwa ma występować w ramce tylko raz), Uwaga: w kolumnie location znajdują się również nazwy kontynentów (i nie tylko)

locations = owid_covid_data %>% filter(!is.na(continent)) %>% distinct(location)

5

Utworzyć ramkę eu zawierającą nazwy krajów europejskich (każda nazwa ma występować w ramce tylko raz),

eu = owid_covid_data %>% filter(continent == "Europe") %>% distinct(location)

6

Na podstawie owid_covid_data, utworzyć ramkę owid_covid_data_eu zawierającą dane tylko dla krajów europejskich (wykorzystać ramkę eu), Wskazówka: można wykorzystać operator %in%

owid_covid_data_eu = owid_covid_data %>% filter(location %in% eu$location)

7

Na podstawie excess_mortality, utworzyć ramkę excess_mortality_eu zawierającą dane tylko dla krajów europejskich,

excess_mortality_eu = excess_mortality %>% filter(location %in% eu$location)

8

Z ramki eu wykluczyć Polskę i wylosować trzy kraje (ustalić ziarno), zapisać je w zmiennej selected_locations_eu, Wskazówka: do losowania użyć funkcji sample_n() z pakietu dplyr, a do ustalenia ziarna - set.seed()

set.seed(20)
selected_locations_eu = eu %>% filter(location != 'Poland') %>% slice_sample(n=3) 

9

Wylosować datę z zakresu 01.10 - 31.12.2021r., zapisać ją do zmiennej selected_date.

selected_date = seq(dmy('01.10.2021'), dmy('31.12.2021'), by=1) %>% sample(1)

Analiza dla świata

Na podstawie owid_covid_data, wykonać (wszystkie dane w przeliczeniu na milion mieszkańców):

1

Na dzień selected_date

• podsumowanie łącznej liczby przypadków, dziennych przypadków, łącznej liczby zgonów, dziennej liczby zgonów - dla każdego kontynentu,

continent_select_date = owid_covid_data %>% 
  filter(date == selected_date & location %in% continents$continent) %>% 
  select(location, total_cases, new_cases, total_deaths, new_deaths) 
continent_select_date %>% kable1()

location	total_cases	new_cases	total_deaths	new_deaths
Africa	8496820	4911	217987	167
Asia	79398436	107716	1172953	1481
Europe	64847982	253374	1300144	3400
North America	55277387	106484	1123063	2196
Oceania	313863	2159	3699	37
South America	38348177	21478	1169884	520

• dokonać wizualizacji danych z użyciem polecenia facet_grid(), Wskazówka: zamienić ramkę na format długi

continent_select_date %>% 
  pivot_longer(-location) %>% 
  ggplot(aes(location, value))+
  geom_col()+
  facet_grid(vars(name), scales="free")+
  labs(
    title = "Łączna i dzienne ilość zachorowań oraz łączna i dzienna ilość zgonów",
    subtitle = paste("Dane na dzień ", selected_date),
    caption = "M.F.",
    x = "Kontynent",
    y = "Wartość")

• wykonać wykres punktowy zależności łącznej liczby przypadków od łącznej liczby zgonów (jeden wykres dla wszystkich krajów),

• zaznaczyć etykietami kraj o największym współczynniku liczby przypadków oraz o największym współczynniku zgonów (etykiety mają zawierać nazwy krajów),

country_select_date = owid_covid_data %>% 
  filter(date == selected_date & location %in% locations$location) 

max_total_cases_per_million = country_select_date %>% 
  filter(total_cases_per_million == max(total_cases_per_million, na.rm = T))
max_total_deaths_per_million = country_select_date %>% 
  filter(total_deaths_per_million == max(total_deaths_per_million, na.rm = T))

max_continent_total_cases_per_million = country_select_date %>% 
  group_by(continent) %>% 
  filter(total_cases_per_million == max(total_cases_per_million, na.rm = T))
max_continent_total_deaths_per_million = country_select_date %>% 
  group_by(continent) %>% 
  filter(total_deaths_per_million == max(total_deaths_per_million, na.rm = T))

country_select_date %>% 
  ggplot(aes(total_deaths, total_cases, label=location))+
  geom_point()+
  geom_label_repel(data=max_total_cases_per_million, color = "red", 
                   nudge_x = -.5, nudge_y = .5)+
  geom_label_repel(data=max_total_deaths_per_million, color = "blue", 
                   nudge_x = .2, nudge_y = -.2)+
  geom_point(data=max_total_cases_per_million, shape=21,  color = "red", size=3)+
  geom_point(data=max_total_deaths_per_million, shape=21,  color = "blue", size=3)+
  scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  annotation_logticks()+
  labs(
    title = "Łączna ilość zachorowań w funkcji łącznej ilości zgonów we wszystkich krajach świata",
    subtitle = paste("Dane na dzień ", selected_date),
    caption = "M.F.",
    x = "Łączna ilość zgonów",
    y = "Łączna ilość zachorowań")

• wykonać dwa poprzednie punkty z podziałem na kontynenty (użyć funkcji facet_wrap());

country_select_date %>% 
  ggplot(aes(total_deaths, total_cases, label=location))+
  geom_label_repel(data=max_continent_total_cases_per_million, color = "red", 
                   nudge_x = -.7, nudge_y = .7)+
  geom_label_repel(data=max_continent_total_deaths_per_million, color = "blue", 
                   nudge_x = .7, nudge_y = -.7)+
  geom_point(data=max_continent_total_cases_per_million, shape=21,  color = "red", size=3)+
  geom_point(data=max_continent_total_deaths_per_million, shape=21,  color = "blue", size=3)+
  geom_point()+
  scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  annotation_logticks()+
  facet_wrap(vars(continent))+
  labs(
    title = "Łączna ilość zachorowań w funkcji łącznej ilości zgonów we wszystkich krajach świata",
    subtitle = paste("Dane na dzień ", selected_date),
    caption = "M.F.",
    x = "Łączna ilość zgonów [log10]",
    y = "Łączna ilość zachorowań [log10]")

2

Obliczyć średnią liczbę wykonanych dziennie szczepień w każdym kraju w okresie od 01.05.2021r. do 31.12.2021r., podsumowanie zaprezentować na wykresie pudełkowym z podziałem na kontynenty.

mean_vaccinations = owid_covid_data %>% 
  filter(date >= dmy('01.05.2021') & 
           date <= dmy('31.12.2021') & 
           location %in% locations$location) %>% 
  group_by(continent, location) %>% 
  summarise(mean_new_vaccinations = mean(new_vaccinations_smoothed, na.rm=T),
            .groups = "keep") %>% 
  filter(!is.nan(mean_new_vaccinations))

mean_vaccinations %>% kable2()

continent	location	mean_new_vaccinations
Africa	Algeria	45427.808
Africa	Angola	44852.461
Africa	Benin	7633.142
Africa	Botswana	4940.898
Africa	Burkina Faso	5284.467
Africa	Burundi	108.082
Africa	Cameroon	4114.820
Africa	Cape Verde	2311.461
Africa	Central African Republic	2254.137
Africa	Chad	1579.147
Africa	Comoros	2251.690
Africa	Congo	2984.433
Africa	Cote d’Ivoire	27023.816
Africa	Democratic Republic of Congo	1249.122
Africa	Djibouti	485.184
Africa	Egypt	218704.763
Africa	Equatorial Guinea	1551.016
Africa	Eswatini	1489.355
Africa	Ethiopia	40194.029
Africa	Gabon	1754.661
Africa	Gambia	1116.796
Africa	Ghana	29413.204
Africa	Guinea	11077.967
Africa	Guinea-Bissau	1756.506
Africa	Kenya	36514.616
Africa	Lesotho	3270.820
Africa	Liberia	3785.545
Africa	Libya	10696.641
Africa	Madagascar	3911.099
Africa	Malawi	6055.465
Africa	Mali	4103.604
Africa	Mauritania	7671.861
Africa	Mauritius	7550.898
Africa	Morocco	168245.935
Africa	Mozambique	58307.090
Africa	Namibia	2551.331
Africa	Niger	6138.298
Africa	Nigeria	53194.004
Africa	Rwanda	49985.294
Africa	Saint Helena	97.000
Africa	Sao Tome and Principe	593.833
Africa	Senegal	6184.984
Africa	Seychelles	240.996
Africa	Sierra Leone	3462.808
Africa	Somalia	5680.339
Africa	South Africa	112477.220
Africa	South Sudan	1127.469
Africa	Sudan	13433.302
Africa	Tanzania	16332.524
Africa	Togo	8994.139
Africa	Tunisia	47486.682
Africa	Uganda	43031.971
Africa	Zambia	6677.547
Africa	Zimbabwe	27727.633
Asia	Afghanistan	17891.849
Asia	Armenia	6643.931
Asia	Azerbaijan	40077.437
Asia	Bahrain	8159.151
Asia	Bangladesh	465187.212
Asia	Bhutan	2771.118
Asia	Brunei	3533.510
Asia	Cambodia	115085.918
Asia	China	10437883.359
Asia	Georgia	9997.955
Asia	Hong Kong	34886.482
Asia	India	5238517.624
Asia	Indonesia	1023698.465
Asia	Iran	473807.131
Asia	Iraq	56493.788
Asia	Israel	25439.584
Asia	Japan	799769.294
Asia	Jordan	30180.318
Asia	Kazakhstan	65889.657
Asia	Kuwait	23908.494
Asia	Kyrgyzstan	9033.649
Asia	Laos	27967.788
Asia	Lebanon	15879.012
Asia	Macao	3556.282
Asia	Malaysia	227990.086
Asia	Maldives	1646.490
Asia	Mongolia	17648.951
Asia	Myanmar	136551.784
Asia	Nepal	88466.469
Asia	Northern Cyprus	2317.105
Asia	Oman	24019.653
Asia	Pakistan	618046.351
Asia	Palestine	12671.122
Asia	Philippines	429335.873
Asia	Qatar	15125.269
Asia	Saudi Arabia	169479.273
Asia	Singapore	36145.351
Asia	South Korea	403396.918
Asia	Sri Lanka	132568.641
Asia	Syria	9687.706
Asia	Taiwan	140880.151
Asia	Tajikistan	27812.244
Asia	Thailand	420434.898
Asia	Timor	4821.457
Asia	Turkey	441324.592
Asia	Turkmenistan	19106.000
Asia	United Arab Emirates	49562.376
Asia	Uzbekistan	155497.922
Asia	Vietnam	604830.363
Asia	Yemen	2758.864
Europe	Albania	7708.567
Europe	Andorra	369.882
Europe	Austria	54439.935
Europe	Belarus	32455.347
Europe	Belgium	72701.796
Europe	Bosnia and Herzegovina	6912.812
Europe	Bulgaria	11886.992
Europe	Croatia	15750.861
Europe	Cyprus	5290.143
Europe	Czechia	50418.731
Europe	Denmark	41266.824
Europe	Estonia	5587.567
Europe	Faeroe Islands	310.082
Europe	Finland	31500.767
Europe	France	414868.351
Europe	Germany	496330.294
Europe	Gibraltar	158.767
Europe	Greece	58193.127
Europe	Guernsey	332.290
Europe	Hungary	39204.192
Europe	Iceland	2412.420
Europe	Ireland	33216.886
Europe	Isle of Man	431.771
Europe	Italy	370988.118
Europe	Jersey	507.678
Europe	Kosovo	6700.661
Europe	Latvia	9168.155
Europe	Liechtenstein	207.959
Europe	Lithuania	12922.935
Europe	Luxembourg	3645.090
Europe	Malta	2973.922
Europe	Moldova	6658.759
Europe	Monaco	169.243
Europe	Montenegro	2322.510
Europe	Netherlands	95246.706
Europe	North Macedonia	6949.012
Europe	Norway	32933.278
Europe	Poland	145693.841
Europe	Portugal	65210.559
Europe	Romania	44010.016
Europe	Russia	514895.278
Europe	San Marino	114.453
Europe	Serbia	19924.224
Europe	Slovakia	19144.665
Europe	Slovenia	8746.204
Europe	Spain	278006.804
Europe	Sweden	58536.743
Europe	Switzerland	45094.482
Europe	Ukraine	112630.424
Europe	United Kingdom	345184.890
North America	Anguilla	51.118
North America	Antigua and Barbuda	370.751
North America	Aruba	366.200
North America	Bahamas	1132.004
North America	Barbados	918.886
North America	Belize	1571.384
North America	Bermuda	229.694
North America	Bonaire Sint Eustatius and Saba	196.000
North America	British Virgin Islands	95.420
North America	Canada	224845.584
North America	Cayman Islands	272.192
North America	Costa Rica	28288.367
North America	Cuba	134792.939
North America	Curacao	506.098
North America	Dominica	126.824
North America	Dominican Republic	49855.931
North America	El Salvador	35931.682
North America	Greenland	265.404
North America	Grenada	264.065
North America	Guatemala	45166.404
North America	Haiti	1180.857
North America	Honduras	38509.931
North America	Jamaica	4322.571
North America	Mexico	537110.780
North America	Montserrat	4.167
North America	Nicaragua	31034.563
North America	Panama	22843.780
North America	Saint Kitts and Nevis	172.869
North America	Saint Lucia	329.196
North America	Saint Vincent and the Grenadines	192.380
North America	Sint Maarten (Dutch part)	119.223
North America	Trinidad and Tobago	5537.780
North America	Turks and Caicos Islands	143.461
North America	United States	1061875.788
Oceania	Australia	164498.127
Oceania	Cook Islands	103.545
Oceania	Fiji	4905.229
Oceania	French Polynesia	1098.269
Oceania	Kiribati	472.540
Oceania	Nauru	51.922
Oceania	New Caledonia	1209.878
Oceania	New Zealand	32212.531
Oceania	Niue	17.181
Oceania	Papua New Guinea	2065.518
Oceania	Pitcairn	0.512
Oceania	Samoa	1071.257
Oceania	Solomon Islands	962.657
Oceania	Tokelau	17.398
Oceania	Tonga	524.188
Oceania	Tuvalu	40.518
Oceania	Vanuatu	746.451
Oceania	Wallis and Futuna	27.269
South America	Argentina	282647.906
South America	Bolivia	36330.376
South America	Brazil	1166325.122
South America	Chile	119642.543
South America	Colombia	243108.188
South America	Ecuador	106425.943
South America	Guyana	2392.416
South America	Paraguay	27289.792
South America	Peru	198545.869
South America	Suriname	1841.780
South America	Uruguay	21284.976
South America	Venezuela	127191.261

mean_vaccinations %>% 
  ggplot(aes(continent, mean_new_vaccinations, fill=continent))+
  geom_boxplot()+
  scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                labels = trans_format("log10", math_format(10^.x))) +
  annotation_logticks(sides = "l")+
  labs(
    title = "Średnia dzienna ilość podanych szczepionek w poszczególnych krajach",
    subtitle = "Dane z okresu pomiędzy 01.05.2021 a 31.12.2021",
    caption = "M.F.",
    x = "Kontynent",
    y = "Ilość dziennych szczepionek [log10]")

Uwaga, ze względu na duże zróżnicowanie otrzymanych statystyk pomiędzy poszczególnymi kontynentami zdecydowano się przedstawić ten wykres w skali logarytmicznej.

mean_vaccinations %>% 
  group_by(continent) %>% 
  summarise(
    min = min(mean_new_vaccinations, na.rm=T),
    q1 = quantile(mean_new_vaccinations, .25, na.rm=T),
    median = median(mean_new_vaccinations, na.rm=T),
    q3 = quantile(mean_new_vaccinations, .75, na.rm=T),
    max = max(mean_new_vaccinations, na.rm=T)
  ) %>% mutate_if(is.numeric, round, digits = 0) %>% kable1()

continent	min	q1	median	q3	max
Africa	97	2252	5868	27552	218705
Asia	1646	13285	35516	213362	10437883
Europe	114	4056	17448	57255	514895
North America	4	204	712	30348	1061876
Oceania	1	43	635	1182	164498
South America	1842	25789	113034	209686	1166325