Nous utilisons ici les données sur la situation hospitalières concernant l’épidémie de COVID-19 provenant du site de Santé publique France et téléchargeables ici https://www.data.gouv.fr/fr/datasets/donnees-hospitalieres-relatives-a-lepidemie-de-covid-19/. Parmi toutes les données proposées, nous avons décidé de n’utiliser que les données hospitalières disponibles par département.
Pour cet essai, le jeu de données est en date du 2020-05-27. Nous avons utilisé R et les librairies suivantes (déplier le premier bouton pour afficher le code)
library(dplyr)
library(ggplot2)
library(readxl)
library(ggrepel)
library(plotly)
library(ggthemes)
library(directlabels)theme_black<- function (base_size = 11, base_family = ""){
theme_minimal() %+replace%
theme(
# line = element_line(colour = "white", size = 0.5, linetype = 1,
# lineend = "butt"),
# rect = element_rect(fill = "white",
# colour = "white", size = 0.5, linetype = 1),
legend.position="none",
text = element_text(family = base_family,
face = "plain", colour = "grey50", size = base_size,
#angle = 0, lineheight = 0.9,
hjust = 0, vjust = 0),
plot.background = element_rect(colour = 'black', fill = 'black'),
plot.title = element_text(size = rel(1.1)),
#panel.border = element_rect(fill = NA, colour = "white"),
panel.grid.major = element_line(colour = "black", size = 0.2),
panel.grid.minor = element_line(colour = "grey30", size = 0.5)
#strip.background = element_rect(fill = "grey30", colour = "grey30")
)
}
theme_black_grid<- function (base_size = 11, base_family = ""){
theme_black() %+replace%
theme(
text = element_text(family = base_family,
face = "plain", colour = "grey10", size = base_size,
angle = 0, lineheight = 0.9, hjust = 0, vjust = 0),
panel.grid.minor = element_line(colour = "black", size = 0.5)
)
}Nous pensons que seules les données concernant les décès , le nombre de personnes en réanimation sont pertinentes pour l’analyse. En effet, les données relatives aux tests de dépistage de COVID-19 réalisés en laboratoire de ville, donnant une approximation du nombre de cas peuvent dépendre de la situation particulière de chaque département ou ville. En outre, les données des urgences hospitalières et de SOS médecins relatives à l’épidémie de COVID-19 ne nous semblent pas pertinentes car mélangeant diverses causes d’accès à l’hôpital. Il a également été montré que les données des décès dans les EHPAD n’ont pas été renseignées correctement au cours de l’épidémie.
Les données hospitalières comportent recensées, jour par jour et pour chaque département les variables suivantes :
Cette dernière variable n’étant disponible qu’en cumul, nous calculerons le nombre de décès par jour en effectuant une soustraction: \[Nb\; décès\; jour_J = cumul\; jour_j - cumul\; jour_{j-1} \]
Nous décidons de nous concentrer sur les deux variables les plus pertinentes à nos yeux:
# Data on Covid-19 are from
# https://www.data.gouv.fr/fr/datasets/donnees-hospitalieres-relatives-a-lepidemie-de-covid-19/
# https://www.data.gouv.fr/fr/datasets/r/41b9bd2a-b5b6-4271-8878-e45a8902ef00
covid.raw <- read.csv(paste0("Data/donnees-hospitalieres-covid19-",DataDate,"-19h00.csv"), header = TRUE, sep = ";")
# Adding elements on departments and regions from https://www.insee.fr/fr/information/3363419
dep.raw <- read.csv("Data/depts2018.txt", header = TRUE, sep="\t")
regions.raw <- read.csv("Data/reg2018-CB.txt", header = TRUE, sep="\t")
# Population par departement https://www.insee.fr/fr/statistiques/1893198 (Slighlty editied to remove the header !!)
pop.raw <- read_excel("Data/estim-pop-dep-sexe-aq-1975-2020-CB.xls" , sheet = "2020")
dep.info <- merge(dep.raw, pop.raw, by.x = "DEP", by.y = "Num" )
dep.info <- merge(dep.info, regions.raw, by.x = "REGION", by.y = "REGION" )
dep.light <- dep.info %>%
select("DEP", "Nom", "REGION", "NCCENR.y", "Total...23") %>%
rename( NomDep = Nom,
NomRegion = NCCENR.y ,
PopDep = Total...23 )
### Now merge with for the Covid data
covid.data <- merge(covid.raw, dep.light, by.x = "dep", by.y = "DEP")
# Test on one department ...
dep.test <- 68 #68
data.test <- covid.data %>%
filter(dep == dep.test & sexe == 0) %>%
mutate(NumJour = as.numeric(jour) )%>%
arrange(NumJour) %>%
rename(NbRea = rea)%>%
mutate(NbDeath = dc - lag(dc, default = 0),
ReturnJ = rad - lag(rad, default = 0),
HospOnlyJ = hosp - NbRea - ReturnJ - NbDeath
)
covid.dep <- covid.data %>%
filter( sexe == 0) %>%
mutate(NumJour = as.numeric(jour) )%>%
rename(NbRea = rea)%>%
group_by(dep) %>%
arrange(NumJour) %>%
mutate(NbDeath = dc - lag(dc, default = 0),
ReturnJ = rad - lag(rad, default = 0),
HospOnlyJ = hosp - NbRea - ReturnJ - NbDeath) %>%
arrange(dep, NumJour)
# if we work on a few... c( 54,57, 67, 68 , 75)
data.dep5 <- covid.dep %>%
filter(dep %in% c( 10, 67, 68, 51, 52) ) %>%
arrange(dep, NumJour)
names(data.dep5$NomDep) = "Dept"J’aime bien regarder des choses simples pour explorer les données. Ici, on visualise le nombre de personnes en réanimation au cours du temps sur 5 départements.
Comme il fallait s’y attendre, nous constatons que certaines données sont entachées d’erreurs (ici un nombre de décès négatif dans le Bas-Rhin). Il faudra sûrement soit corriger, soit lisser ces données afin que les erreurs n’influencent pas la tendance générale de la représentation
D’autres problèmes apparaissent lorsqu’on cherche à relier ces points ce qui est une erreur puisque la dimension temps est manquante dans cette analyse. On constate toutefois l’extrême variabilité des données reportées au jour le jour sur ce graphique des 20 premiers jours. .
Un petit travail sur les données nous permet d’agréger les informations au niveau régional et de récupérer des informations sur la population de chaque région. Nous décidons d’exclure les DOM et la corse de notre analyse pour ne pas avoir trop de région avec trop peu de cas.
# we take only Metropole (not DOM)
covid.reg <- covid.dep %>%
filter(REGION >10 & REGION != 94) %>% # keep IDF (11) and suppress DOM
group_by( jour, REGION) %>%
summarise_at(vars(hosp, NbRea, NbDeath, ReturnJ, HospOnlyJ, PopDep), funs(sum)) %>%
rename(pop = PopDep
) %>%
arrange(REGION,jour)
#Recalling region names
covid.reg <- merge(covid.reg, regions.raw, by= "REGION") %>%
select(-c(CHEFLIEU,TNCC, NCC )) %>%
rename(NomReg = NCCENR)
# Adding duration
covid.reg <- covid.reg %>%
mutate(
lag = abs(as.numeric(difftime("2020-01-01", covid.reg$jour, units = "days"))),
rel.lag = 100 *(lag- min(lag))/(max(lag)-min(lag))
# NomReg = replace(NomReg, REGION =="93", "PACA")
# NomReg = ifelse(REGION == 93, "PACA", NomReg )
)
# Adding rates
covid.reg <- covid.reg %>%
mutate(
NbRea.tx = 1000000 * (NbRea/pop),
NbDeath.tx = 1000000 * (NbDeath/pop),
HospOnlyJ.tx = 1000000 * (HospOnlyJ/pop)
)
# adding smoothed values
library(zoo)
covid.reg <- covid.reg %>%
group_by(REGION) %>%
mutate(
NbRea.tx.5d = rollapply(NbRea.tx, 5 ,mean,align='right',fill=NA),
NbDeath.tx.5d = rollapply(NbDeath.tx, 5 ,mean,align='right',fill=NA)
)Nous reviendrons plus tard sur l’aspect dynamique de l’évolution conjointe du nombre de réanimations et de décès et changeons complètement d’optique:
covid.reg.agg <- covid.reg %>%
group_by(REGION) %>%
mutate(
NbDeath.tot = sum(NbDeath),
NbRea.tot = sum(NbRea),
NbRea.tot.tx = 1000000*NbRea.tot/pop,
NbDeath.tot.tx = 1000000*NbDeath.tot/pop,
ratio = round(ifelse(NbDeath.tot>0, NbRea.tot/NbDeath.tot ,NA), 1)
) %>%
select(REGION, NomReg, NbRea.tot, NbDeath.tot, ratio, pop,
NbDeath.tot.tx, NbRea.tot.tx) %>%
top_n(n = 1, wt = REGION)
covid.reg.agg <- distinct(covid.reg.agg)Sur le graphique suivant sont représentées des droites liant l’origine des axes et le point (Taux de réanimation par Million d’hab., Taux de décès par Million d’hab.) pour chaque région. La longueur de ces segments montre l’impact global du COVID-19 subi en nombre de décès ET en nombre de réanimations par Million d’habitants. En outre, la relation entre ces deux variables montre le taux relatif de décès par rapport aux nombre de réanimations.
Si ce taux était le même pour toutes les régions, alors les droites auraient toutes le même angle
En outre, la position de ce point permet de classer :
p<- ggplot(covid.reg.agg,
aes(x = NbRea.tot.tx, y = NbDeath.tot.tx,
group = NomReg, col = NomReg, label = NomReg)) +
geom_segment(aes(y = 0, x = 0, yend = NbDeath.tot.tx, xend = NbRea.tot.tx),
size = 1.1, lineend = "round", alpha = 0.3) +
geom_point() +
labs(title = "Tx de décès / Tx de réanimation par Million d'hab",
subtitle = paste("\nPlus la droite est verticale, plus le taux Décès/réanimation est fort \nPlus la droite est longue, plus il y a de Décès ET de réanimations"),
caption = paste("Données data.gouv.fr au ",DataDate),
y = "Décès pour 1M d'hab",
x = "Réanimations pour 1M d'hab") +
scale_size_identity(trans = "sqrt") +
#scale_colour_discrete() +
theme_tufte() +
theme_black()+
theme(legend.position="none")
p +
geom_dl(aes(x = NbRea.tot.tx, y = NbDeath.tot.tx, label = NomReg),
method = list(dl.trans(y = y+ 0.1 , x = x - 2 ), "last.bumpup", cex = 0.60)) Nous pouvons voir que :
#version interactive pas terrible du tout...
ggplotly(p, tooltip = c("NomReg", "pop","NbDeath.tot.tx", "NbRea.tot.tx", "ratio"))L’analyse en small multiple région par région confirme cette impression visuelle.
Maintenant que l’analyse globale est faite, penchons nous de nouveau sur la représentation temporelle de l’évolution jointe des réanimations et des décès.
Nos régions étant plus ou moins peuplées, toute représentation en valeur du Nombre de décès et du nombre de réanimation ne va pas permettre de comparr grange chose. Les grandes régions imposeront l’échelle du graphique et les petites régiosn en seront pas visible. Exempel ci-dessous.
On constate que l’on a bien une boule de poil pour les “petites” régions. La version interactive de ce graphique n’apportant pas grand chose…
Tout comme pour la version statique des nombres cumulés, nous pouvons essayer de représenter les condition journalières des hôpitaux vis-à-vis des personnes en réanimation et de celles décédées. Nous avons réalisé cela en suivant reliant le nombre de réanimations et de décès au cours du temps. On obtient ainsi une circulation orientée par l’intensité du phénomène pour chaque région. Pour ces graphiques, nous avons également opté pour un lissage sur 5 jours des observations.
Beaucoup de possibilités restent à explorer sur ces données. Nous n’avons utilisé ici que deux variables dont les relations nous intéressaient spécialement tant elles nous semblaient reliées. le nombre de décès et le nombre de personnes en réanimation. Il est certain que des effets retard existent entre ces variables.
Parfois la simplicité l’emporte.
En utilisant des graphiques très simples, nous avons mis en avant l’intensité de la crise pour nos régions et en révélons l’hétérogénéité. Nous avons également exploré la possibilité de visualiser l’interdépendance décès / réanimations au cours du temps en montrant à la fois la différence d’intensité (Ile de France et Grand-Est vs les autres régions) et des structures différentes. Ceci révèle que les réanimations et les décès n’ont pas évolué de la même façon dans les différentes régions étudiées. Le graphique montrant les Taux de décès / Taux de réanimation (le seul sur fond noir) en est une illustration. Certains patterns se dessinent mais il faudra plus de temps pour les exploiter finement.
Comment introduire la dimension temporelle ?
Nous décidons de changer radicalement la représentation graphique en reliant les points chronologiquement (en utilisant un lineplot comme expliqué par Yan Holtz ici https://www.r-graph-gallery.com/connected_scatterplot_ggplot2.html )
Une conclusion partielle, est que :