Evolución de la semana 12 a 13

La comunidad de Madrid proporciona datos de la incidencia acumulada de los últimos 14 días (IA14) de covid19 desglosada por zonas básicas de salud (ZBS) A estos datos les he añadido una tabla con una línea para cada ZBS con estas columnas

Uniendo ambas tablas podemos comparar:

Nota: Algunas ZBS están compartidas por más de un municipio, en ese caso están asignadas en la tabla a uno solo. En principio no afecta mucho a la clasificación que se hace en estas gráficas

Plantilla de gráficos

theme_a <- function(base_size = 12,
                    base_family = "sans"
                           )
    {
 
    tema <-
        theme_bw(base_size=base_size) +
          
        theme(legend.position="top") +
        theme(legend.text = element_text(size=base_size+1,family = base_family)) +
        theme(plot.title=element_text(size=base_size+2, 
                                      vjust=1.25, 
                                      family=base_family, 
                                      hjust = 0.5
                                      )) +
        
        theme(plot.subtitle=element_text(size=base_size, family = base_family))  +
        theme(text = element_text(size=base_size+1,family = base_family)) +
        theme(axis.text.x=element_text(size=base_size,family = base_family)) +
        theme(axis.text.y=element_text(size=base_size, family = base_family)) +

        theme(axis.title.x=element_text(size=base_size, vjust=0, family = base_family)) +
        theme(axis.title.y=element_text(size=base_size, vjust=1.25, family = base_family)) +
        theme(plot.caption=element_text(size=base_size-2, family = base_family)) +
        theme(strip.text = element_text(size=base_size+1, family = base_family)) +
        theme(strip.text.x = element_text(size=base_size, family = base_family)) +
        theme(strip.text.y = element_text(size=base_size,, family = base_family)) 

    return (tema)
}

preparar datos para gráficas

library(tidyverse)
library(knitr)
library(viridis)
library(stringr)
require(RCurl)
# library(sparkline)

locale(date_names = "es", date_format = "%AD", time_format = "%AT",
  decimal_mark = ",", grouping_mark = ".", tz = "UTC",
  encoding = "UTF-8", asciify = FALSE)
## <locale>
## Numbers:  123.456,78
## Formats:  %AD / %AT
## Timezone: UTC
## Encoding: UTF-8
## <date_names>
## Days:   domingo (dom.), lunes (lun.), martes (mar.), miércoles (mié.), jueves
##         (jue.), viernes (vie.), sábado (sáb.)
## Months: enero (ene.), febrero (feb.), marzo (mar.), abril (abr.), mayo (may.),
##         junio (jun.), julio (jul.), agosto (ago.), septiembre (sept.),
##         octubre (oct.), noviembre (nov.), diciembre (dic.)
## AM/PM:  a. m./p. m.
file_serie_madrid_zbs <- "https://datos.comunidad.madrid/catalogo/dataset/b3d55e40-8263-4c0b-827d-2bb23b5e7bab/resource/43708c23-2b77-48fd-9986-fa97691a2d59/download/covid19_tia_zonas_basicas_salud_s.csv"

#file_serie_madrid_zbs <- "../data/covid19_tia_zonas_basicas_salud_s.csv"

file_madrid_zbs <- "https://raw.githubusercontent.com/montera34/escovid19data/master/data/original/madrid_zbs.csv"


serie_madrid_zbs <- read_csv2(file_serie_madrid_zbs,locale = locale(encoding = 'ISO-8859-1'))
madrid_zbs <-  read_csv2(file_madrid_zbs)
zbs_restringidas <- read_csv2("../data/zbs_restringidas.csv")
municipios_restringidos <- read_csv2("../data/municipios_restringidos.csv")

madrid_zbs   <- madrid_zbs %>%
                  mutate (restriccion = ifelse (zbs %in% zbs_restringidas$zbs, "Sí",
                                        ifelse (municipio_distrito  %in% 
                                                  municipios_restringidos$municipio,"Sí","No"))) 
madrid_zbs_restringidas <- madrid_zbs %>%
                    filter (restriccion == "Sí")

serie_madrid_zbs$fecha_informe <-  as.Date(serie_madrid_zbs$fecha_informe,format= "%Y/%m/%d")

serie_madrid_zbs <- serie_madrid_zbs %>%
                    merge(madrid_zbs, by.x = "zona_basica_salud", by.y = "zbs", all = TRUE   ) %>%
                    mutate (year = as.integer(format(fecha_informe, format="%Y")) -2020) %>%
                    mutate (week = (as.integer(format(fecha_informe, format="%U")) +1)+(52*year)) %>%
                    mutate(poblacion= round((casos_confirmados_ultimos_14dias *100000 ) /
                             tasa_incidencia_acumulada_ultimos_14dias),0)

last_week <- max(serie_madrid_zbs$week,na.rm = TRUE) 
last_week_text <- last_week %% 53
value_last_week <- serie_madrid_zbs %>% filter (week == last_week ) 
cm_max_value <- round(max(value_last_week$tasa_incidencia_acumulada_ultimos_14dias,na.rm = TRUE))
cd_min_value <- round(min(value_last_week$tasa_incidencia_acumulada_ultimos_14dias,na.rm = TRUE))
cd_mean  <- mean (value_last_week$tasa_incidencia_acumulada_ultimos_14dias)

cap_value_last_week <- serie_madrid_zbs %>% filter (week == last_week)  %>% filter (Capital == "Sí")
cap_max_value <- round(max(cap_value_last_week$tasa_incidencia_acumulada_ultimos_14dias,na.rm = TRUE))
cap_min_value <- round(min(cap_value_last_week$tasa_incidencia_acumulada_ultimos_14dias,na.rm = TRUE))
cap_mean <- mean(cap_value_last_week$tasa_incidencia_acumulada_ultimos_14dias)

max_poblacion = round(max(serie_madrid_zbs$poblacion,na.rm = TRUE))
min_poblacion = round(min(serie_madrid_zbs$poblacion,na.rm = TRUE))
total_poblacion <- serie_madrid_zbs %>% 
                  filter (week == last_week) %>% summarise (t_poblacion = sum(poblacion,na.rm = TRUE))
poblacion <-  serie_madrid_zbs %>% filter (week == last_week ) %>%
              select(zona_basica_salud,poblacion ) %>%
              arrange (poblacion)
rangos_zbs <- c(poblacion$zona_basica_salud[1],
            poblacion$zona_basica_salud[72],
            poblacion$zona_basica_salud[143],
            poblacion$zona_basica_salud[214],
            poblacion$zona_basica_salud[286])
rangos_poblacion <- c(poblacion$poblacion[1],
            poblacion$poblacion[72],
            poblacion$poblacion[143],
            poblacion$poblacion[214],
            poblacion$poblacion[286])
rangos <- data.frame(zbs=rangos_zbs,
                     poblacion=rangos_poblacion)
distritos <- serie_madrid_zbs %>% filter (week == last_week ) %>%
             filter (Capital == "Sí") %>%
             select(zona_basica_salud,municipio_distrito ) %>%
             arrange (municipio_distrito)

Seleccionar datos para gráfica

Es una parte cómun a todas las gráficas de variación y se centralkizan en una función para no repetir código

select_last_weeks <- function (df,poblacion,indicator,since,to){
  
library(ggalt)
  

diff <- mutate (df,indicator=df[[indicator]]) %>%
    filter (!is.na (indicator) ) %>%
    filter (week == last_week | week == last_week-1 ) %>%
    mutate (week_order = ifelse(week == last_week, "indicator_last_week","indicator_pre_last_week")) %>%
    pivot_wider (names_from=week_order,values_from= indicator) %>%
    group_by(zona_basica_salud) %>%
    summarise ( indicator_last_week = sum (indicator_last_week,na.rm = TRUE),
                indicator_pre_last_week = sum (indicator_pre_last_week,na.rm = TRUE) ,
                indicator_diff = indicator_last_week - indicator_pre_last_week,na.rm = TRUE,
                distrito = municipio_distrito,
                restriccion= restriccion) %>%
                distinct(zona_basica_salud,indicator_last_week,indicator_pre_last_week,
                         indicator_diff,distrito,restriccion) %>%
    filter (indicator_last_week > 0 & indicator_pre_last_week > 0)  %>%
    mutate(ajuste_text = ifelse(indicator_diff >0, -0.2,(0.04*abs(indicator_diff/100))+1),
           ajuste_perc = ifelse(indicator_diff > 0,  (0.05*abs(indicator_diff/100))+1.25,-0.2)) 
    
diff <- merge(diff,poblacion)    
cuartile <- quantile(diff$indicator_last_week, prob=seq(0, 1, length = 11))
diff <-  diff %>% 
          filter (indicator_last_week >= cuartile[since] &
                               indicator_last_week <= cuartile[to])


return (diff)
}  

Gráfica de incrementos (incremento)

dumbbell_A <- function (df,text_indicator,max_size,skip,left_margin,su_color,annotation_zbs){
  

grafica <- df %>% 
     ggplot() + 
     geom_segment(aes(x=indicator_pre_last_week, 
                      xend=indicator_last_week, 
                      y= zona_basica_salud,
                      yend=zona_basica_salud, 
                      color=ajuste_color,
                      size = poblacion),
                      arrow = arrow(length=unit(0.10,"cm"), ends="last", type = "closed"))+
    geom_line (aes(x=indicator_last_week, 
               y= as.numeric(reorder(zona_basica_salud,indicator_last_week))),
               size=4, alpha=0.5, color = "gray") +
     labs(x = "Variación", y = "zbs",
     caption = "By @congosto\nFuente: Comunidad de Madrid")+
     scale_colour_manual('', values = su_color) +
     scale_size(breaks =c(2000,10000,20000,30000,40000,60000),range = c(0.5,1.5)) +
     scale_y_discrete ( expand = c(0.05, 0.05)) +
     scale_x_continuous(name=text_indicator,position = "top", limit = c(left_margin,max_size),
                        breaks=seq(0, max_size, by = skip), sec.axis = dup_axis(),
                        expand = c(0.0, 0.0)) +
     theme_a() +
     theme(axis.title.y=element_blank(),
           axis.text.y=element_blank(),
           axis.ticks.y=element_blank(),
           panel.grid.major.y = element_blank(),
           panel.grid.major.x = element_line(colour = "gray"),
           plot.margin = unit(c(1,1,1,1), "cm"),
           legend.position="top",legend.text = element_text(size=11))
if (annotation_zbs) {
  grafica <- grafica +
     geom_text(aes(x=indicator_last_week, 
                  y= zona_basica_salud, color=ajuste_color, label = zona_basica_salud, 
                  hjust= ajuste_text),
                  size=4, vjust=0, show.legend = FALSE ) +
     geom_text(aes(x=indicator_pre_last_week, 
                   y= zona_basica_salud, color=ajuste_color,
                   label = round(indicator_diff,1),
                   hjust= ajuste_perc),
                   size=4, vjust=0, show.legend = FALSE ) 

}

return (grafica)

}

Variación ZBS comunidad Madrid

df <- select_last_weeks (serie_madrid_zbs,poblacion,"tasa_incidencia_acumulada_ultimos_14dias","0%","100%") %>% 
      mutate(ajuste_color = ifelse(indicator_diff >0, "Incremento", "Descenso")) %>%
      arrange (indicator_last_week)

df$zona_basica_salud <- factor(df$zona_basica_salud, levels=df$zona_basica_salud)

variacion <- df$indicator_diff
pos <- sum(variacion > 0)
neg <- sum(variacion < 0)
cero <- sum(variacion ==0)
vacio <- sum(is.na (variacion))


mi_color <- c('Descenso'='steelblue4', 'Incremento'='red4')
grafica <-  dumbbell_A (df,"IA14",750,250,0,mi_color,FALSE)

grafica <- grafica + 
    labs(  
      title = paste("ZBS En la Comunidad de Madrid, diferencia de la IA14 entre las semanas", 
                     last_week_text-1,"y",last_week_text) ,
      subtitle="Normalizado a 100.000 habitantes.Los valores semanales se calculan como media\nEn rojo las ZBS que aumentan el IA14, en azul las que disminuyen.")

plot(grafica)

name_file <- paste0("images/segunda_ola_tasa_incidencia_acumulada_ultimos_14dias_tendencia.png")
ggsave(name_file,grafica, width = 200, height = 300,unit="mm")

Zonas Básicas de Salud (ZBS) de la Comunidad de Madrid con mayor Valor de IA14

df <- select_last_weeks (serie_madrid_zbs,poblacion,"tasa_incidencia_acumulada_ultimos_14dias","80%","100%") %>% 
      mutate(ajuste_color = ifelse(indicator_diff >0, "Incremento", "Descenso")) %>% 
      arrange (indicator_last_week)
df$zona_basica_salud <- factor(df$zona_basica_salud, levels=df$zona_basica_salud)

mi_color <- c('Descenso'='steelblue4', 'Incremento'='red4')
grafica <-  dumbbell_A (df,"IA14",750,250,0,mi_color,TRUE)

grafica <- grafica + 
    labs(  
      title = paste("ZBS con mayor incidencia en la Comunidad de Madrid, diferencia de la IA14 entre las semanas", 
                     last_week_text-1,"y",last_week_text) ,
      subtitle="Normalizado a 100.000 habitantes.Los valores semanales se calculan como media\nEn rojo las ZBS que aumentan el IA14, en azul las que disminuyen. El dato númerico es la variación en esa semana")

plot(grafica)

name_file <- paste0("images/segunda_ola_tasa_incidencia_acumulada_ultimos_14dias_comunidad_mayor.png")
ggsave(name_file,grafica, width = 230, height = 325,unit="mm")

Zonas Básicas de Salud (ZBS) de la Comunidad de Madrid con menor Valor de IA14

df <- select_last_weeks (serie_madrid_zbs,poblacion,"tasa_incidencia_acumulada_ultimos_14dias","0%","20%") %>% 
      mutate(ajuste_color = ifelse(indicator_diff >0, "Incremento", "Descenso")) %>% 
      arrange (indicator_last_week)
df$zona_basica_salud <- factor(df$zona_basica_salud, levels=df$zona_basica_salud)

mi_color <- c('Descenso'='steelblue4', 'Incremento'='red4')
grafica <-  dumbbell_A (df,"IA14",750,250,-100,mi_color,TRUE)

grafica <- grafica + 
    labs(  
      title = paste("ZBS con menor incidencia en la Comunidad de Madrid, diferencia de la IA14 entre las semanas", 
                     last_week_text-1,"y",last_week_text) ,
      subtitle="Normalizado a 100.000 habitantes.Los valores semanales se calculan como media\nEn rojo las ZBS que aumentan el IA14, en azul las que disminuyen. El dato númerico es la variación en esa semana")

plot(grafica)