Evolución del COVID-19 en la provincia de Granada

1 Introducción

El objetivo de este proyecto es realizar una visualización longitudinal del impacto del COVID-19 en la provincia de Granada. Para ello se está realizando un doble esfuerzo. Por un lado se están empleando los datos procedentes de fuentes oficiales sobre la incidencia diaria del virus en la provincia y por otro se está observando la discusión al respecto en Twitter.

Cabe destacar que por este motivo no se pretende realizar un análisis de estos datos, sino que su fin pasa por ofrecer una fotografía de la situación actual desde dos perspectivas diferentes.

2 Metodología

Los materiales empleados para mostrar la incidencia del virus en la provincia proceden de la Junta de Andalucía, los cuales son actualizados a diario. A excepción de los casos nuevos, el resto de variables (fallecimientos, curados, hospitalizados e ingresos en UCI) aparecen recogidos como valores acumulados, por lo que estos casos han requerido ser disgregados. No obstante, en los valores obtenidos de curados y hospitalizados diarios exite un día que dicha diferencia de acumulados da como resultado un valor negativo.

datos <- read.csv2('datos.csv', stringsAsFactors = FALSE)
datos$Fecha <- as.Date(datos$Fecha, format = '%d/%m/%Y')

edad <- read.csv2('datos_edad.csv', stringsAsFactors = FALSE, encoding = 'UTF-8')
#edad <- edad[-which(edad$Edad == 'TOTAL' | edad$Sexo == 'Ambos sexos'),]
edad$Valor <- 100*edad$Valor/sum(edad$Valor)

tuits <- read.csv2('tuits.csv', stringsAsFactors = FALSE, encoding = 'UTF-8')
tuits$Fecha <- as.Date(tuits$Fecha, format = '%d-%m-%Y')

Partiendo de las medidas antes citadas se han realizados gráficos con la evolución diaria y acumulada, incluyendo en ambos la media móvil de 3 días, la ratio de crecimiento cada 4 días y la de curados con el resto de medidas. Todos ellos se han realizado tomando como punto de inicio el día 12 de marzo, cuando se confirmaron los primeros positivos en la provincia. Tanto para la disgregación como para la visualización, elaborada mediante ggplot2, se han realizado varias funciones incluidas más abajo.

Por otra parte, también se ha estudiado la actividad en Twitter al respecto. Para ello se han recuperado los tuits que hiciesen mención de manera conjunta a Granada y la Covid-19, incluyendo también como alternativas las palabras coronavirus y Wuhan, esta última debido a las referencias iniciales al virus durante las primeras semanas antes de establecerse el nombre oficial. Esta búsqueda se ha realizado desde el 1 de enero de 2020 hasta la actualidad (dos días antes de la fecha de actualización de esta notebook), siendo el primer tuit del 21 de enero.

Cabe destacar que tanto los datos usados como este archivo Rmd se encuentran disponibles en GitHub.

# función de disgregación
diario <- function(datos, columna){
  aux <- datos[which(datos$Medida == columna),]
  aux <- aux[order(aux$Fecha, decreasing = FALSE),]
  aux$Valor[-1] <- aux$Valor[-1] - aux$Valor[-dim(aux)[1]]
  
  return(aux)
}

# función para calcular la media movil de n días
media_movil <- function(datos, dias){
  datos$Valor <- filter(datos$Valor, rep(1/dias, dias), sides=2)
  
  return(datos)
}

# función para calcular la ratio de crecimiento en n días
ratio_crec <- function(datos, dias){
  datos$Valor_aux <- datos$Valor
  sapply(dias:dim(datos)[1], function(x){
    datos$Valor[x] <<- datos$Valor_aux[x] / datos$Valor_aux[x - (dias - 1)] 
  })
  
  datos$Valor[which(datos$Valor == Inf)] <- NaN
  
  return(datos)
}

# función para dibujar la evolución diaria
evolucion <- function(datos, titulo, color){
  ggplot(datos, aes(x = Fecha, y = Valor)) +
    geom_col(fill = color) +
    geom_text(data = datos, aes(x = Fecha, y = Valor, label = round(Valor, 2)), size = 2, vjust = 0.5, hjust = -0.2, angle = 90) +
    geom_hline(yintercept = 1, alpha = 0.7) +
    scale_x_date(date_breaks = '2 days', date_labels = '%d-%b', limits = c(as.Date('11-03-2020', format = '%d-%m-%Y'), NA), expand = c(0,0)) +
    labs(title = titulo, x = '', y = '') +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1),
          plot.title = element_text(hjust = 0.5))
}

# función para dibujar la evolución diaria y media móvil
evolucion_movil <- function(datos1, datos2, titulo, serie, color){
  ggplot() +
    geom_col(data=datos1, aes(x = Fecha, y = Valor, fill = serie)) +
    geom_line(data=datos2, aes(x = Fecha, y = Valor, color = 'Media móvil'), alpha = 0.7, size = 1.2) +
    geom_text(data = datos1, aes(x = Fecha, y = Valor, label = round(Valor, 2)), size = 2, vjust = 0.5, hjust = -0.2, angle = 90) +
    scale_fill_manual('', values = color) +
    scale_color_manual('', values = 'black') +
    scale_x_date(date_breaks = '2 days', date_labels = '%d-%b', limits = c(as.Date('11-03-2020', format = '%d-%m-%Y'), NA), expand = c(0,0)) +
    scale_y_continuous(expand = c(0, 0, 0.1, 0)) +
    labs(title = titulo, x = '', y = '') +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 90, vjust=0.5, hjust=1),
          plot.title = element_text(hjust = 0.5),
          legend.position = 'bottom')
}

# diferencia semanal
diferencia_semana <- function(datos, titulo){
  
  datos$Valor[8:(dim(datos)[1])] <- datos$Valor[8:dim(datos)[1]]-datos$Valor[1:(dim(datos)[1]-7)]
  datos <- datos[8:(dim(datos)[1]),]
  
  ggplot() +
    geom_col(data = datos, aes(x = Fecha, y = Valor, fill = ifelse(Valor >= 0, 'Aumenta', 'Decrece'))) +
    geom_text(data = datos, aes(x = Fecha, y = Valor, label = Valor, hjust = ifelse(Valor > 0, -0.2, 1.2)), vjust = 0.5, size = 2, angle = 90) +
    geom_hline(yintercept = 0, alpha = 0.7) +
    scale_fill_manual('', values =  c('Aumenta'='#FD6467', 'Decrece'='#7294D4')) +
    scale_x_date(date_breaks = '2 days', date_labels = '%d-%b', limits = c(as.Date('11-03-2020', format = '%d-%m-%Y'), NA), expand = c(0,0)) +
    scale_y_continuous(expand = c(0.1, 0, 0.1, 0)) +
    labs(title = titulo, subtitle = 'Diferencia respecto al mismo día de la semana anterior', x = '', y = '') +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 90, vjust=0.5, hjust=1),
          plot.title = element_text(hjust = 0.5),
          plot.subtitle = element_text(hjust = 0.5),
          legend.position = 'bottom')
}

# ratios de curados
ratios <- function(curados, datos, serie, color){
  aux <- curados
  aux$Valor <- (aux$Valor - datos$Valor)/(aux$Valor + datos$Valor)
  
  ggplot() +
    geom_col(data = aux, aes(x = Fecha, y = ifelse(Valor > 0, Valor, 0), fill = 'Curados')) +
    geom_col(data = aux, aes(x = Fecha, y = ifelse(Valor < 0, Valor, 0), fill = serie)) +
    geom_text(data = aux, aes(x = Fecha, y = Valor, label = round(Valor, 2), hjust = ifelse(Valor > 0, -0.2, 1.2)), vjust = 0.5, size = 2, angle = 90) +
    geom_hline(yintercept = 0, alpha = 0.7) +
    scale_fill_manual('', values =  setNames(c('#00A08A', color), c('Curados', serie))) +
    scale_x_date(date_breaks = '2 days', date_labels = '%d-%b', limits = c(as.Date('11-03-2020', format = '%d-%m-%Y'), NA), expand = c(0,0)) +
    scale_y_continuous(expand = c(0.1, 0, 0.1, 0)) +
    labs(title = paste0('Ratio Curados/',serie), x = '', y = '') +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 90, vjust=0.5, hjust=1),
          plot.title = element_text(hjust = 0.5),
          legend.position = 'bottom')
}

3 Visualización

3.1 Casos por edad y sexo

ggplot(data=edad, aes(x = Edad, y = ifelse(Sexo == 'Hombres', -Valor, Valor), fill = Sexo)) + 
  geom_bar(stat = "identity") +
  geom_text(data = edad, aes(x = Edad, y = ifelse(Sexo == 'Hombres', -Valor, Valor), label = paste(round(Valor, 2), '%'), vjust = 0.5, hjust = ifelse(Sexo == 'Hombres', 1.2, -0.2)), size = 3) +
  scale_fill_manual('', values = c('#46ACC8','#B40F20')) +
  scale_y_continuous(limits = c(-30, 30), labels = function(x) paste(x, '%')) +
  coord_flip() +
  labs(title = 'Distribución de casos', subtitle = 'Porcentaje respecto al total de casos', x = '', y = '') +
    theme_minimal() +
    theme(axis.text.x = element_text(vjust=1, hjust=0.5),
          plot.title = element_text(hjust = 0.5),
          plot.subtitle = element_text(hjust = 0.5),
          legend.position = 'bottom')

3.2 Evolución diaria y diferencia semanal

#d_diarios <- datos[which(datos$Medida == 'Nuevos casos'),]
d_diarios <- diario(datos, 'Confirmados')

evolucion_movil(d_diarios, media_movil(d_diarios, 3), 'Casos (diario)', 'Nuevos casos', '#5BBCD6')

diferencia_semana(d_diarios, 'Casos (diario)')

f_diarios <- diario(datos, 'Fallecimientos')

evolucion_movil(f_diarios, media_movil(f_diarios, 3), 'Fallecidos (diario)', 'Fallecimientos', '#FF0000')

diferencia_semana(f_diarios, 'Fallecidos (diario)')

c_diarios <- diario(datos, 'Curados')

evolucion_movil(c_diarios, media_movil(c_diarios, 3), 'Curados (diario)', 'Curados', '#00A08A')

diferencia_semana(c_diarios, 'Curados (diario)')

h_diarios <- diario(datos, 'Hospitalizados')

evolucion_movil(h_diarios, media_movil(h_diarios, 3), 'Hospitalizados (diario)', 'Hospitalizados', '#F2AD00')

diferencia_semana(h_diarios, 'Hospitalizados (diario)')

u_diarios <- diario(datos, 'Total UCI')

evolucion_movil(u_diarios, media_movil(u_diarios, 3), 'Ingresos en UCI (diario)', 'Ingresos en UCI', '#F98400')

diferencia_semana(u_diarios, 'Ingresos en UCI (diario)')

3.3 Evolución acumulada

d_diarios_a <- datos[which(datos$Medida == 'Confirmados'),]

evolucion_movil(d_diarios_a, media_movil(d_diarios_a, 3), 'Casos confirmados (acumulado)', 'Nuevos casos', '#5BBCD6')

f_diarios_a <- datos[which(datos$Medida == 'Fallecimientos'),]

evolucion_movil(f_diarios_a, media_movil(f_diarios_a, 3), 'Fallecidos (acumulado)', 'Fallecimientos', '#FF0000')

c_diarios_a <- datos[which(datos$Medida == 'Curados'),]

evolucion_movil(c_diarios_a, media_movil(c_diarios_a, 3), 'Curados (acumulado)', 'Curados', '#00A08A')

h_diarios_a <- datos[which(datos$Medida == 'Hospitalizados'),]

evolucion_movil(h_diarios_a, media_movil(h_diarios_a, 3), 'Hospitalizados (acumulado)', 'Hospitalizados', '#F2AD00')

u_diarios_a <- datos[which(datos$Medida == 'Total UCI'),]

evolucion_movil(u_diarios_a, media_movil(u_diarios_a, 3), 'Ingresos en UCI (acumulado)', 'Ingresos en UCI', '#F98400')

3.4 Ratios de crecimiento

d_diarios_r <- ratio_crec(datos[which(datos$Medida == 'Confirmados'),], 4)

evolucion(d_diarios_r, 'Casos confirmados (ratio de crecimiento)', '#5BBCD6')

f_diarios_r <- ratio_crec(datos[which(datos$Medida == 'Fallecimientos'),], 4)

evolucion(f_diarios_r, 'Fallecidos (ratio de crecimiento)', '#FF0000')

c_diarios_r <- ratio_crec(datos[which(datos$Medida == 'Curados'),], 4)

evolucion(c_diarios_r, 'Curados (ratio de crecimiento)', '#00A08A')

h_diarios_r <- ratio_crec(datos[which(datos$Medida == 'Hospitalizados'),], 4)

evolucion(h_diarios_r, 'Hospitalizados (ratio de crecimiento)', '#F2AD00')

u_diarios_r <- ratio_crec(datos[which(datos$Medida == 'Total UCI'),], 4)

evolucion(u_diarios_r, 'Ingresos en UCI (ratio de crecimiento)', '#F98400')

3.5 Ratios de curados

ratios(c_diarios, d_diarios, 'Nuevos casos', '#5BBCD6')

ratios(c_diarios, f_diarios, 'Fallecimientos', '#FF0000')

ratios(c_diarios, h_diarios, 'Hospitalizados', '#F2AD00')

ratios(c_diarios, u_diarios, 'Ingresos en UCI', '#F98400')

3.6 Evolución de tuits

ggplot(data = tuits, aes(x = Fecha, y = Tuits)) +
  geom_area(fill = '#046C9A', alpha = 0.7) +
  geom_line(color = '#046C9A', size = 1) +
  #geom_text(aes(label = ifelse(Tuits > 300, Tuits, NA)), size = 2, vjust = 0.5, hjust = -0.2, angle = 90) +
  scale_x_date(date_breaks = '7 days', date_labels = '%d-%b', limits = c(as.Date('20-01-2020', format = '%d-%m-%Y'), NA), expand = c(0,0)) +
    scale_y_continuous(expand = c(0, 0, 0.1, 0)) +
    labs(title = 'Tuits (diario)', x = '', y = '') +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 90, vjust=0.5, hjust=1),
          plot.title = element_text(hjust = 0.5),
          legend.position = 'bottom')

tuits_ts <- ts(tuits$Tuits[69:(68+(trunc((dim(tuits)[1]-68)/7)*7))], frequency = 7)
df_decompose <- data.frame(Fecha = rep(tuits$Fecha[69:(68+(trunc((dim(tuits)[1]-68)/7)*7))],2),
                           Variable = c(rep('Estacionalidad',length(tuits_ts)), rep('Tendencia',length(tuits_ts))),
                           Value = c(decompose(tuits_ts)$seasonal,decompose(tuits_ts)$trend), stringsAsFactors = FALSE)

ggplot(data = df_decompose, aes(x = Fecha, y = Value)) +
  facet_grid(Variable ~ . , scales = 'free')+
  geom_line(color = '#046C9A', size = 1) +
  scale_x_date(date_breaks = '2 week', date_labels = '%A\n%d %b', expand = c(0,0)) +
  labs(title = 'Estacionalidad y tendencia de los tuits', subtitle= 'Desde la semana del inicio del confinamiento', x = '', y = '') +
    theme_bw() +
    theme(axis.text.x = element_text(vjust=0.5, hjust=0.5),
          plot.title = element_text(hjust = 0.5),
          plot.subtitle = element_text(hjust = 0.5),
          legend.position = 'bottom')

4 Agradecimientos

Los colores empleados en las gráficas proceden del paquete wesanderson.