Zgony ogółem vs zgony na Covid (analiza danych tygodniowych)

Dane

Pomocniczy plik csv zawiera identyfikatory makroregionów (Eurostat/NUTS) oraz odpowiadające im nazwy. Uprzedzając wydarzenia problemem jest województwo mazowieckie podzielone w nomenklaturze NUTS na dwa makroregiony

ww <- c('PL21', 'PL22', 'PL41', 'PL42', 'PL43', 'PL51', 
'PL52', 'PL61', 'PL62', 'PL63', 'PL71', 'PL72', 'PL81', 
'PL82', 'PL84', 'PL91', 'PL92', 'PL')

## Dane z CSV
## PL91 = warszawskie + PL92 = mazowieckie
n <- read.csv(file='nuts.csv',sep=';',header=T)

Dane tygodniowe dotyczące zgonów z GUS w podziale na makroregiony (a nie województwa.) W związku z tym makroregion 91 zostaje przekodowany na 92 (mazowieckie). Następnie ramka jest przeliczana tak żeby dla każdego tygodnia 92 występowało jako jeden wiersz a nie dwa:

z <- read.csv(file='zgonyGUS.csv',sep=';',header=T)
## Filtrowanie wierszy
z <- z %>% filter ( woj %in% ww ) %>%
  mutate(woj=recode(woj, PL91="PL92")) %>%
  group_by(date,woj) %>% 
  ## sumowanie 91+92
  mutate(value=sum(value))

Po tym zabiegu ramka z jest podzielona na województwa. Łączymy ją zatem z ramką zawierającą nazwy województw (po czym tworzymy identyfikator wiersza w postaci napisu rrrrtt; gdzie rrrr – rok a tt tydzień-w-roku)

z <- left_join(z, n, by=c('woj'='geo')) %>%
  mutate( yyww = sprintf ("%i%02i", year, week))

Czytamy dane dotyczące zgonów kowidowych (osoby zmarłe z powodu COVID19 lub z powodu COVID19 w połączeniu ze słynnymi chorobami współistniejącymi.) Dane pochodzą z komunikatów publikowanych codziennie na koncie Ministerstwa Zdrowia; MinZdrowia podaje dane dla województw, a nie makroregionów NUTS i stąd przeliczenia powyżej (https://twitter.com/MZ_GOV_PL):

## obserwacje dzienne z https://twitter.com/MZ_GOV_PL
c <- read.csv(file='MZN_weekly.csv',sep=';',header=T)

Tworzymy identyfikator wiersza postaci rrrrtt; grupujemy wiersze wg tego identyfikatora oraz województwa. Następnie sumujemy grupy, co w efekcie zamienia dane dzienne na tygodniowe:

c <- c %>% 
  mutate(yr = substr(date, 1, 4)) %>%
  mutate(yyww = sprintf ("%i%02i", as.numeric(yr), as.numeric(wn))) %>%
  group_by(yyww,idw) %>%
  summarise( nc = sum(newc), nd=sum(newd) )

Łączymy z danymi nt zgonów ogółem; jako klucza używając kolumn rrrrtt oraz nazwy województwa:

z0 <- left_join(z, c, by=c('name'='idw', 'yyww'='yyww'))

Wykresy

Polska ogółem

zz <- z0 %>% filter(name == 'Polska' & year > 2019)

p <- zz %>% 
  pivot_longer(cols = c(nd, value), names_to = "dtype", values_to = "dval") %>%
  ##
  ggplot(aes(x = as.Date(date), y=dval, color=dtype)) +
  geom_point(size=1 ) +
  geom_smooth(method = "loess", size=.5, span=0.25, se=F) +
  ##geom_text(aes(label = week, color=dtype), size=3) +
  theme_nikw() +
  xlab(label="mm/dd") +
  ylab(label="zgony") +
  scale_x_date( breaks = "3 weeks", labels = date_format("%m/%d")) +
  scale_y_continuous(breaks=seq(0, 20000, by=1000)) +
  scale_color_manual(name="", values = c(nd=default_red, value=default_cyan ), 
                     labels =c(nd="Ogółem", value="Covidowe")) +
  ##
  ggtitle("Zgony ogółem vs covidowe w PL (wg tygodni)",
          subtitle = "źródło: GUS https://stat.gov.pl/obszary-tematyczne/ludnosc/ludnosc/zgony-wedlug-tygodni,39,2.html + MinZdrowia (COVID)") +
  ##
  theme(axis.text = element_text(size = 6)) +
  theme(plot.title = element_text(hjust = 0), 
        plot.subtitle=element_text(size=8)
        )

##ggsave(plot=p, file='zz_p.png', width=9)
p

Wg województw

## usuń PL (a będzie 16)
zz <- z0 %>% filter(name != 'Polska' & year > 2019)

q <- zz %>% 
  pivot_longer(cols = c(nd, value), names_to = "dtype", values_to = "dval") %>%
  ##
  ggplot(aes(x = as.Date(date), y=dval, color=dtype)) +
  geom_point(size=1 ) +
  geom_smooth(method = "loess", size=.5, span=0.25, se=F) +
  ##geom_text(aes(label = week, color=dtype), size=3) +
  theme_nikw() +
  xlab(label="mm/dd") +
  ylab(label="zgony") +
  scale_x_date( breaks = "8 weeks", labels = date_format("%m/%d")) +
  ##scale_y_continuous(breaks=seq(0, 20000, by=1000)) +
  scale_color_manual(name="", values = c(nd=default_red, value=default_cyan ), 
                     labels =c(nd="Ogółem", value="Covidowe")) +
  ##
  ggtitle("Zgony ogółem vs covidowe w PL (wg tygodni)",
          subtitle = "źródło: GUS https://stat.gov.pl/obszary-tematyczne/ludnosc/ludnosc/zgony-wedlug-tygodni,39,2.html + MinZdrowia (COVID)") +
  ##
  facet_wrap( ~name, scales = "free_y") +
  theme(axis.text = element_text(size = 6)) +
  theme(plot.title = element_text(hjust = 0), 
        plot.subtitle=element_text(size=8)
  )

##ggsave(plot=q, file='zz_w.png', width=12, height=12)
q

Powyższe ale jako udział zgonów cowidowych w wielkości zgonów ogółem:

## udział w zgonach kowidowych
z0 <- z0 %>% mutate ( rr = nd / value * 100 )
zz <- z0 %>% filter(name == 'Polska' & year > 2019)

p <- zz %>% 
  ggplot(aes(x = as.Date(date), y=rr)) +
  geom_point(size=1 ) +
  geom_smooth(method = "loess", size=.5, span=0.25, se=F) +
  ##geom_text(aes(label = week, color=dtype), size=3) +
  theme_nikw() +
  xlab(label="mm/dd") +
  ylab(label="zgony") +
  scale_x_date( breaks = "3 weeks", labels = date_format("%m/%d")) +
  ##
  ggtitle("Zgony covidowe jako % ogółem w PL (wg tygodni)",
          subtitle = "źródło: GUS https://stat.gov.pl/obszary-tematyczne/ludnosc/ludnosc/zgony-wedlug-tygodni,39,2.html + MinZdrowia (COVID)") +
  ##
  theme(axis.text = element_text(size = 6)) +
  theme(plot.title = element_text(hjust = 0), 
        plot.subtitle=element_text(size=8)
  )
##
##ggsave(plot=p, file='zz_p_p.png', width=9)
p

Udziały wg województw:

### Województwa (udziały)
zz <- z0 %>% filter(name != 'Polska' & year > 2019)

q <- zz %>% 
  ggplot(aes(x = as.Date(date), y=rr)) +
  geom_point(size=1 ) +
  geom_smooth(method = "loess", size=.5, span=0.25, se=F) +
  ##geom_text(aes(label = week, color=dtype), size=3) +
  theme_nikw() +
  xlab(label="mm/dd") +
  ylab(label="zgony") +
  coord_cartesian(ylim = c(0, 30)) +
  scale_x_date( breaks = "6 weeks", labels = date_format("%m/%d")) +
  ##
  ggtitle("Zgony covidowe jako % ogółem w PL (wg tygodni)",
          subtitle = "źródło: GUS https://stat.gov.pl/obszary-tematyczne/ludnosc/ludnosc/zgony-wedlug-tygodni,39,2.html + MinZdrowia (COVID)") +
  ##
  facet_wrap( ~name, scales = "fixed") +
  theme(axis.text = element_text(size = 6)) +
  theme(plot.title = element_text(hjust = 0), 
        plot.subtitle=element_text(size=8)
  )
##
##ggsave(plot=q, file='zz_w_p.png', width=12, height=12)
q

Plik wojewodztwa.csv zawiera dane dotyczące liczby ludności (wg GUS za 2019 rok); łączymy go z ramką z0 a następnie obliczamy liczbę zgonów na 1mln mieszkańców:

### Ludność wg/woj
wp <- read.csv(file='wojewodztwa.csv',sep=';',header=T)
z0 <- left_join(z0, wp, by=c('name'='woj')) 

## zgony na 1mln (tygodniowo)
z1 <- z0 %>% mutate ( value = value / pop * 1000, nd = nd / pop * 1000)
zz <- z1 %>% filter(name != 'Polska' & year > 2019)
r <- zz %>% 
  pivot_longer(cols = c(nd, value), names_to = "dtype", values_to = "dval") %>%
  ##
  ggplot(aes(x = as.Date(date), y=dval, color=dtype)) +
  geom_point(size=1 ) +
  geom_smooth(method = "loess", size=.5, span=0.25, se=F) +
  ##geom_text(aes(label = week, color=dtype), size=3) +
  theme_nikw() +
  xlab(label="mm/dd") +
  ylab(label="zgony") +
  scale_x_date( breaks = "8 weeks", labels = date_format("%m/%d")) +
  ##scale_y_continuous(breaks=seq(0, 20000, by=1000)) +
  scale_color_manual(name="", values = c(nd=default_red, value=default_cyan ), 
                     labels =c(nd="Ogółem", value="Covidowe")) +
  ##
  ggtitle("Zgony ogółem vs covidowe na 1mln w PL (wg tygodni)",
          subtitle = "źródło: GUS https://stat.gov.pl/obszary-tematyczne/ludnosc/ludnosc/zgony-wedlug-tygodni,39,2.html + MinZdrowia (COVID)") +
  ##
  facet_wrap( ~name, scales = "fixed") +
  theme(axis.text = element_text(size = 6)) +
  theme(plot.title = element_text(hjust = 0), 
        plot.subtitle=element_text(size=8)
  )

##ggsave(plot=r, file='zz_w1m.png', width=12, height=12)
r

Wnioski

Niewątpliwie liczba zgonów covidowych słabo wyjaśnia skalę wzrostu liczby zgonów ogółem pod koniec 2020 roku. O tym zresztą świadczy na przykład poniższy wykres rozproszenia:

zz <- z1 %>% filter(name != 'Polska' & ( (year == 2020 & week >= 44) | (year > 2020)  ))
p <- zz %>% 
  ggplot(aes(x = nd, y=value, color=name)) +
  geom_point(size=1 ) +
  #geom_smooth(method = "loess", size=.5, span=0.25, se=F) +
  theme_nikw() +
  xlab(label="ogółem") +
  ylab(label="c19") +
  ggtitle("Zgony ogółem vs covidowe w PL (od 44 tygodnia/2020)",
          subtitle = "źródło: GUS https://stat.gov.pl/obszary-tematyczne/ludnosc/ludnosc/zgony-wedlug-tygodni,39,2.html + MinZdrowia (COVID)")
p

albo niska, bo wynosząca zaledwie 0.3621134 wartość współczynnika korelacji liniowej Pearsona (dla tygodni 44/2020 i kolejnych).

Zgony ogółem vs zgony na Covid (analiza danych tygodniowych)

TP

2 03 2021

Dane

Wykresy

Wnioski