Przygotowanie

Na początku projektu wczytałem dane oraz przygotowałem wszelkie pomocnicze tabele.

#Wczytanie danych
owid_covid_data <- read_csv("owid_covid_data.csv", show_col_types = FALSE)
excess_mortality <- read_csv("excess_mortality.csv", show_col_types = FALSE)

#Przygotowanie pomocniczych tabel
continents = owid_covid_data %>% filter(!is.na(continent)) %>% distinct(continent)
locations = owid_covid_data %>% filter(!is.na(continent)) %>% distinct(location)
eu = owid_covid_data %>% filter(continent == "Europe") %>% distinct(location)
owid_covid_data_eu = owid_covid_data %>% filter(location %in% eu$location)
excess_mortality_eu = excess_mortality %>% filter(location %in% eu$location)

set.seed(314159)
selected_locations_eu = eu %>% filter(location != "Poland") %>% slice_sample(n=3)
selected_period = seq(dmy('01.05.2021'), dmy('31.12.2021'), by=1)
selected_date = seq(dmy('01.05.2021'), dmy('31.12.2021'), by=1) %>% sample(1)
location_population = owid_covid_data %>% 
  select(location, population) %>% 
  distinct(location, population)

Utworzyłem następujące ramki pomocnicze:

  • continents zawierająca nazwy 6-ściu kontynentów,
continents %>% kable1()
continent
Asia
Europe
Africa
North America
South America
Oceania
  • locations, zawierająca 229 nazw krajów,
locations %>% kable2()
location
Afghanistan
Albania
Algeria
Andorra
Angola
Anguilla
Antigua and Barbuda
Argentina
Armenia
Aruba
Australia
Austria
Azerbaijan
Bahamas
Bahrain
Bangladesh
Barbados
Belarus
Belgium
Belize
Benin
Bermuda
Bhutan
Bolivia
Bonaire Sint Eustatius and Saba
Bosnia and Herzegovina
Botswana
Brazil
British Virgin Islands
Brunei
Bulgaria
Burkina Faso
Burundi
Cambodia
Cameroon
Canada
Cape Verde
Cayman Islands
Central African Republic
Chad
Chile
China
Colombia
Comoros
Congo
Cook Islands
Costa Rica
Cote d’Ivoire
Croatia
Cuba
Curacao
Cyprus
Czechia
Democratic Republic of Congo
Denmark
Djibouti
Dominica
Dominican Republic
Ecuador
Egypt
El Salvador
Equatorial Guinea
Eritrea
Estonia
Eswatini
Ethiopia
Faeroe Islands
Falkland Islands
Fiji
Finland
France
French Polynesia
Gabon
Gambia
Georgia
Germany
Ghana
Gibraltar
Greece
Greenland
Grenada
Guam
Guatemala
Guernsey
Guinea
Guinea-Bissau
Guyana
Haiti
Honduras
Hong Kong
Hungary
Iceland
India
Indonesia
Iran
Iraq
Ireland
Isle of Man
Israel
Italy
Jamaica
Japan
Jersey
Jordan
Kazakhstan
Kenya
Kiribati
Kosovo
Kuwait
Kyrgyzstan
Laos
Latvia
Lebanon
Lesotho
Liberia
Libya
Liechtenstein
Lithuania
Luxembourg
Macao
Madagascar
Malawi
Malaysia
Maldives
Mali
Malta
Marshall Islands
Mauritania
Mauritius
Mexico
Micronesia (country)
Moldova
Monaco
Mongolia
Montenegro
Montserrat
Morocco
Mozambique
Myanmar
Namibia
Nauru
Nepal
Netherlands
New Caledonia
New Zealand
Nicaragua
Niger
Nigeria
Niue
North Macedonia
Northern Cyprus
Northern Mariana Islands
Norway
Oman
Pakistan
Palau
Palestine
Panama
Papua New Guinea
Paraguay
Peru
Philippines
Pitcairn
Poland
Portugal
Puerto Rico
Qatar
Romania
Russia
Rwanda
Saint Helena
Saint Kitts and Nevis
Saint Lucia
Saint Pierre and Miquelon
Saint Vincent and the Grenadines
Samoa
San Marino
Sao Tome and Principe
Saudi Arabia
Senegal
Serbia
Seychelles
Sierra Leone
Singapore
Sint Maarten (Dutch part)
Slovakia
Slovenia
Solomon Islands
Somalia
South Africa
South Korea
South Sudan
Spain
Sri Lanka
Sudan
Suriname
Sweden
Switzerland
Syria
Taiwan
Tajikistan
Tanzania
Thailand
Timor
Togo
Tokelau
Tonga
Trinidad and Tobago
Tunisia
Turkey
Turkmenistan
Turks and Caicos Islands
Tuvalu
Uganda
Ukraine
United Arab Emirates
United Kingdom
United States
United States Virgin Islands
Uruguay
Uzbekistan
Vanuatu
Vatican
Venezuela
Vietnam
Wallis and Futuna
Yemen
Zambia
Zimbabwe
  • eu zawierająca nazwy 51 krajów europy,
eu %>% kable2()
location
Albania
Andorra
Austria
Belarus
Belgium
Bosnia and Herzegovina
Bulgaria
Croatia
Cyprus
Czechia
Denmark
Estonia
Faeroe Islands
Finland
France
Germany
Gibraltar
Greece
Guernsey
Hungary
Iceland
Ireland
Isle of Man
Italy
Jersey
Kosovo
Latvia
Liechtenstein
Lithuania
Luxembourg
Malta
Moldova
Monaco
Montenegro
Netherlands
North Macedonia
Norway
Poland
Portugal
Romania
Russia
San Marino
Serbia
Slovakia
Slovenia
Spain
Sweden
Switzerland
Ukraine
United Kingdom
Vatican

Ta ramka posłużyła mi do wydzielania z tabel owid_covid_data oraz excess_mortality danych dla krajów Europy (owid_covid_data_eu, excess_mortality_eu).

Ponadto wylosowałem trzy kraje europejskie zapisane w selected_locations_eu,

selected_locations_eu %>% kable1()
location
Czechia
Montenegro
Germany

przygotowałem wektor zawierający daty z badanego okresu selected_period (od 2021-05-01r. do 2021-12-31r.), wylosowałem datę selected_date (2021-07-23r.) oraz przygotowałem ramkę z wielkościami populacji każdej lokalizacji location_population wykorzystywaną w zadaniu trzecim.

location_population %>% kable2()
location population
Afghanistan 39835428
Africa 1373486472
Albania 2872934
Algeria 44616626
Andorra 77354
Angola 33933611
Anguilla 15125
Antigua and Barbuda 98728
Argentina 45605823
Armenia 2968128
Aruba 107195
Asia 4678444992
Australia 25788217
Austria 9043072
Azerbaijan 10223344
Bahamas 396914
Bahrain 1748295
Bangladesh 166303494
Barbados 287708
Belarus 9442867
Belgium 11632334
Belize 404915
Benin 12451031
Bermuda 62092
Bhutan 779900
Bolivia 11832936
Bonaire Sint Eustatius and Saba 26445
Bosnia and Herzegovina 3263459
Botswana 2397240
Brazil 213993441
British Virgin Islands 30423
Brunei 441532
Bulgaria 6896655
Burkina Faso 21497097
Burundi 12255429
Cambodia 16946446
Cameroon 27224262
Canada 38067913
Cape Verde 561901
Cayman Islands 66498
Central African Republic 4919987
Chad 16914985
Chile 19212362
China 1444216102
Colombia 51265841
Comoros 888456
Congo 5657017
Cook Islands 17572
Costa Rica 5139053
Cote d’Ivoire 27053629
Croatia 4081657
Cuba 11317498
Curacao 164796
Cyprus 896005
Czechia 10724553
Democratic Republic of Congo 92377986
Denmark 5813302
Djibouti 1002197
Dominica 72172
Dominican Republic 10953714
Ecuador 17888474
Egypt 104258327
El Salvador 6518500
Equatorial Guinea 1449891
Eritrea 3601462
Estonia 1325188
Eswatini 1172369
Ethiopia 117876226
Europe 748962983
European Union 447189915
Faeroe Islands 49053
Falkland Islands 3528
Fiji 902899
Finland 5548361
France 67422000
French Polynesia 282534
Gabon 2278829
Gambia 2486937
Georgia 3979773
Germany 83900471
Ghana 31732128
Gibraltar 33691
Greece 10370747
Greenland 56868
Grenada 113015
Guam 170184
Guatemala 18249868
Guernsey 63385
Guinea 13497237
Guinea-Bissau 2015490
Guyana 790329
Haiti 11541683
High income 1214930230
Honduras 10062994
Hong Kong 7552800
Hungary 9634162
Iceland 368792
India 1393409033
Indonesia 276361788
International NA
Iran 85028760
Iraq 41179351
Ireland 4982904
Isle of Man 85410
Israel 9291000
Italy 60367471
Jamaica 2973462
Japan 126050796
Jersey 101073
Jordan 10269022
Kazakhstan 18994958
Kenya 54985702
Kiribati 121388
Kosovo 1782115
Kuwait 4328553
Kyrgyzstan 6628347
Laos 7379358
Latvia 1866934
Lebanon 6769151
Lesotho 2159067
Liberia 5180208
Libya 6958538
Liechtenstein 38254
Lithuania 2689862
Low income 665149040
Lower middle income 3330652550
Luxembourg 634814
Macao 658391
Madagascar 28427333
Malawi 19647681
Malaysia 32776195
Maldives 543620
Mali 20855724
Malta 516100
Marshall Islands 59618
Mauritania 4775110
Mauritius 1273428
Mexico 130262220
Micronesia (country) 116255
Moldova 4024025
Monaco 39520
Mongolia 3329282
Montenegro 628051
Montserrat 4981
Morocco 37344787
Mozambique 32163045
Myanmar 54806014
Namibia 2587344
Nauru 10873
Nepal 29674920
Netherlands 17173094
New Caledonia 288217
New Zealand 5126300
Nicaragua 6702379
Niger 25130810
Nigeria 211400704
Niue 1614
North America 596581283
North Macedonia 2082661
Northern Cyprus NA
Northern Mariana Islands 57910
Norway 5465629
Oceania 43219954
Oman 5223376
Pakistan 225199929
Palau 18174
Palestine 5222756
Panama 4381583
Papua New Guinea 9119005
Paraguay 7219641
Peru 33359415
Philippines 111046910
Pitcairn 47
Poland 37797000
Portugal 10167923
Puerto Rico 2828246
Qatar 2930524
Romania 19127772
Russia 145912022
Rwanda 13276517
Saint Helena 6095
Saint Kitts and Nevis 53546
Saint Lucia 184401
Saint Pierre and Miquelon 5771
Saint Vincent and the Grenadines 111269
Samoa 200144
San Marino 34010
Sao Tome and Principe 223364
Saudi Arabia 35340680
Senegal 17196308
Serbia 6871547
Seychelles 98910
Sierra Leone 8141343
Singapore 5453600
Sint Maarten (Dutch part) 43421
Slovakia 5449270
Slovenia 2078723
Solomon Islands 703995
Somalia 16359500
South Africa 60041996
South America 434260137
South Korea 51305184
South Sudan 11381377
Spain 46745211
Sri Lanka 21497306
Sudan 44909351
Suriname 591798
Sweden 10160159
Switzerland 8715494
Syria 18275704
Taiwan 23855008
Tajikistan 9749625
Tanzania 61498438
Thailand 69950844
Timor 1343875
Togo 8478242
Tokelau 1368
Tonga 106759
Trinidad and Tobago 1403374
Tunisia 11935764
Turkey 85042736
Turkmenistan 6117933
Turks and Caicos Islands 39226
Tuvalu 11925
Uganda 47123533
Ukraine 43466822
United Arab Emirates 9991083
United Kingdom 68207114
United States 332915074
United States Virgin Islands 104218
Upper middle income 2513672790
Uruguay 3485152
Uzbekistan 33935765
Vanuatu 314464
Vatican 812
Venezuela 28704947
Vietnam 98168829
Wallis and Futuna 11094
World 7874965730
Yemen 30490639
Zambia 18920657
Zimbabwe 15092171

Zadanie 1

Dla wybranego okresu wykonałem podsumowanie zawierające średnią liczbę wykonywanych dziennie szczepień w przeliczeniu na milion mieszkańców. Do wyliczenia średniej użyłem danych wygładzonych tygodniowo ze zmiennej new_vaccinations_smoothed_per_million.

sum_selected_data = owid_covid_data %>% 
  filter(date %in% selected_period & 
           location %in% locations$location &
           !is.na(new_vaccinations_smoothed_per_million)) %>% 
  group_by(continent, location) %>% 
  summarise(
    mean_nvspm = mean(new_vaccinations_smoothed_per_million, na.rm = T), 
    .groups = "keep") %>% 
  arrange(desc(mean_nvspm))

sum_selected_data %>% mutate(mean_nvspm = mean_nvspm %>% round(0)) %>% kable2()
continent location mean_nvspm
Africa Saint Helena 15915
Oceania Tokelau 12718
North America Cuba 11910
Oceania Pitcairn 10892
Oceania Niue 10645
Asia Brunei 8003
Asia South Korea 7863
North America Bonaire Sint Eustatius and Saba 7412
Asia China 7227
Europe Denmark 7099
Asia Malaysia 6956
Asia Cambodia 6791
Europe Ireland 6666
Asia Singapore 6628
Europe Iceland 6541
Europe Portugal 6413
Oceania Australia 6379
Asia Japan 6345
Europe Faeroe Islands 6321
Oceania New Zealand 6284
Europe Belgium 6250
South America Chile 6227
South America Argentina 6198
Asia Sri Lanka 6167
Asia Vietnam 6161
Europe France 6153
Europe Italy 6145
South America Uruguay 6107
Asia Northern Cyprus 6062
Europe Norway 6026
Europe Austria 6020
Asia Thailand 6010
South America Peru 5952
South America Ecuador 5949
Europe Spain 5947
Africa Mauritius 5930
Europe Germany 5916
North America Canada 5906
Asia Taiwan 5906
Europe Cyprus 5904
Oceania Cook Islands 5893
Europe Malta 5762
Europe Sweden 5761
Europe Luxembourg 5742
Europe Finland 5677
Europe Greece 5611
Asia Iran 5572
Europe Netherlands 5546
Asia Kuwait 5523
North America El Salvador 5512
North America Costa Rica 5505
South America Brazil 5450
Europe Liechtenstein 5436
Oceania Fiji 5433
Asia Macao 5401
Oceania Samoa 5352
Asia Mongolia 5301
Europe Guernsey 5242
North America Panama 5214
Asia Turkey 5189
Europe Switzerland 5174
Asia Qatar 5161
Europe United Kingdom 5061
Europe Isle of Man 5055
Europe Jersey 5023
Asia United Arab Emirates 4961
Europe Latvia 4911
Oceania Tonga 4910
Europe Lithuania 4804
Asia Saudi Arabia 4796
Europe Andorra 4782
Oceania Nauru 4775
South America Colombia 4742
Europe Gibraltar 4712
Europe Czechia 4701
North America Greenland 4667
Asia Bahrain 4667
North America Nicaragua 4630
Asia Hong Kong 4619
Asia Oman 4599
Asia Uzbekistan 4582
North America Dominican Republic 4551
Africa Morocco 4505
South America Venezuela 4431
Europe Monaco 4282
Europe Estonia 4216
Europe Slovenia 4207
Oceania New Caledonia 4198
North America Mexico 4123
Africa Cape Verde 4114
North America Cayman Islands 4093
Europe Hungary 4069
Africa Tunisia 3979
North America Trinidad and Tobago 3946
Asia Azerbaijan 3920
Oceania Kiribati 3893
Oceania French Polynesia 3887
North America Belize 3881
Asia Philippines 3866
Europe Croatia 3859
Europe Poland 3855
North America Honduras 3827
Asia Laos 3790
South America Paraguay 3780
Africa Rwanda 3765
Europe Kosovo 3760
Asia India 3759
North America Antigua and Barbuda 3755
Asia Indonesia 3704
North America Bermuda 3699
Europe Montenegro 3698
North America Turks and Caicos Islands 3657
Asia Timor 3588
Asia Bhutan 3553
Europe Russia 3529
Europe Slovakia 3513
Asia Kazakhstan 3469
Europe Belarus 3437
North America Aruba 3416
Oceania Tuvalu 3398
North America Anguilla 3380
Europe San Marino 3365
Europe North Macedonia 3337
North America Saint Kitts and Nevis 3228
North America United States 3198
North America Barbados 3194
North America British Virgin Islands 3136
Asia Turkmenistan 3123
South America Suriname 3112
North America Curacao 3071
South America Bolivia 3070
Asia Maldives 3029
South America Guyana 3027
Asia Nepal 2981
Asia Jordan 2939
Europe Serbia 2900
Asia Tajikistan 2853
North America Bahamas 2852
Asia Bangladesh 2797
North America Sint Maarten (Dutch part) 2746
Asia Pakistan 2744
Asia Israel 2738
Europe Albania 2683
Africa Sao Tome and Principe 2659
Europe Ukraine 2591
Africa Comoros 2534
Asia Georgia 2512
Asia Myanmar 2492
North America Guatemala 2475
Oceania Wallis and Futuna 2458
Africa Seychelles 2437
Asia Palestine 2426
Oceania Vanuatu 2374
Asia Lebanon 2346
North America Grenada 2337
Europe Romania 2301
Asia Armenia 2238
Europe Bosnia and Herzegovina 2118
Africa Egypt 2098
Africa Botswana 2061
Africa South Africa 1873
Africa Zimbabwe 1837
Africa Mozambique 1813
North America Saint Lucia 1785
North America Dominica 1757
North America Saint Vincent and the Grenadines 1729
Europe Bulgaria 1724
Europe Moldova 1655
Africa Mauritania 1607
Africa Libya 1537
Africa Lesotho 1515
North America Jamaica 1454
Asia Iraq 1372
Oceania Solomon Islands 1367
Asia Kyrgyzstan 1363
Africa Angola 1322
Africa Eswatini 1270
Africa Equatorial Guinea 1070
Africa Togo 1061
Africa Algeria 1018
Africa Cote d’Ivoire 999
Africa Namibia 986
Africa Ghana 927
Africa Uganda 913
Africa Guinea-Bissau 872
North America Montserrat 837
Africa Guinea 821
Africa Gabon 770
Africa Liberia 731
Africa Kenya 664
Africa Benin 613
Asia Syria 530
Africa Congo 528
Africa Djibouti 484
Africa Central African Republic 458
Africa Gambia 449
Asia Afghanistan 449
Africa Sierra Leone 425
Africa Senegal 360
Africa Zambia 353
Africa Somalia 347
Africa Ethiopia 341
Africa Malawi 308
Africa Sudan 299
Africa Tanzania 266
Africa Nigeria 252
Africa Burkina Faso 246
Africa Niger 244
Oceania Papua New Guinea 226
Africa Mali 197
Africa Cameroon 151
Africa Madagascar 137
North America Haiti 102
Africa South Sudan 99
Africa Chad 93
Asia Yemen 90
Africa Democratic Republic of Congo 14
Africa Burundi 9

Dane te zaprezentowałem na wykresie typu box-plot z podziałem na kontynenty.

sum_selected_data %>% 
  ggplot(aes(continent, mean_nvspm, fill=continent))+
  geom_boxplot()+
  labs(
    title = "Średnia dziena ilości szczepień",
    subtitle = paste("Dane z okresu od", min(selected_period), 
                     "do", max(selected_period)),
    caption = "M.F.",
    fill="Kontynent",
    y = "Średnia dzienna liczba szczepień")+
  theme(axis.title.x = element_blank())

Zadanie 2

W zadaniu drugim analizowałem zależność ilości zgonów total_deaths_per_million w dniu 2021-07-23 od innych wybranych zmiennych we wszystkich krajach Europy. Do efektywnej wizualizacji przygotowałem specjalną własna funkcję PlotSpec1 generująca odpowiedni wykres z możliwością zmiany skali osi x i/lub y na skalę logarytmiczną dziesiętną. Dodatkowo na wykresie tym zaznaczyłem odpowiednimi etykietami dane dla Polski oraz trzech wylosowanych krajów.

selected_data = owid_covid_data_eu %>% 
  filter(date == selected_date) %>% 
  mutate(population_aged_70_older = population*aged_70_older/population*1e6)

Zgony a ilość osób powyżej 70 lat

selected_data %>% 
  PlotSpec1(selected_locations_eu, population_aged_70_older, 
            total_deaths_per_million, location, F, F)+
  labs(
    title = "Zależność pomiędzy ilością zgonów a ilością osób w wieku powyżej 70 lat",
    subtitle = paste("Dane na dzień", selected_date),
    caption = "M.F.",
    x="Ilość osób w wieku powyżej 70 lat na milion mieszkańców",
    y = "Ilość zgonów na milion mieszkańców")

Trudno jest dopatrzeć się tu jakiejkolwiek sensownej zależności. Ilość zgonów w przeliczeniu na milion mieszkańców nie zależy od ilości osób w wieku powyżej 70 lat.

Zgony a mediana wieku

selected_data %>% 
  PlotSpec1(selected_locations_eu, median_age, 
            total_deaths_per_million, location, F, F)+
  labs(
    title = "Zależność pomiędzy ilością zgonów a medianą wieku",
    subtitle = paste("Dane na dzień", selected_date),
    caption = "M.F.",
    x="Mediana wieku",
    y = "Ilość zgonów na milion mieszkańców")

Również w przypadku mediany wieku trudno jest doprzeć się jakiejś istotnej zależności.

Zgony a gęstość zaludnienia

selected_data %>% 
  PlotSpec1(selected_locations_eu, population_density, 
            total_deaths_per_million, location, T, F)+
  labs(
    title = "Zależność pomiędzy ilością zgonów a gęstością zaludnienia",
    subtitle = paste("Dane na dzień", selected_date),
    caption = "M.F.",
    x="Gęstość zaludnienia [log10]",
    y = "Ilość zgonów na milion mieszkańców ")

Tak samo jest w przypadku gęstości zaludnienia.

Zgony a liczba wykonanych testów

selected_data %>% 
  PlotSpec1(selected_locations_eu, total_tests_per_thousand, 
            total_deaths_per_million, location, T, F)+
  labs(
    title = "Zależność pomiędzy ilością zgonów a liczbą wykonanych testów",
    subtitle = paste("Dane na dzień", selected_date),
    caption = "M.F.",
    x="Ilość wykonanych testów na tysiąc mieszkańców [log10]",
    y = "Ilość zgonów na milion mieszkańców")

Wskaźnik zgonów nie zależy także od liczby wykonywanych testów. Uwaga, na wykresie zaznaczone są dane tylko dla jednego kraju. Jest to związane z brakiem danych w pozostałych wylosowanych krajach (również w Polsce) na dzień 2021-07-23.

Hospitalizowani a liczba wykonanych testów

selected_data %>% 
  PlotSpec1(selected_locations_eu, total_tests_per_thousand, 
            new_cases_smoothed_per_million, location, T, T)+
  labs(
    title = "Zależność pomiędzy ilością nowych przypadków a liczbą wykonanych testów",
    subtitle = paste("Dane na dzień", selected_date),
    caption = "M.F.",
    x="Ilość wykonanych testów na tysiąc mieszkańców [log10]",
    y = "Ilość nowych przypadków zachorowań [log10]")

Ilość nowych przypadków także nie jest zależna od liczby wykonywanych testów.

Hospitalizowani a liczba nowych przypadków

selected_data %>% 
  PlotSpec1(selected_locations_eu, new_cases_smoothed_per_million, 
            icu_patients_per_million, location, T, F)+
  labs(
    title = "Zależność pomiędzy ilością osób hospitalizowanych a liczbą nowych przypadków",
    subtitle = paste("Dane na dzień", selected_date),
    caption = "M.F.",
    x="Ilość nowych przypadków na milion mieszkańców [log10]",
    y = "Ilość osób hospitalizownych na milion mieszkańców")

W przypadku zależności pomiędzy ilością osób hospitalizowanych a liczbą nowych przypadków można zauważyć (począwszy od 100 przypadków na milion) niewielki paraboliczny wzrost. Należy jednak pamiętać, że ilości nowych przypadków zostały przedstawione w skali logarytmicznej.

Hospitalizowani a liczba zgonów

selected_data %>% 
  PlotSpec1(selected_locations_eu, icu_patients_per_million, 
            new_deaths_smoothed_per_million, location, T, F)+
  labs(
    title = "Zależność pomiędzy ilością osób hospitalizowanych a liczbą zgonóW",
    subtitle = paste("Dane na dzień", selected_date),
    caption = "M.F.",
    x="Ilość zgonów  milion mieszkańców [log10]",
    y = "Ilość osób hospitalizownych na milion mieszkańców")

Bardzo podobnie wygląda zależność ilości hospitalizowanych osób w funkcji ilości zgonów. Występuje tu również niewielka paraboliczna zależność.

Zadanie 3

W tym zadaniu będę porównywał średnie ilości zgonów w latach 2015 - 2019 z ilościami zgonów w dwóch latach trwania pandemii. Wszystkie wartości przeliczyłem na milion mieszkańców. Należy jednak zwrócić uwagę, że dla szesnastu krajów dane odnośnie zgonów podane są w okresach miesięcznych, natomiast dla pozostałych trzydziestu jeden krajów europejskich dane są zebrane w okresach tygodniowych. Z tego powodu prezentację danych wykonałem osobno dla krajów z raportowaniem miesięcznym a osobno dla krajów z raportowaniem tygodniowym.

country_monthly = excess_mortality_eu %>% 
  filter(time_unit == "monthly") %>% 
  distinct(location)

country_weekly = excess_mortality_eu %>% 
  filter(time_unit == "weekly") %>% 
  distinct(location)

selected_data = excess_mortality_eu %>% 
  rename(`2015-19` = average_deaths_2015_2019_all_ages,
         `2020` = deaths_2020_all_ages,
         `2021` = deaths_2021_all_ages) %>% 
  pivot_longer(c(`2015-19`, `2020`, `2021`), names_to = "Okres") %>% 
  filter(!is.na(value)) %>% 
  left_join(location_population, by="location") %>% 
  mutate(value = value/population*1e6)
selected_data %>% 
  filter(location %in% country_weekly$location[1:16]) %>% 
  ggplot(aes(time, value, color=Okres))+
  geom_line()+
  scale_x_continuous(breaks = seq(12, 54, 12), labels = seq(12, 54, 12))+
  facet_wrap(vars(location))+
  labs(
    title = "Tygodniowa liczba zgonów",
    caption = "M.F.",
    x="Nr tygodnia roku",
    y = "Ilość zgonów na milion mieszkańców")

selected_data %>% 
  filter(location %in% country_weekly$location[17:31]) %>% 
  ggplot(aes(time, value, color=Okres))+
  geom_line()+
  scale_x_continuous(breaks = seq(12, 54, 12), labels = seq(12, 54, 12))+
  facet_wrap(vars(location))+
  labs(
    title = "Tygodniowa liczba zgonów",
    caption = "M.F.",
    x="Nr tygodnia roku",
    y = "Ilość zgonów na milion mieszkańców")

selected_data %>% 
  filter(location %in% country_monthly$location) %>% 
  ggplot(aes(time, value, color=Okres))+
  geom_line()+
  scale_x_continuous(breaks = seq(3, 12, 3), labels = seq(3, 12, 3))+
  facet_wrap(vars(location))+
  labs(
    title = "Miesięczna liczba zgonów",
    caption = "M.F.",
    x="Miesiąc",
    y = "Ilość zgonów na milion mieszkańców")

selected_data %>% 
  filter(location == "Poland") %>% 
  ggplot(aes(time, value, color=Okres))+
  geom_line()+
  scale_x_continuous(breaks = seq(12, 54, 12), labels = seq(12, 54, 12))+
  labs(
    title = "Tygodniowa liczba zgonów w Polsce",
    caption = "M.F.",
    x="Nr tygodnia roku",
    y = "Ilość zgonów na milion mieszkańców")

Analizując powyższe wykresy można zauważyć, że bez wątpienia w czasie pandemii średnio umierało więcej osób niż w poprzednich latach. W przypadku wielu krajów szczególnie wyraźne widoczne są okresy wzmożonej intensywności widoczne w formie pików, w czasie których umieralność wzrastała nawet kilkukrotnie. Takiego gwałtownego wzrostu umieralności nie doświadczyły jednak wszystkie kraje. Obroniły się przed tym chociażby Finlandia, Dania, Islandia czy Norwegia. Niestety w naszym kraju przypadły aż trzy takie okresy.

Zadanie 4

W ostatnim zadania (na podstawie owid_covid_data_eu) dla Polski oraz wybranych losowo krajów z selected_locations_eu wykonałem wizualizację wybranych wskaźników w czasie. Na wykresach zaznaczyłem dni w których w danym kraju osiągnięto maksymalną wartość badanego wskaźnika.

W celu łatwego wygenerowania wykresu z odpowiednimi etykietami przygotowałem kolejną własną funkcję PlotSpec2.

Ilość nowych przypadków

owid_covid_data_eu %>% 
  PlotSpec2(selected_locations_eu, date, new_cases_smoothed_per_million, date)+
  labs(
    title = "Dzienna liczba nowych przypadków w wybranych krajach",
    caption = "M.F.",
    color = "Kraj",
    x="Data",
    y = "Ilość nowych przypadków na milion mieszkańców")

Ilość nowych zgonów

owid_covid_data_eu %>% 
  PlotSpec2(selected_locations_eu, date, new_deaths_smoothed_per_million, date)+
  labs(
    title = "Dzienna liczba nowych zgonów w wybranych krajach",
    caption = "M.F.",
    color = "Kraj",
    x="Data",
    y = "Ilość nowych zgonów na milion mieszkańców")

Dzienna ilość osób zaszczepionych

owid_covid_data_eu %>% 
  PlotSpec2(selected_locations_eu, date, 
            new_people_vaccinated_smoothed_per_hundred, date)+
  labs(
    title = "Dzienna liczba osób zaszczepionych w wybranych krajach",
    caption = "M.F.",
    color = "Kraj",
    x="Data",
    y = "Ilość osób zaszczepionych na milion mieszkańców")

Dzienna liczba testów do liczby nowych przypadków

owid_covid_data_eu %>% 
  mutate(test_to_cases = new_tests_smoothed_per_thousand/new_cases_smoothed_per_million) %>% 
  PlotSpec2(selected_locations_eu, date, test_to_cases, date)+
  labs(
    title = "Stosunek dziennej liczby wykonanych testów do dziennej liczby nowych przypadków",
    caption = "M.F.",
    color = "Kraj",
    x="Data",
    y = "Liczba testów do liczby nowych przypadków")

Dodatek

Na zakończenie dołączam zawartość pomocniczego skryptu Funkcje pomocnicze.R W którym zebrałem wszystkie włane funkcje wykorzystywane w projekcie.

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

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

#Wizualizacja tabel w HTML z przewijaniem
kable2 = function(data, digits=3, height="320px") data %>%
  kable1(digits = digits) %>%
  scroll_box(width = "100%", height = height)

#Wykres specjalny 1
PlotSpec1 = function(df, sel_location, var_x, var_y, var_lab, x_log10, y_log10){
  var_X = enquo(var_x)
  var_y = enquo(var_y)
  var_lab = enquo(var_lab)
  df = df %>% filter(!is.na(!!var_X) & !is.na(!!var_y))
  sides = ""

  df_max = df %>% filter(location %in% c(sel_location$location, "Poland"))

  p = df %>% ggplot(aes(!!var_X, !!var_y, label=!!var_lab))+
    geom_point()+
    geom_smooth(method = 'loess', formula = 'y ~ x')+
    geom_point(data = df_max, shape = 21, size=5, color = "red")+
    geom_label_repel(data = df_max, color = "red", box.padding = 1)

  if(x_log10){
    p = p + scale_x_log10(breaks = trans_breaks("log10", function(x) 10^x),
                          labels = trans_format("log10", math_format(10^.x)))
    sides = paste0(sides, "b")
  }
  if(y_log10){
    p = p + scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
                          labels = trans_format("log10", math_format(10^.x)))

      sides = paste0(sides, "l")
  }
  if(x_log10 | y_log10) p = p + annotation_logticks(sides=sides)

  p
}

#Wykres specjalny 2
PlotSpec2 = function(df, sel_location, var_x, var_y, var_lab){
  var_X = enquo(var_x)
  var_y = enquo(var_y)
  var_lab = enquo(var_lab)
  df = df %>%
    filter(!is.na(!!var_X) & !is.na(!!var_y) &
             location %in% c(sel_location$location, "Poland"))

  df_max = df %>%
    group_by(location) %>%
    filter(!!var_y == max(!!var_y))

  df %>%
    ggplot(aes(!!var_X, !!var_y, color=location, label=paste(!!var_lab)))+
    geom_line()+
    geom_point(data = df_max, shape=23)+
    geom_label_repel(data = df_max, box.padding = 1)
}

`