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:

• GDP (https://ourworldindata.org/economic-growth maddison-data-gdp-per-capita-in-2011us.csv)
• LE (https://ourworldindata.org/life-expectancy life-expectancy.csv)
• CM (https://ourworldindata.org/child-mortality child-mortality-igme.csv).

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ą...