Marimekko to zestawiony do 100% wykres słupkowy, gdzie szerokość słupka jest proporcjonalna do jego udziału w liczebności. (https://predictivesolutions.pl/wykres-marimekko-czyli-analityczny-patchwork)
Nie wiem o co chodzi, ale patrząc na przykłady, to jest to wykres pokazujący strukturę dwóch zmiennych na raz. Coś jak skumulowany wykres słupkowy (stacked barchart), tyle że słupki mają zmienną szerokość, odpowiadającą udziałom/liczebnościom wartości jednej cechy. Dla każdego słupka z kolei poszczególne segmenty mają wysokości proporcjonalne do udziałów/liczebności wartości drugiej cechy (w tym słupku). Alternatywną nazwą jest wykres mozaikowy.
Ale jest też trochę inny wariant takich wykresów, dla przypadku kiedy dla każdej jednostki w populacji generalnej jest Wi = Ci/Ni. Jeżeli wysokość słupka jest proporcjonalna do wartości Wi, szerokość jest proporcjonalna do Ni, to pola są oczywiście w proporcji Ci. Przykładowo jeżeli populacją generalną są kraje świata, wartością cechy Ni jest liczba mieszkańców w kraju i, wartością cechy Ci wielkość emisja CO2 w kraju i, to Wi jest oczywiście emisją per capita.
Moim zdaniem użyteczne, bo pokazuje na raz dwa natężenia: łączne, w skali całej populacji oraz szczegółowe, w skali jednostki. Kontynuując przykład: ile emituje przeciętny mieszkaniec kraju i oraz jaki jest udział emisji kraju i w całości emisji.
W przypadku epidemii COVID19 podstawową zmienną jest liczba zarażonych/zmarłych w kraju i. Ale jeżeli chcemy porównać kraj i z krajem j to oczywiście należy uwzględnić liczbę mieszkańców w obu krajach. Czyli wysokości słupków powinny odpowiadać liczbie zarażonych/zmarłych na jednostkę (np. na 1mln) a szerokości liczbie mieszkańców:
library(ggplot2) library(dplyr) dat <- "2020/04/09" d <- read.csv("indcs.csv", sep = ';', header=T, na.string="NA"); ## liczba ludności w milionach (szerokość): d$popm <- d$pop / million ## Oblicz współczynniki na 1mln d$casesr <- d$cases/d$popm ### Wysokość: d$deathsr <- d$deaths/d$popm ## Ograniczamy liczbę krajów żeby zwiększyć czytelność wykresu ## Tylko kraje wykazujące zmarłych d <- d %>% filter(deaths > 0) %>% as.data.frame ## Tylko kraje z min 2/1mln i populacji > 1mln d9 <- d %>% filter(deathsr > 2 & popm > 3 & deaths > 49) %>% droplevels() %>% arrange (deathsr) %>% as.data.frame d9$w <- cumsum(d9$popm) d9$wm <- d9$w - d9$popm d9$wt <- with(d9, wm + (w - wm)/2) d8$w <- cumsum(d8$popm) d8$wm <- d8$w - d8$popm d8$wt <- with(d8, wm + (w - wm)/2) ## Dzielimy etykiety na dwie grupy ## (inaczej wiele etykiet zachodzi na siebie) d9$iso3h <- d9$iso3 d9$iso3l <- d9$iso3 ## Kraje o niskich wartościach bez etykiet d9$iso3h[ (d9$popm < 15 ) ] <- "" ## Kraje o wysokich wartościach bez etykiet d9$iso3l[ (d9$popm >= 15 ) ] <- "" p9 <- ggplot(d9, aes(ymin = 0)) + ylab(label="mratio (deaths/1mln)") + xlab(label="population (mln)") + ggtitle(sprintf("COVID19 mortality (%s | mratio > 2 | population > 3mln )", dat), subtitle="source: https://www.ecdc.europa.eu/en/covid-19-pandemic (twitter.com/tprzechlewski)") + geom_rect(aes(xmin = wm, xmax = w, ymax = deathsr, fill = iso3)) + geom_text(aes(x = wt, y = 0, label = iso3h), vjust=+0.5, hjust=+1.25, size=2.0, angle = 90) + geom_text(aes(x = wt, y = 0, label = iso3l), vjust=+0.5, hjust=-0.20, size=1.5, angle = 90) + theme(legend.position = "none") ## ... podobnie dla zmiennej casesr
Wynik w postaci rysunków:
Powyższe jest dostępne tutaj
Wymyśliłem sobie wykreślić wykresy pokazujące zależność pomiędzy liczbą zarażonych/zmarłych, a wybranymi wskaźnikami: GDP (zamożność), oczekiwana długość życia (poziom służby zdrowia) oraz śmiertelność dzieci (zamożność/poziom rozwoju). Większość danych pobrałem z portalu OWiD:
Dane dotyczące liczby ludności są z bazy Banku Światowego
(https://data.worldbank.org/indicator/sp.pop.totl
.)
Dane dotyczące zarażonych/zmarłych ze strony ECDC (www.ecdc.europa.eu/en/covid-19/data-collection)
Scaliłem wszystko do kupy skryptem Perlowym. NB pojawił się tzw. small problem,
bo bazy OWiD oraz WorldBank używają ISO-kodów 3-literowych krajów,
a ECDC dwuliterowych (PL vs POL).
Trzeba było znaleźć wspólny mianownik.
Szczęśliwie Perl ma gotowy moduł. Oprócz tego ECDC stosuje EU-standard w przypadku Grecji
(EL zamiast GR) oraz Wielkiej Brytanii (UK/GB).
#!/usr/bin/perl use Locale::Codes::Country; ... while (<COVID>) { chomp(); ($date, $iso2, $country, $newc, $newd, $totalc, $totald) = split /;/, $_; $iso3 = uc ( country_code2code($iso2, 'alpha-2', 'alpha-3')); }
Rezultat jest zapisywany do pliku o następującej zawartości:
iso3;country;lex2019;gdp2016;cm2017;pop2018;cases;deaths ABW;Aruba;76.29;NA;NA;105845;77;0 AFG;Afghanistan;64.83;1929;6.79;37172386;423;14 ...
Wierszy jest 204, przy czym niektórym krajom brakuje wartości. Ponieważ dotyczy to krajów egzotycznych, zwykle małych, to pominę je (nie teraz później, na etapie przetwarzania R-em). Takich wybrakowanych krajów jest 49 (można grep-em sprawdzić). Jedynym większym w tej grupie jest Syria, ale ona odpada z innych powodów.
Do wizualizacji wykorzystam wykres punktowy (dot-plot) oraz wykresy rozrzutu (dot-plot).
library("dplyr") library("ggplot2") library("ggpubr") ## options(scipen=1000000) ## https://www.r-bloggers.com/the-notin-operator/ `%notin%` <- Negate(`%in%`) ## today <- Sys.Date() tt<- format(today, "%d/%m/%Y") million <- 1000000 ## Lista krajów Europejskich + Izrael ## (pomijamy kraje-liliputy) ee <- c( 'BEL', 'GRC', 'LTU', 'PRT', 'BGR', 'ESP', 'LUX', 'ROU', 'CZE', 'FRA', 'HUN', 'SVN', 'DNK', 'HRV', 'MLT', 'SVK', 'DEU', 'ITA', 'NLD', 'FIN', 'EST', 'CYP', 'AUT', 'SWE', 'IRL', 'LVA', 'POL', 'ISL', 'NOR', 'LIE', 'CHE', 'MNE', 'MKD', 'ALB', 'SRB', 'TUR', 'BIH', 'BLR', 'MDA', 'UKR', 'ISR', 'RUS', 'GBR' ); ee.ee <- c('POL') d <- read.csv("indcs.csv", sep = ';', header=T, na.string="NA"); ## Liczba krajów N1 <- nrow(d) ## liczba ludności w milionach d$popm <- d$pop / million ## Oblicz współczynniki na 1mln d$casesr <- d$cases/d$popm d$deathsr <- d$deaths/d$popm ## Tylko kraje wykazujące zmarłych d <- d %>% filter(deaths > 0) %>% as.data.frame ## Liczba krajów wykazujących zmarłych N1d <- nrow(d) ## Tylko kraje z kompletem wskaźników (pomijamy te z brakami) d <- d[complete.cases(d), ] nrow(d) ## UWAGA: pomijamy kraje o wsp. <= 2 ## droplevels() usuwa `nieużywane' czynniki ## mutate zmienia kolejność na kolejność wg dearhsr: d9 <- d %>% filter(deathsr > 2 ) %>% droplevels() %>% mutate (iso3 = reorder(iso3, deathsr)) %>% as.data.frame N1d2 <- nrow(d9) M1d2 <- median(d9$deathsr, na.rm=T) ## https://stackoverflow.com/questions/11093248/geom-vline-with-character-xintercept ## Wykres punktowy rys99 <- ggplot(d9, aes(x =iso3, y = deathsr )) + geom_point(size=1, colour = 'steelblue', alpha=.5) + xlab(label="Country") + ylab(label="Deaths/1mln") + ggtitle(sprintf("COVID19 mortality in deaths/mln (as of %s)", tt), subtitle=sprintf("Countries with ratio > 0: %i | Countries with ratio > 2.0: N=%i (median %.1f)", N1d, N1d2, M1d2)) + theme(axis.text = element_text(size = 4)) + ##theme(plot.title = element_text(hjust = 0.5)) + scale_y_continuous(breaks=c(0,20,40,60,80,100,120,140,160,180,200,220,240,260,280,300,320,340,360)) + geom_hline(yintercept=M1d2, linetype="solid", color = "steelblue") + geom_vline(aes(xintercept = which(levels(iso3) == 'POL')), size=1, color="#8A0303", alpha=.25) + geom_vline(aes(xintercept = which(levels(iso3) == 'DEU')), size=1, color="#8A0303", alpha=.25) + geom_vline(aes(xintercept = which(levels(iso3) == 'SWE')), size=1, color="#8A0303", alpha=.25) + coord_flip()
Uwaga: oś OX to skala porządkowa. Czynniki powinny być uporządkowane wg. wartości zmiennej z osi OY,
czyli według deathsr
.
Do tego służy funkcja mutate (iso3 = reorder(iso3, deathsr)
.
Można też uporządkować je ,,w locie'' aes(x =iso3, y = deathsr )
, ale wtedy
niepoprawnie będą kreślone (za pomocą geom_vline
) linie pionowe. Linie
pionowe służą do wyróżnienia
pewnych krajów. Linia pozioma to linia mediany.
sources <- sprintf ("As of %s\n(Sources: %s %s)", tt, "https://www.ecdc.europa.eu/en/covid-19-pandemic", "https://ourworldindata.org/") ## Żeby etykiety nie zachodziły na siebie tylko dla wybranych krajów ## Add empty factor level! Istotne inaczej będzie błąd # https://rpubs.com/Mentors_Ubiqum/Add_Levels d$iso3 <- factor(d$iso3, levels = c(levels(d$iso3), "")) d$iso3xgdp <- d$iso3 d$iso3xlex <- d$iso3 d$iso3xcm <- d$iso3 ## Kraje o niskich wartościach bez etykiet ## Bez etykiet jeżeli GDP<=45 tys oraz wskaźnik < 50: d$iso3xgdp[ (d$gdp2016 < 45000) & (d$deathsr < 50 ) ] <- "" ## Inne podobnie d$iso3xlex[ ( (d$lex2019 < 80) | (d$deathsr < 50 ) ) ] <- "" d$iso3xcm[ ((d$cm2017 > 1.2) | (d$deathsr < 50 ) ) ] <- "" ## GDP vs współczynnik zgonów/1mln rys1 <- ggplot(d, aes(x=gdp2016, y=deathsr)) + geom_point() + geom_text(data=d, aes(label=sprintf("%s", iso3xgdp), x=gdp2016, y= deathsr), vjust=-0.9, size=2 ) + xlab("GDP (USD, Constant prices)") + ylab("deaths/1mln") + geom_smooth(method="loess", se=F, size=2) + ggtitle("GDP2016CP vs COVID19 mortality", subtitle=sources) ## Life ex vs współczynnik zgonów/1mln rys2 <- ggplot(d, aes(x=lex2019, y=deathsr)) + geom_point() + geom_text(data=d, aes(label=sprintf("%s", iso3xlex), x=lex2019, y= deathsr), vjust=-0.9, size=2 ) + xlab("Life expentancy") + ylab("deaths/1mln") + geom_smooth(method="loess", se=F, size=2) + ggtitle("Life expentancy vs COVID19 mortality", subtitle=sources) ## Child mortality vs współczynnik zgonów/1mln rys3 <- ggplot(d, aes(x=cm2017, y=deathsr)) + geom_point() + geom_text(data=d, aes(label=sprintf("%s", iso3xcm), x=cm2017, y= deathsr), vjust=-0.9, size=2 ) + xlab("Child mortality %") + ylab("deaths/1mln") + geom_smooth(method="loess", se=F, size=2) + ggtitle("Child mortality vs COVID19 mortality", subtitle=sources) ## GDP vs Child mortality rys0 <- ggplot(d, aes(x=gdp2016, y=cm2017)) + geom_point() + xlab("GDP (USD, Constant prices)") + ylab("Child mortality") + geom_smooth(method="loess", se=F, size=2) + ggtitle("GDP2016CP vs Child mortality", subtitle=sources)
Jeszcze raz dla krajów Europejskich:
## Tylko kraje Europejskie: d <- d %>% filter (iso3 %in% ee) %>% as.data.frame d$iso3xgdp <- d$gdp2016 d$iso3xlex <- d$lex2019 d$iso3xcm <- d$cm2017 d$iso3xgdp[ d$iso3 %notin% ee.ee ] <- NA d$iso3xlex[ d$iso3 %notin% ee.ee ] <- NA d$iso3xcm[ d$iso3 %notin% ee.ee ] <- NA rys1ec <- ggplot(d, aes(x=gdp2016, y=casesr)) + geom_point() + geom_text(data=d, aes(label=sprintf("%s", iso3), x=gdp2016, y= casesr), vjust=-0.9, size=2 ) + geom_point(data=d, aes(x=iso3xgdp, y= casesr), size=2, color="red" ) + xlab("GDP (USD, Constant prices") + ylab("cases/1mln") + geom_smooth(method="loess", se=F, size=2) + ggtitle("GDP2016CP vs COVID19 cases (Europe)", subtitle=sources) ... itd...
Wynik w postaci rysunków:
Powyższe jest dostępne tutaj
Danych nt COVID19 jest multum bo są traktowane jako treść promocyjna, przyciągająca klikających. Każda tuba medialna (gazeta/portal/telewizja) w szczególności publikuje dane nt
Niestety z faktu, że danych nt COVID19 jest multum niewiele wynika, bo wszystkie są do dupy, w sensie że są wątpliwej jakości, tj. zwykle sposób w jaki są gromadzone nie jest opisany. Nie wiadomo kto jest klasyfikowany jako zarażony COVID19, nie wiadomo kto jest klasyfikowany jako zmarły w wyniku zarażenia COVID19. Można się domyślać że klasyfikowany jako zarażony COVID19 jest ten komu wykonany słynny test (w większości wypadków, podobno nie zawsze); zmarły w wyniku zarażenia COVID19 jest ten, któremu lekarz wypisał świadectwo zgonu ze stosownym wpisem.
Powyższe skutkuje: niemożnością oceny prawdziwej skali zjawiska (stąd teorie że rząd fałszuje) oraz niemożnością dokonania wiarygodnych porównań międzynarodowych.
Jeżeli chodzi o Polskę, to nikt nie prowadzi publicznego rejestru. Strona GIS to w ogóle kuriozalnie wygląda. Są komunikaty, jak ktoś ma czas to może jest sobie z nich dane wydłubywać i agregować. Na poziomie międzynarodowym są 2 źródła agregacji pierwotnej nazwijmy to: WHO oraz ECDC. Te dwa źródła agregują dane nadsyłane przez ciała krajowe, wg jakiejś niezdefiniowanej (przypuszczalnie ad hoc ustalanej) procedury. Inni korzystają z danych WHO/ECDC pośrednio lub bezpośrednio ewentualnie uzupełniając/modyfikując je w bliżej niezdefiniowany sposób. No i są jeszcze źródła specyficzne takie jak Google Community Mobility Reports.
WHO Situation Reports.
To nie jest baza danych, ale pliki PDF zawierające raporty w tym dane.
Pozyskanie z nich danych wymaga nietrywialnej konwersji.
www.who.int/emergencies/diseases/novel-coronavirus-2019/situation-reports
.
Dane z raportów dostępne są m.in. na stronie Wikipedii:
en.wikipedia.org/wiki/2019%E2%80%9320_coronavirus_pandemic_cases/WHO_situation_reports
oraz
en.wikipedia.org/wiki/Talk:2019%E2%80%9320_coronavirus_pandemic_cases/WHO_situation_reports
ECDC.europa.eu
Dane udostępniane w postacji codziennie aktualizowanego arkusza kalkulacyjnego.
www.ecdc.europa.eu/en/covid-19/data-collection
[Since the beginning of the coronavirus pandemic, ECDC's Epidemic
Intelligence team has been collecting the number of COVID-19 cases
and deaths, based on reports from health authorities worldwide.]
John Hopkins Univ/CSSE
github.com/CSSEGISandData/COVID-19
[To identify new cases, we monitor various twitter feeds, online
news services, and direct communication sent through the
dashboard. Before manually updating the dashboard, we confirm the
case numbers using regional and local health departments, namely the
China CDC (CCDC), Hong Kong Department of Health, Macau Government,
Taiwan CDC, European CDC (ECDC), the World Health Organization
(WHO), as well as city and state level health authorities.]
Worldometers
https://worldometers.info/coronavirus/
[nie wiadomo jak
zbierane, przypuszczalnie kopiowane z WHO/ECDC; Worldometers, to -- wydaje się -- inicjatywa PR-owa firmy
produkującej oprogramowanie]
OWiD czyli Our World in Data wykorzystuje bazę ECDC.
ourworldindata.org/coronavirus-source-data
[na podstawie ECDC]
Reasumując: jak ktoś potrzebuje gotowego zbioru danych, to ma do wyboru ECDC/OWiD/CSSE. Wszystkie są wątpliwe, ale lepszych nie ma a ci przynajmniej podają (ogólnikowo to fakt) jak te dane zbierają. Jak ktoś używa worldometers to pytanie czemu to robi... Jak posługuje się jeszcze innymi bardziej egoztycznymi danymi to szkoda tracić czasu na jego analizy (ew. sprawdzić czy nie są to dane ECDC/OWiD/CSSE tylko pod inną marką sprzedawane).
W Polsce nie ma oficjalnego rejestru. Przynajmniej ja nic nie wiem na temat.
To tak nawiasem mówiąc szejm. Że żaden
urząd, uniwersytet czy instytut nie udostępnia oficjalnych/wiarygodnych/kompletnych/łatwo dostępnych danych
(w Niemczech na przykład robi to słynny
RKI; a we Francji
nie mniej słynny pasteur.fr). W PL zaś każdy się stara i coś tam udostępnia,
z naciskiem na coś...
Znalazłem rejestr nieopisany (w sensie jak/skąd są nim gromadzone dane)
prowadzony przez dziennik z grupy PolskaPress.
dziennikzachodni.carto.com/tables/zachorowania_na_koronawirusa_w_polsce_marzec/public
Google Community Mobility Reports
To nie jest baza danych, ale zbiór raportów w formacie PDF.
www.google.com/covid19/mobility/
.
[Google has launched a new website that uses
anonymous location data collected from users of Google products and
services to show the level of social distancing taking place in
various locations. The COVID-19 Community Mobility Reports web site
will show population data trends of six categories: Retail and
recreation, grocery and pharmacy, parks, transit stations, workplaces,
and residential. The data will track changes over the course of
several weeks, and as recent as 48-to-72 hours prior, and will
initially cover 131 countries as well as individual counties within
certain states.]
Ciekawostka raczej, bo w szczególności, nie do końca wiadomo
co te procenty Gógla oznaczają, np. -60% względem baseline. Anie nie wiadomo
co to jest ten baseline (średnia?) ani jak liczony jest ruch...
Nie mniej wydłubałem te procenty z raportów dla krajów OECD i zamieniłem na plik w formacie CSV. Jest on do pobrania tutaj.
Dane dotyczące USA. Oczywiście są częścią WHO/ECDC/CSSE. Ale są także bardziej szczegółowe:
CDC
[The provisional counts for coronavirus disease (COVID-19) deaths are
based on a current flow of mortality data in the National Vital
Statistics System.]
https://www.cdc.gov/nchs/nvss/vsrr/COVID19/index.htm
NewYork Times
[The data is the product of dozens of journalists working across
several time zones to monitor news conferences, analyze data releases
and seek clarification from public officials on how they categorize
cases.]
https://github.com/nytimes/covid-19-data
oraz
https://www.nytimes.com/interactive/2020/us/coronavirus-us-cases.html
No i jeszcze są pewnie jakieś chińskie dane, ale to trzeba znać chiński.
Financial Times zamieścił wykres wględnego tempa wzrostu (rate of growth) czyli procentu liczonego jako liczba-nowych / liczba-ogółem-z-okresu-poprzedniego x 100%. Na wykresie wględnego tempa wzrostu zachorowań na COVID19 wszystkim spada: Every day the Covid-19 virus is infecting an increasing number of people, but the rate of growth in cases in some of the worst-hit countries is starting to slow. Powyższe Czerscy przetłumaczyli jako m.in. trend dotyczy niemal wszystkich krajów rozwiniętych. [he, he... Rozwiniętych pod względem liczby chorych, pewnie chcieli uściślić, ale się nie zmieściło]
Spróbowałem narysować taki wykres samodzielnie:
library("dplyr") library("ggplot2") library("ggpubr") ## surl <- "https://www.ecdc.europa.eu/en/publications-data/download-todays-data-geographic-distribution-covid-19-cases-worldwide" today <- Sys.Date() tt<- format(today, "%d/%m/%Y") #d <- read.csv("covid19_C.csv", sep = ';', header=T, na.string="NA", stringsAsFactors=FALSE); d <- read.csv("covid19_C.csv", sep = ';', header=T, na.string="NA", colClasses = c('factor', 'factor', 'factor', 'character', 'character', 'numeric', 'numeric')); d$newc <- as.numeric(d$newc) d$newd <- as.numeric(d$newd)
Zwykłe read_csv
skutkowało tym, że newc/newd
nie były liczbami całkowitymi, tylko
czynnikami. Z kolei dodanie colClasses kończyło się błędem. W końcu stanęło na tym, że czytam
dane w kolumnach newc/newd zadeklarowanych jako napisy a potem konwertuję na liczby. Czy to jest
prawidłowa strategia to ja nie wiem...
Kolejny problem: kolumny newc/newd zawierają NA, wykorzystywana
później funkcja cumsum
z pakietu dplyr
,
obliczająca szereg kumulowany nie działa poprawnie jeżeli szereg
zawiera NA
. Zamieniam od razu NA
na zero.
Alternatywnie można korzystać
z funkcji replace_na
(pakiet dplyr):
# change NA to 0 d[is.na(d)] = 0 # Alternatywnie replace_na #d %>% replace_na(list(newc = 0, newd=0)) %>% # mutate( cc = cumsum(newc), dd=cumsum(newd))
Ograniczam się tylko do danych dla wybranych krajów, nie starszych niż 16 luty 2020:
d <- d %>% filter(as.Date(date, format="%Y-%m-%d") > "2020-02-15") %>% as.data.frame str(d) last.obs <- last(d$date) c1 <- c('IT', 'DE', 'ES', 'UK', 'FR') d1 <- d %>% filter (id %in% c1) %>% as.data.frame str(d1)
Obliczam wartości skumulowane (d
zawiera już skumulowane wartości,
ale obliczone Perlem tak nawiasem mówiąc):
t1 <- d1 %>% group_by(id) %>% summarise(cc = sum(newc, na.rm=T), dd=sum(newd, na.rm=T)) t1c <- d %>% group_by(id) %>% mutate(cum_cc = cumsum(newc), cum_dd = cumsum(newd)) %>% filter (id %in% c1) %>% filter(as.Date(date, format="%Y-%m-%d") > "2020-02-15") %>% as.data.frame str(t1c)
Wykres wartości skumulowanych:
pc1c <- ggplot(t1c, aes(x= as.Date(date, format="%Y-%m-%d"), y=cum_cc)) + geom_line(aes(group = id, color = id), size=.8) + xlab(label="") + theme(plot.subtitle=element_text(size=8, hjust=0, color="black")) + ggtitle(sprintf("COVID19: total confirmed cases (%s)", last.obs), subtitle=sprintf("%s", surl)) ggsave(plot=pc1c, "Covid19_1c.png", width=15)
Kolumny cum_lcc/cum_ldd
zawierają wartości z kolumny cum_cc/cum_dd
ale opóźnione o jeden okres (funkcja lag
):
## t1c <- t1c %>% group_by(id) %>% mutate(cum_lcc = lag(cum_cc)) %>% as.data.frame t1c <- t1c %>% group_by(id) %>% mutate(cum_ldd = lag(cum_dd)) %>% as.data.frame t1c$gr_cc <- t1c$newc / (t1c$cum_lcc + 0.01) * 100 t1c$gr_dd <- t1c$newd / (t1c$cum_ldd + 0.01) * 100 ## Początkowo wartości mogą być ogromne zatem ## zamień na NA jeżeli gr_cc/dd > 90 t1c$gr_cc[ (t1c$gr_cc > 90) ] <- NA t1c$gr_dd[ (t1c$gr_dd > 90) ] <- NA
Wykres tempa wzrostu:
pc1c_gr <- ggplot(t1c, aes(x= as.Date(date, format="%Y-%m-%d"), y=gr_cc, colour = id, group=id )) + ##geom_line(aes(group = id, color = id), size=.8) + geom_smooth(method = "loess", se=FALSE) + xlab(label="") + theme(plot.subtitle=element_text(size=8, hjust=0, color="black")) + ggtitle(sprintf("COVID19: confirmed cases growth rate (smoothed)"), subtitle=sprintf("%s", surl)) ggsave(plot=pc1c_gr, "Covid19_1g.png", width=15)
To samo co wyżej tylko dla PL/CZ/SK/HU:
c2 <- c('PL', 'CZ', 'SK', 'HU') t2c <- d %>% group_by(id) %>% mutate(cum_cc = cumsum(newc), cum_dd = cumsum(newd)) %>% filter (id %in% c2) %>% filter(as.Date(date, format="%Y-%m-%d") > "2020-02-15") %>% as.data.frame ##str(t2c) t2c.PL <- t2c %>% filter (id == "PL") %>% as.data.frame t2c.PL head(t2c.PL, n=200) pc2c <- ggplot(t2c, aes(x= as.Date(date, format="%Y-%m-%d"), y=cum_cc)) + geom_line(aes(group = id, color = id), size=.8) + xlab(label="") + theme(plot.subtitle=element_text(size=8, hjust=0, color="black")) + ggtitle(sprintf("COVID19: total confirmed cases (%s)", last.obs), subtitle=sprintf("Total: %s\n%s", lab1c, surl)) ggsave(plot=pc2c, "Covid19_2c.png", width=15) t2c <- t2c %>% group_by(id) %>% mutate(cum_lcc = lag(cum_cc)) %>% as.data.frame t2c <- t2c %>% group_by(id) %>% mutate(cum_ldd = lag(cum_dd)) %>% as.data.frame t2c$gr_cc <- t2c$newc / (t2c$cum_lcc + 0.01) * 100 t2c$gr_dd <- t2c$newd / (t2c$cum_ldd + 0.01) * 100 ## zamień na NA jeżeli gr_cc/dd > 90 t2c$gr_cc[ (t2c$gr_cc > 90) ] <- NA t2c$gr_dd[ (t2c$gr_dd > 90) ] <- NA t2c.PL <- t2c %>% filter (id == "PL") %>% as.data.frame t2c.PL pc2c_gr <- ggplot(t2c, aes(x= as.Date(date, format="%Y-%m-%d"), y=gr_cc, colour = id, group=id )) + ##geom_line(aes(group = id, color = id), size=.8) + geom_smooth(method = "loess", se=FALSE) + xlab(label="") + theme(plot.subtitle=element_text(size=8, hjust=0, color="black")) + ggtitle(sprintf("COVID19: confirmed cases growth rate (smoothed)"), subtitle=sprintf("%s", surl)) ggsave(plot=pc2c_gr, "Covid19_2g.png", width=15)
Koniec
Dane pierwotne: Center for Systems Science and
Engineering (CSSE/Johns Hopkins University)
https://github.com/CSSEGISandData/COVID-19
(także słynna
wizualizacja:
https://gisanddata.maps.arcgis.com/apps/opsdashboard/index.html#/bda7594740fd40299423467b48e9ecf6
.)
European Centre for Disease Prevention and Control
https://ecdc.europa.eu/en/geographical-distribution-2019-ncov-cases
.
Dane agregowane od innych: Our World in
Data/Coronavirus Source Data/WHO Situation Reports
https://ourworldindata.org/coronavirus-source-data
.
Są też tzw. dane w czasie rzeczywistym:
https://worldometers.info/coronavirus/
, ale ich
wiarygodność jest podejrzana, bo w przeciwieństwie do tych wyżej
opisanych nie wiadomo jak są zbierane i/lub
skąd agregowane (więc nie ma klikalnego linku).
Na stronie
https://ourworldindata.org/coronavirus-source-data
są dane nt liczby przypadków/zgonów z powodu zarażenia wirusem covid19, których źródłem
są 'Raporty Sytuacyjne WHO'
(https://www.who.int/emergencies/diseases/novel-coronavirus-2019/situation-reports/
).
Raporty są w formacie PDF więc bezpośrednio nie można korzystać
z publikowanych tam danych.
No ale uprzejmi ludzie z ourworldindata.org
już te raporty zamienili na csv i są one gotowe do pobrania:
wget -N https://covid.ourworldindata.org/data/full_data.csv
Za pomocą prostych skryptów Perla modyfikuję plik full_data.csv
tak, żeby
poszczególne kolumny zawierały:
date;id;country;newc;newd;totalc;totald
(data, ISO-kod
kraju, nazwa-kraju, nowe-przypadki, nowe-zgony, wszystkie-przypadki,
wszystkie-zgony)
Dla wybranych krajów rysują wykresy liniowe (wykorzystując R):
library("dplyr") library("ggplot2") library("ggpubr") ## today <- Sys.Date() tt<- format(today, "%d/%m/%Y") d <- read.csv("covid19.csv", sep = ';', header=T, na.string="NA"); d <- d %>% filter(as.Date(date, format="%Y-%m-%d") > "2020-02-15") %>% as.data.frame ## c1 <- c('ITw', 'DEw', 'ESw', 'UKw', 'FRw', 'DKw', 'SEw') # date;id;country;newc;newd;totalc;totald d1 <- d %>% filter (id %in% c1) %>% as.data.frame t1 <- d1 %>% group_by(id) %>% summarise(cc = sum(newc, na.rm=T), dd=sum(newd, na.rm=T)) lab1c <- toString(paste (sep=" = ", t1$id, t1$cc)) lab1d <- toString(paste (sep=" = ", t1$id, t1$dd)) str(d1) pc1 <- ggplot(d1, aes(x= as.Date(date, format="%Y-%m-%d"), y=newc)) + geom_line(aes(group = id, color = id), size=.8) + xlab(label="") + theme(plot.subtitle=element_text(size=8, hjust=0, color="black")) + ggtitle(sprintf("COVID19: new confirmed cases (%s)", tt), subtitle=sprintf("Total: %s\n%s", lab1c, surl)) pd1 <- ggplot(d1, aes(x= as.Date(date, format="%Y-%m-%d"), y=newd)) + geom_line(aes(group = id, color = id), size=.8) + xlab(label="") + theme(plot.subtitle=element_text(size=8, hjust=0, color="black")) + ggtitle(sprintf ("COVID19: deaths (%s)", tt), subtitle=sprintf("Total: %s\n%s", lab1d, surl)) c2 <- c('PLw', 'CZw', 'SKw', 'HUw', 'ROw', 'BGw', 'ELw') d2 <- d %>% filter (id %in% c2) %>% as.data.frame t2 <- d2 %>% group_by(id) %>% summarise(cc = sum(newc, na.rm=T), dd=sum(newd, na.rm=T)) str(d2) lab2c <- toString(paste (sep=" = ", t2$id, t2$cc)) lab2d <- toString(paste (sep=" = ", t2$id, t2$dd)) pc2 <- ggplot(d2, aes(x= as.Date(date, format="%Y-%m-%d"), y=newc)) + geom_line(aes(group = id, color = id), size=.8) + theme(plot.subtitle=element_text(size=8, hjust=0, color="black")) + xlab(label="") + ggtitle(sprintf("COVID19: new confirmed cases (%s)", tt), subtitle=sprintf("Total: %s\n%s", lab2c, surl)) pd2 <- ggplot(d2, aes(x= as.Date(date, format="%Y-%m-%d"), y=newd)) + geom_line(aes(group = id, color = id), size=.8) + theme(plot.subtitle=element_text(size=8, hjust=0, color="black")) + xlab(label="") + scale_y_continuous(breaks=c(1,2,3,4,5,6,7,8,9)) + ggtitle(sprintf ("COVID19: deaths (%s)", tt), subtitle=sprintf("Total: %s\n%s", lab2d, surl)) p1 <- ggarrange(pc1,pd1, ncol=2, nrow=1) p2 <- ggarrange(pc2,pd2, ncol=2, nrow=1) ggsave(plot=p1, "Covid19_1w.png", width=15) ggsave(plot=p2, "Covid19_2w.png", width=15)
Zatem: Liczba przypadków/zgonów z powodu zarażenia wirusem covid19 na podstawie danych ourworldindata.org/WHO:
UE, która jest powszechnie krytykowana, że nic nie robi w sprawie, okazuje się że coś tobi -- też udostępnia jakieś dane w temacie (https://www.ecdc.europa.eu/en/publications-data/download-todays-data-geographic-distribution-covid-19-cases-worldwide). Wprawdzie nie jest określone skąd te dane pochodzą, ale sądząc po ich zawartości źródło jest to samo (WHO).
wget -N https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-2020-03-15.xls\ -O covid19.csv
Ponieważ dane, że tak powiem, unijne są w formacie xls
zamieniam
je na csv
, wykorzystując
do tego LibreOffice:
## zamień wszystkie pliki z bieżącego katalogu na csv ze ; (59) jako znakiem separacji: soffice --convert-to csv:"Text - txt - csv (StarCalc)":59,,0,1,1 --outdir . *.xls
Rysuję wykresy liniowe zmodyfikowanym z dokładnością do pliku z danymi R-skryptem. Wyniki są prawie takie same. Może bym nawet nie zwrócił uwagi, że się różnią gdyby nie podejrzane załamanie liczby przypadków dla Włoch dla 15.03.2020 (z 2,5 tys na 90).
Drążąc temat wyrysowałem wykresy dla wybranych czterech krajów w dwóch wariantach danych
(dane z ourworldindata.org oznaczone literką w
). W szczególności i niestety
Włochy 15/3/2020 odnotowały ponad 3497 nowych przypadków
a nie 90 jak podano w bazie Unijnej. Są też mniejsze różnice w innych miejscach:
Wszystko to robione jest automatem co pobiera/zamienia/rysuje/wstawia na githuba
(https://github.com/hrpunio/Nafisa/tree/master/Covid19
)
oraz wysyła na twittera (https://twitter.com/tprzechlewski
). Automat działa
na RaspberryPi zresztą...