Compte rendu projet RDSM
Formatage des données.
Compte tenu du nombre important des départements en France, Pour mieux visualiser et analyser les données, nous avons décidé de réunir la corse du sud et la corse du nord. Par conséquent, le département 20 represente ainsi toute la corse.
Nous avons également jugé important de scinder les données en deux categories:
Selon la classe d’âge: afin d’analyser l’évolution par semaine de l’épidemie dans les différentes classes d’âge. Le facteur âge est évidemment non négligéable car la pluspart des publications scientifiques soulignent la relation entre l’âge et les conséquences liées à cette maladie.
Selon les départements: Il est indispensable de comparer les départements entre eux car le facteur géographique dans la propagation de l’épidemie est à priori non négligéable. Egalement du fait que les mesures sont prises parfois localement. Cela nous permettra d’analyser l’évolution sur le plan géographique de l’épidemie au cours des différentes semaines.
Transformation de la variable semaine en variable numérique:
data <- read.csv2('covid.csv', sep = ',')
liste_dep <- read.csv2('liste_dep.csv',sep=',',encoding='UTF-8')
week_int = c(NULL)
incidence = c(NULL)
table_dep = data.frame(cbind(1:103))
colnames(table_dep)[1] = 'Dep'
num_dep = unique(data$dep)
table_dep = add_column(table_dep, d = num_dep)
colnames(table_dep)[2] = 'Num_dep'
pop_dep = c(NULL)
data$pop <- as.integer(data$pop)
for (k in 1:length(data$week)) {
semaine = strsplit(data$week[k], 'S')[[1]][2]
week_int[k] = as.numeric(semaine)
incidence[k] = (as.numeric(data$P[k]) / as.numeric(data$pop[k])) * 100000
if (data$cl_age90[k] == 0 && week_int[k] == 21) {
pop_dep[data$dep[k]] = as.numeric(data$pop[k])
}
}Calcul des statistiques générales par département:
dep_P = sqldf('SELECT sum(P) as P FROM data GROUP BY dep;')
table_dep = add_column(table_dep, d = (dep_P))
data = add_column(data, d = week_int, .after = "week")
colnames(data)[3] = 'week_int'
data = add_column(data, d = incidence, .after = "P")
colnames(data)[6] = 'Taux_incidence'
pop_dep = data.frame(pop_dep)
pop_dep = subset(pop_dep,!is.na(pop_dep))
table_dep = add_column(table_dep, d = pop_dep)
colnames(table_dep)[4] = 'Pop'
colnames(table_dep)[3] = 'P'Comme annoncé précedemment nous allons calculé les différentes données par semaine par classe d’âge.
table_age = sqldf(
'SELECT cl_age90,sum(P) as P,sum(pop)/(max(week_int)-min(week_int)+1) as Pop FROM data GROUP BY cl_age90;'
)
table_week_classe = sqldf('SELECT DISTINCT week_int FROM data')
col_incidence_classe = c(1:length(table_week_classe$week_int))
col_incidence_classe = data.frame(col_incidence_classe)
for (i in table_age$cl_age90) {
a = paste('SELECT Pop FROM table_age WHERE cl_age90=', i, ';')
pop = sqldf(a)
for (k in table_week_classe$week_int) {
b = paste('SELECT sum(P) as P FROM data WHERE week_int=',
k,
'AND cl_age90=',
i,
';')
sum_p = sqldf(b)
incidence_week = (sum_p$P / pop$Pop) * 100000
col_incidence_classe$col_incidence_classe[k - 20] = incidence_week
}
table_week_classe = add_column(table_week_classe, d = col_incidence_classe$col_incidence_classe)
}
colnames(table_week_classe) = c(
'week_int',
'classe_0',
'classe_9',
'classe_19',
'classe_29',
'classe_39',
'classe_49',
'classe_59',
'classe_69',
'classe_79',
'classe_89',
'classe_90'
)Nous allons également calculé les différentes données par semaine par département.
table_week_dep = sqldf('SELECT DISTINCT week_int FROM data')
col_incidence_dep = c(1:length(table_week_classe$week_int))
col_incidence_dep = data.frame(col_incidence_dep)Lors de la création de la table des différentes valeurs par semaine par département. Nous avons obtenu un objet qui nous paraît difficile à manipuler donc nous allons formaté cette table dans une nouvelle table plus simple.
table_super_dep = data.frame(matrix(nrow = nrow(table_dep), ncol = ncol(table_dep)))
for (i in 1:ncol(table_super_dep)) {
for (j in 1:nrow(table_super_dep))
table_super_dep[j, i] = table_dep[j, i]
}
colnames(table_super_dep) = c('Dep', 'Num_dep', 'P', 'Pop')
for (i in table_dep$Num_dep) {
a = paste('SELECT Pop FROM table_super_dep WHERE Num_dep=', i, ';')
pop_dep = sqldf(a)
for (k in table_week_classe$week_int) {
b = paste('SELECT sum(P) as P FROM data WHERE week_int=',
k,
'AND dep=',
i,
';')
sum_dep_p = sqldf(b)
incidence_week = (sum_dep_p$P / pop_dep$Pop) * 100000
col_incidence_dep$col_incidence_dep[k - 20] = incidence_week
}
table_week_dep = add_column(table_week_dep, d = col_incidence_dep)
}
#Noms colonnes table_week_dep
k = 2
for (i in table_super_dep$Num_dep) {
colnames(table_week_dep)[k] = paste("Dep_", i)
k = k + 1
}Voici les nouvelles données:
- Données de base
paged_table(data)- Données par classe:
paged_table(table_week_classe)Données par département:
paged_table(table_super_dep)Répresentations et interprétations des graphiques.
Heatmap du taux d’incidence avec les données sur les classes d’âge:
table_week_classe_melted = melt(as.data.table(table_week_classe), id = 'week_int')
colnames(table_week_classe_melted)[2] = 'Classe'
colnames(table_week_classe_melted)[3] = 'Taux_incidence'
ggplot(table_week_classe_melted,
aes(factor(week_int), Classe, fill = Taux_incidence)) +
geom_tile() +
scale_fill_gradient(low = '#001CBD', high = '#E70000') +
geom_text(aes(label = round(Taux_incidence, 1)), color = 'white') +
labs(x = "Numero de semaine(2020)", y = "Classe d'age", title = "Evolution du taux d'incidence par classe d'age") +
theme_light()
Interpretation:
Cette repartition de couleur globalement de manière non homogène dans différentes classes d’âge, montre que l’évolution de l’épidemie selon les classes d’âge n’est pas monotone.
Toutefois l’on remarque une situation un peu plus critique chez les moins de 29 ans dans les dernières semaines.
Et de manière générale chez les individus entre 19 et 50 ans malgré le fait que les moins de 29 ans se demarquent.
Il est nécessaire de souligner le fait que la situation concernant les moins de 9 ans est relativement très bien.
Ce qui laisse envisager grossièrement que la classe d’âge la plus critique se situerait entre 10 et 29 ans.
En fin la classe 0 ne fait que s’enpirer, ce qui est plustôt logique du fait que le nombre des cas positifs en France ne fait qu’augmenter au cours des dernières semaines.
Heatmap du taux d’incidence avec les données sur les départements:
table_week_dep_melted = melt(as.data.table(table_week_dep), id = 'week_int')
colnames(table_week_dep_melted)[2] = 'Dep'
colnames(table_week_dep_melted)[3] = 'Taux_incidence'
heatmap_table_week_dep = ggplot(table_week_dep_melted, aes(factor(week_int), Dep, fill =
Taux_incidence)) +
geom_tile() +
scale_fill_gradient(low = '#001CBD', high = '#E70000') +
geom_text(aes(label = round(Taux_incidence, 1)), color = 'white') +
labs(x = "Numero de semaine(2020)", y = "département", title = "Evolution du taux d'incidence par département") +
theme_light()
heatmap_table_week_dep
Interpretation:
D’après ce heatmap des départements, on se rend compte que la situation dans les départements s’enpire avec le temps. Sauf quelques départements font exception.A l’exemple de la Guyanne a une variation très différente des autres.
Cela ce verifie grâce à cette representation de l’évolution du taux d’incidence par département.
La Guyane correspond au département 973. On confirme la particularité de l’allure de la courbe par rapport aux autres.
ggplot(table_week_dep_melted) +
aes(x = week_int, y = Taux_incidence, colour = Dep) +
geom_line(size = 1L) +
scale_color_hue() +
theme_minimal() +
facet_wrap(vars(Dep))
Malgré qu’on a réuni la corse, la taille de notre heatmap pour les département est énorme. Pour faciliter la lecture, nous avons decidé de l’enregistrer sous format pdf.
ggsave(
plot = heatmap_table_week_dep,
width = 30,
height = 30,
dpi = 300,
filename = "heatmap_table_week_dep.pdf",
limitsize = FALSE
)Grâphe representant l’évolution du taux d’incidence dans différentes classes d’âge:
Nous avons précedemment analysé l’évolution du taux d’incidence grâce au heatmap.Toutefois il serait judicieux de revoir les données sous un angle différent en utilisant une répresenta des différentes courbes de l’évolution de l’épidemie par classe d’âge.Car malgré la grande capacité de perception des couleurs de l’oeil humain, la distinction peut être source de confusion.
multiple_courbe <-ggplot(
table_week_classe_melted,
aes(
x = week_int,
y = Taux_incidence,
group = Classe,
color = Classe
)
) +
geom_line() +
labs(x = "Numero de semaine(2020)", y = "Taux d'incidence", title = "Evolution du taux d'incidence par Classe") +
theme_light()
multiple_courbe
Interpretation:
A partir de cette courbe, nous confirmons les affirmations faites grâce au heatmap et surtout le fait que la situation concernant la classe des moins de 29 ans s’est largement déteriorée par rapport aux autres classes.
La situation chez les moins de 9 ans tend à se stabiliser . En revanche les autres classses ont un sens de variation presque simulaire.
Il est intéressant d’observer ces courbes graduellement afin de mieux percevoir la vitesse de variation de l’épidemie dans différentes classes.
anim <- ggplot(
table_week_classe_melted,
aes(
x = week_int,
y = Taux_incidence,
group = Classe,
color = Classe
)
) +
geom_line() +
transition_reveal(
week_int
)+
labs(x = "Numero de semaine(2020)", y = "Taux d'incidence", title = "Evolution du taux d'incidence par Classe") +
geom_text(aes(x = min(week_int), y = max(Taux_incidence), label = as.factor(week_int)) , hjust=-2, vjust = 3, alpha = 0.5, col = "gray", size = 20)+
theme_light() +
view_follow()
anim
animate(
plot = anim,
render = gifski_renderer(),
height = 600,
width = 800,
duration = 10,
fps = 25)
anim_save('anim.gif')Il faut representer séparément les classes d’âge afin de mieux les étudier.
ggplot(table_week_classe_melted) +
aes(x = week_int, y = Taux_incidence, colour = Classe, size = Taux_incidence) +
geom_line() +
scale_color_hue() +
theme_minimal() +
facet_wrap(vars(Classe))
Interpretation:
Nous pouvons observer l’allure du taux d’incidence par classe . La classe de moins de 29 se distingue toujours malgré l’echelle reduite.
Nous allons ajouter les noms des départements dans notre jeu de données:
liste_dep_transform =list(NULL)
for (i in 1:length(liste_dep$nom)){
liste_dep_transform <-append(liste_dep_transform,rep(liste_dep$nom[i],length(table_age$cl_age90)*length(table_week_dep$week_int)))
}
liste_dep_transform=liste_dep_transform[-1]
data <- add_column(data,d=liste_dep_transform,.after=data$dep)
#On le renomme
colnames(data)[2]= 'Nom_Dep'
#On l'ajoute a table_week_dep_melted
liste_dep_transform =list(NULL)
for (i in 1:length(liste_dep$nom)){
liste_dep_transform <-append(liste_dep_transform,rep(liste_dep$nom[i],length(table_week_dep$week_int)))
}
liste_dep_transform=liste_dep_transform[-1]
table_week_dep_melted <- add_column(table_week_dep_melted,d=liste_dep_transform,.after=table_week_dep_melted$Dep)
colnames(table_week_dep_melted)[2]= 'Nom_Dep'
data_bar_race <- table_week_dep_melted %>%
group_by(week_int) %>%
arrange(week_int,desc(Taux_incidence)) %>%
mutate(ranking = row_number()) %>%
filter(ranking <=15)Nous allons pour cette dernière partie, classer chaque semaine les départements par leur taux d’incidences .
bar_race <- data_bar_race %>%
ggplot()+
geom_col(aes(ranking,Taux_incidence,fill=Dep))+
geom_text(aes(ranking,Taux_incidence,label=floor(Taux_incidence)),hjust=-0.1)+
geom_text(aes(ranking,y=0,label=Nom_Dep),hjust=1.1)+
geom_text(aes(x=15,y=max(Taux_incidence),label=as.factor(week_int)),vjust=0.2,alpha=0.5,color='grey',size=20)+
coord_flip(clip='off',expand = FALSE)+scale_x_reverse()+
theme_minimal() + theme(
panel.grid=element_blank(),
legend.position = 'none',
axis.ticks.y =element_blank(),
axis.title = element_blank(),
axis.text.y=element_blank(),
plot.margin = margin(1,4,1,5,'cm')
)+
transition_states(week_int,state_length = 0,transition_length = 1)+
enter_fade()+
exit_fade()+
ease_aes('quadratic-in-out')
bar_race
animate(
plot = bar_race,
render = gifski_renderer(),
height = 600,
width = 1000,
duration = 40,
fps = 25)