Evolución de hospitalizaciones por provincias desde la 1ª ola
Gráfica dinámica
Plantilla de gráficos
theme_a <- function(base_size = 10,
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+5,
vjust=1.25,
family=base_family,
hjust = 0.5
)) +
theme(plot.subtitle=element_text(size=base_size,
hjust = 0.5,
family = base_family)) +
theme(text = element_text(size=base_size+1,family = base_family)) +
theme(axis.text.x=element_text(size=base_size-1,family = base_family)) +
theme(axis.text.y=element_text(size=base_size-1, family = base_family)) +
theme(axis.title.x=element_text(size=base_size-1, vjust=0, family = base_family)) +
theme(axis.title.y=element_text(size=base_size-1, 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 la gráfica
library(readr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(lubridate)
library(gifski)
library(purrr)
library(animation)
library(magick)
url_file_prov<-"https://raw.githubusercontent.com/montera34/escovid19data/master/data/output/covid19-provincias-spain_consolidated.csv"
url_file_poblacion <- "https://raw.githubusercontent.com/montera34/escovid19data/master/data/original/provincias-poblacion.csv"
provincias <- read.csv( url_file_prov,encoding = "UTF-8")
provincias$date <- as.Date(provincias$date,format= "%Y-%m-%d")
provincias <- provincias %>%
select (date,province,ccaa,hospitalized,intensive_care,daily_deaths,poblacion) %>%
mutate(hospitalized_tot = ifelse(ccaa == "Andalucía" |
ccaa == "Madrid, Comunidad de" |
ccaa == "Cantabria" |
ccaa == "Murcia" |
ccaa == "Cantabria",hospitalized ,
hospitalized+intensive_care)) %>%
mutate (hospitalized_nor =hospitalized_tot *100000/ poblacion ) %>%
mutate (intensive_care_nor = intensive_care *100000/ poblacion) %>%
mutate (daily_deaths_nor =daily_deaths *100000/ poblacion ) %>%
mutate (year = as.integer(format(date, format="%Y")) -2020) %>%
mutate (week = (as.integer(format(date, format="%U")) +1)+(52*year)) %>%
arrange (week) Gráfica dinámica de tendencia
Gráfica sin nombres de provincia para destacar la tendencia.
tendencia <- function (provincias,indicator,text_indicator,max_size,skip,left_margin){
library(ggalt)
weeks <- unique(provincias$week)
first_week <- min(weeks,na.rm = TRUE)
last_week <- max(weeks,na.rm = TRUE)
last_week_text <- last_week %% 53
prefix_file <- paste0("tmp/tendencia_",indicator,"_")
chart_title <- paste("Diferencia de ",text_indicator )
diff <- mutate (provincias,indicator=provincias[[indicator]]) %>%
select (week,province,indicator,ccaa) %>%
group_by(week,province,ccaa) %>%
summarise ( indicator_week = mean (indicator, na.rm = TRUE), .groups = 'drop') %>%
group_by(province,ccaa) %>%
summarise ( indicator_week = indicator_week,
indicator_pre_week = lag (indicator_week),
indicator_diff = indicator_week - indicator_pre_week,
date = ifelse (week < 52,
lubridate::ymd( "2020-01-01" ) + lubridate::weeks( week ),
lubridate::ymd( "2021-01-01" ) + lubridate::weeks( week - 53 )), .groups = 'drop') %>%
filter (!is.na(indicator_diff)) %>%
mutate(Color = ifelse(indicator_diff >0, "Incremento", "Descenso")) %>%
arrange (date)
diff$date = format(as.Date(diff$date,origin="1970-01-01"))
do.call(file.remove, list(list.files("tmp", full.names = TRUE))) # Borramos frames anteriores
print(unique(diff$date))
# Generamos los frames
for (week in unique(diff$date)){
week=format(as.Date(week,origin="1970-01-01"))
previous_sunday <- floor_date(Sys.Date(), "week")
if (week >= previous_sunday)
{break}
ola = ifelse (week > "2021-06-21", "5ª Ola",
ifelse (week > "2021-03-22", "4ª Ola",
ifelse (week > "2020-12-02", "3ª Ola",
ifelse (week > "2020-08-02","2ª Ola","1ª Ola"))))
ggplot(data = diff %>% filter (date == week)) +
geom_segment(aes(x=indicator_pre_week,
xend=indicator_week,
y= reorder(province,indicator_week),
yend=province,
color=Color),
arrow = arrow(length=unit(0.20,"cm"), ends="last", type = "closed"),size=1)+
geom_line (aes(x=indicator_week,
y= as.numeric(reorder(province,indicator_week))),
size=4, alpha=0.5, color = "gray") +
scale_colour_manual('', values = c('Descenso'='steelblue4', 'Incremento'='red4')) +
scale_x_continuous(limit = c(-left_margin,max_size),
breaks=seq(0, max_size, by = skip)) +
labs(title = paste (ola, week),
subtitle = paste("Diferencia semanal de ",text_indicator, "por provincias"),
x = paste (text_indicator, "(por 100.000 habitantes)"),
caption = "By @congosto\n Fuente: @escovid19data. https://github.com/montera34/escovid19data")+
theme_a() +
theme(axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.x=element_blank(),
axis.ticks.y=element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(colour = "gray")) +
ggsave(paste0(prefix_file,week,".png"),width = 160, height = 90,unit="mm")
}
#duplicamos la última gráfica para ralentizar su vsualización
ggsave(paste0(prefix_file,week,"_a.png"), width = 160, height = 90,unit="mm")
ggsave(paste0(prefix_file,week,"_b.png"), width = 160, height = 90,unit="mm")
ggsave(paste0(prefix_file,week,"_c.png"), width = 160, height = 90,unit="mm")
ggsave(paste0(prefix_file,week,"_d.png"), width = 160, height = 90,unit="mm")
# Preparo frame del final
text <- paste("Fin de la animación.\n\n",
"Hecha con datos de @escovid19data\n\n",
"https://github.com/montera34/escovid19data")
ggplot() +
annotate("text", x = 4, y = 25, size=8, label = text) +
theme_void()
ggsave(paste0(prefix_file,"9999_fin",".png"),width = 160, height = 90,unit="mm")
ggsave(paste0(prefix_file,"9999_fin_a",".png"),width = 160, height = 90,unit="mm")
ggsave(paste0(prefix_file,"9999_fin_b",".png"),width = 160, height = 90,unit="mm")
ggsave(paste0(prefix_file,"9999_fin_c",".png"),width = 160, height = 90,unit="mm")
ggsave(paste0(prefix_file,"9999_fin_d",".png"),width = 160, height = 90,unit="mm")
return (diff)
}Evolución de hopilatizados por semanas y provincias
diff <- tendencia (provincias,"hospitalized_nor", "Hospitalizados",250,50,1)## [1] "2020-03-11" "2020-03-18" "2020-03-25" "2020-04-01" "2020-04-08"
## [6] "2020-04-15" "2020-04-22" "2020-04-29" "2020-05-06" "2020-05-13"
## [11] "2020-05-20" "2020-05-27" "2020-06-03" "2020-06-10" "2020-06-17"
## [16] "2020-06-24" "2020-07-01" "2020-07-08" "2020-07-15" "2020-07-22"
## [21] "2020-07-29" "2020-08-05" "2020-08-12" "2020-08-19" "2020-08-26"
## [26] "2020-09-02" "2020-09-09" "2020-09-16" "2020-09-23" "2020-09-30"
## [31] "2020-10-07" "2020-10-14" "2020-10-21" "2020-10-28" "2020-11-04"
## [36] "2020-11-11" "2020-11-18" "2020-11-25" "2020-12-02" "2020-12-09"
## [41] "2020-12-16" "2020-12-23" "2020-12-25" "2021-01-01" "2021-01-08"
## [46] "2021-01-15" "2021-01-22" "2021-01-29" "2021-02-05" "2021-02-12"
## [51] "2021-02-19" "2021-02-26" "2021-03-05" "2021-03-12" "2021-03-19"
## [56] "2021-03-26" "2021-04-02" "2021-04-09" "2021-04-16" "2021-04-23"
## [61] "2021-04-30" "2021-05-07" "2021-05-14" "2021-05-21" "2021-05-28"
## [66] "2021-06-04" "2021-06-11" "2021-06-18" "2021-06-25" "2021-07-02"
## [71] "2021-07-09" "2021-07-16" "2021-07-23" "2021-07-30" "2021-08-06"
## [76] "2021-08-13" "2021-08-20" "2021-08-27" "2021-09-03"# generamos el gif aninado
file_anim= paste0("images/tendencia_hospitalized_nor.gif")
list.files(path = "./tmp/",
pattern = "*.png", full.names = T) %>%
map(image_read) %>% # lee las imagenes del directorio
image_join() %>% # une las imagenes
image_animate(fps=1) %>% # genera la animacion
image_write(file_anim) # la guarda en un fichero .gif
Grafica