class: center, middle, inverse, title-slide # Laboratorio Bio-demografico ## Lezione 10. Grafici Interattivi e animazioni ### Nicola Barban
Alma Mater Studiorum Università di Bologna
Dipartimento di Scienze Statistiche ### 9 Marzo 2021 --- --- # Outline .center[## Creare grafici interattivi e animazioni ] ### Pacchetti usati: * `gganimate` * `plotly` * `animate` * `htmlwidgets` * `av` * `tidyverse` * `zoo` * `lubridate` * `gapminder` --- # Gapminder ```r library(gapminder) library(ggplot2) data(gapminder) g1<-ggplot( data=gapminder, aes(y=lifeExp, x= gdpPercap))+ geom_point(aes(color=continent))+ theme_minimal()+ ylab("Aspettativa di vita")+ xlab("PIL pro capite")+ scale_x_log10(labels=scales::dollar) #g1 ``` --- ```r g1 ``` <img src="lezione10_files/figure-html/unnamed-chunk-2-1.png" width="40%" /> --- # Grafico interattivo https://plotly-r.com ```r library(plotly) p1<-ggplotly(g1) p1 ```
--- # Salva html widget ```r library(htmlwidgets) saveWidget(p1, "p1.html", selfcontained = T, libdir = "lib") ``` --- # Aggiungo etichette ai dati ```r g2<-ggplot( data=gapminder, aes(y=lifeExp, x= gdpPercap, text = paste( "Paese: ", country, "\n", "anno: ", year, "\n", sep = "")))+ geom_point(aes(color=continent, group=country))+ theme_minimal()+ ylab("Aspettativa di vita")+ xlab("PIL pro capite")+ scale_x_log10(labels=scales::dollar) ``` --- # Rendo il grafico interattivo ```r ggplotly(g2) ```
--- # Animations ```r library(gganimate) a1<-ggplot( data=gapminder, aes(y=lifeExp, x= gdpPercap))+ geom_point(aes(color=continent, group=country))+ theme_minimal()+ ylab("Aspettativa di vita")+ xlab("PIL pro capite")+ scale_x_log10(labels=scales::dollar) ``` --- ```r A<-a1+ * transition_states(year) + ease_aes('linear')+ labs(title = "{closest_state}") ``` --- # Visulizzo e salvo la mia animation ```r A ``` <img src="lezione10_files/figure-html/unnamed-chunk-9-1.gif" width="40%" /> ```r anim_save("animation1.gif") ``` --- # Opzioni in *transition_states()* * `transition_length` definisce la lunghezza relativa della transizione de uno stato all'altro. * `state_length` definisce per quanto tempo (in termini relativi) ogni stato è visualizzato. * `wrap` se = TRUE, la visualizzazione viene proposta in loop --- # Opzioni in *transition_states()* ```r a1.2<-ggplot( data=gapminder, aes(y=lifeExp, x= gdpPercap))+ geom_point(aes(color=continent, group=country))+ theme_minimal()+ ylab("Aspettativa di vita")+ xlab("PIL pro capite")+ scale_x_log10(labels=scales::dollar)+ ease_aes('linear')+ labs(title = "{closest_state}") + transition_states(year , transition_length = 3, # 3/4 of total time for transitions state_length = 1, # 1/4 of time to display actual data wrap = FALSE) ``` --- ```r a1.2 ``` <img src="lezione10_files/figure-html/unnamed-chunk-11-1.gif" width="40%" /> --- # Shadow_wake() ```r A+ shadow_wake(wake_length = 0.5) ``` <img src="lezione10_files/figure-html/unnamed-chunk-12-1.gif" width="40%" /> --- # Shadow_wake() ```r A+ shadow_wake(wake_length = 0.8) ``` <img src="lezione10_files/figure-html/unnamed-chunk-13-1.gif" width="40%" /> --- ```r a2<-ggplot( data=gapminder, aes(y=lifeExp, x= gdpPercap))+ geom_point(aes(color=continent, group=country, size=log(pop), alpha=.3), show.legend = FALSE) + theme_minimal()+ ylab("Aspettativa di vita")+ xlab("PIL pro capite")+ scale_x_log10(labels=scales::dollar)+ transition_states(year, transition_length = 3, state_length = 1 ) + ease_aes('linear')+ labs(title = 'Year: {closest_state}') + * facet_wrap(~continent) ``` --- ```r a2 ``` <img src="lezione10_files/figure-html/unnamed-chunk-15-1.gif" width="40%" /> ---# Salvare animation in formato video ```r #install.packages("av") library(av) df <- animate(a2, renderer = av_renderer('animation2.mp4'), width = 1280, height = 720, res = 104, fps = 25) utils::browseURL('animation2.mp4') ``` --- # Scarico dati provinciali COVID ```r storicoProvince <- read.csv(file = "https://raw.githubusercontent.com/pcm-dpc/COVID-19/master/dati-province/dpc-covid19-ita-province.csv", stringsAsFactors = FALSE) storicoProvince <- subset(storicoProvince, codice_provincia<=111) storicoProvince$denominazione_regione[storicoProvince$denominazione_regione %in% list("P.A. Trento", "P.A. Bolzano")] <- "Trentino-Alto Adige" ``` --- # Creo dataset provinciale ```r library(zoo) covid_prov <- storicoProvince %>% group_by(codice_provincia) %>% mutate(diff_totale_casi = diff(c(0, totale_casi)), data=as.Date(data)) ``` --- # Creo dati settimanali ```r library(lubridate) covid_prov_sett <- covid_prov %>% mutate(week = week(data), year=year(data), time=year*100+week) %>% group_by(time,year, week,denominazione_regione, denominazione_provincia, codice_provincia) %>% summarise(diff_casi = sum(diff_totale_casi), data=min(data)) %>% arrange(year, week, denominazione_regione,denominazione_provincia) glimpse(covid_prov_sett) ``` ``` ## Rows: 5,992 ## Columns: 8 ## Groups: time, year, week, denominazione_regione, denominazione_provincia [5,992] ## $ time <dbl> 202008, 202008, 202008, 202008, 202008, 20200… ## $ year <dbl> 2020, 2020, 2020, 2020, 2020, 2020, 2020, 202… ## $ week <dbl> 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, … ## $ denominazione_regione <chr> "Abruzzo", "Abruzzo", "Abruzzo", "Abruzzo", "… ## $ denominazione_provincia <chr> "Chieti", "L'Aquila", "Pescara", "Teramo", "M… ## $ codice_provincia <int> 69, 66, 68, 67, 77, 76, 79, 78, 101, 80, 102,… ## $ diff_casi <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, … ## $ data <date> 2020-02-24, 2020-02-24, 2020-02-24, 2020-02-… ``` --- # Importo dati ISTAT ```r library(readr) ISTAT.prov <- read_csv("province.csv", col_types = cols(`Codice provincia` = col_integer()), skip = 1) Pop.prov <-ISTAT.prov %>% filter(Età=="Totale") %>% mutate(Tot.Pop=`Totale Maschi`+`Totale Femmine`) %>% select(codice_provincia="Codice provincia" , "Tot.Pop" ) ``` --- # Merge dati e calcolo incidenza ```r inc.prov<- full_join(covid_prov_sett,Pop.prov, by="codice_provincia" ) inc.prov<-inc.prov %>% mutate (incidenza=10^5*diff_casi/Tot.Pop) ``` --- # Seleziono 10 provincie ```r inc.prov <- inc.prov %>% group_by(time) %>% arrange(year, week, desc(incidenza)) %>% * mutate(rankingI = row_number()) %>% * filter(rankingI <=10) ``` --- # creo proptotipo grafico a barre ```r covid_anim_prov0 <- inc.prov %>% filter(week==1) %>% ggplot() + geom_col(aes(rankingI, incidenza, fill = denominazione_regione))+ coord_flip(clip = "off", expand = FALSE) covid_anim_prov0 ``` <img src="lezione10_files/figure-html/unnamed-chunk-23-1.png" width="40%" /> --- # Ordino le barre ```r covid_anim_prov0.1 <- covid_anim_prov0+ scale_x_reverse() covid_anim_prov0.1 ``` <img src="lezione10_files/figure-html/unnamed-chunk-24-1.png" width="40%" /> --- # Aggiungo etichette ai dati ```r covid_anim_prov0.2<-covid_anim_prov0.1+ geom_text(aes(rankingI, incidenza, label = round(incidenza,0)), hjust=-0.1) + geom_text(aes(rankingI, y=0 , label = denominazione_provincia), hjust=1.1) + geom_text(aes(x=10, y=max(incidenza) , label = format(data, "%d %B %Y"))) covid_anim_prov0.2 ``` <img src="lezione10_files/figure-html/unnamed-chunk-25-1.png" width="40%" /> --- # cambio estetica assi ```r covid_anim_prov0.3<-covid_anim_prov0.2+ theme_minimal() + theme( panel.grid = element_blank(), legend.position = "none", axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.text.y = element_blank(), plot.margin = margin(1, 4, 1, 3, "cm"))+ labs(y="", subtitle="per 100.000 abitanti", caption= "Dati Protezione civile", title="Incidenza settimanale") ``` --- ```r covid_anim_prov0.3 ``` <img src="lezione10_files/figure-html/unnamed-chunk-27-1.png" width="40%" /> --- # Barchart race ```r *covid_anim_prov_base <- inc.prov %>% ggplot() + geom_col(aes(rankingI, incidenza, fill = denominazione_regione)) + scale_x_reverse()+ geom_text(aes(rankingI, incidenza, label = round(incidenza,0)), hjust=-0.1) + geom_text(aes(rankingI, y=0 , label = denominazione_provincia), hjust=1.1) + geom_text(aes(x=10, y=max(incidenza) , label = format(data, "%d %B %Y")), vjust = 0.2, alpha = 0.5, col = "gray", size = 14) + coord_flip(clip = "off", expand = FALSE) + theme_minimal() + theme( panel.grid = element_blank(), legend.position = "none", axis.ticks.y = element_blank(), axis.title.y = element_blank(), axis.text.y = element_blank(), plot.margin = margin(1, 4, 1, 3, "cm"))+ labs(y="", subtitle="per 100.000 abitanti", caption= "Dati Protezione civile", title="Incidenza settimanale") ``` --- ```r covid_anim_prov<- covid_anim_prov_base + transition_states(data, state_length = 3, transition_length = 1) + enter_fade() + exit_fade() + ease_aes('linear') ``` --- ```r covid_anim_inc <- animate(covid_anim_prov, renderer = av_renderer('covid_incidenza_prov.mp4'), width = 1280, height = 720, res = 104, fps = 10, nframes = 200) utils::browseURL('covid_incidenza_prov.mp4') ``` --- ```r covid_anim_prov ``` <img src="lezione10_files/figure-html/unnamed-chunk-31-1.gif" width="40%" /> --- ```r storicoRegioni <- read.csv( file = "https://raw.githubusercontent.com/pcm-dpc/COVID-19/master/dati-regioni/dpc-covid19-ita-regioni.csv", stringsAsFactors = FALSE) %>% mutate(data=as.Date(data)) ``` --- # Confronto terapie intensive ```r plot_reg0<-storicoRegioni %>% filter(data>as.Date("2020-09-01")) %>% ggplot(aes(x=data, y=terapia_intensiva, group=denominazione_regione))+ geom_line(col="grey", alpha=0.2, size=2)+ geom_line(data=storicoRegioni %>% filter(data>as.Date("2020-09-01"),denominazione_regione=="Emilia-Romagna"), aes(y=terapia_intensiva, x=data),col="darkred", size=2)+ geom_line(data=storicoRegioni %>% filter(data>as.Date("2020-09-01"),denominazione_regione=="Lombardia"), aes(y=terapia_intensiva, x=data), col="darkgreen", size=2)+ annotate("text",x=as.Date("2020-09-15"), y=750, label="Lombardia", col="darkgreen")+ annotate("text",x=as.Date("2020-09-15"), y=500, label="Emilia-Romagna", col="darkred")+ theme_bw()+ labs(title = 'Terapia Intensiva. ', subtitle = "Emilia Romagna e Lombardia", y="Pazienti in TI", x="", caption="Fonte: Protezione Civile") ``` --- # Transition Reveal ```r plot_reg0+ transition_reveal(data) ``` <img src="lezione10_files/figure-html/unnamed-chunk-34-1.gif" width="40%" /> --- # creo una lista di grafici ```r r2<-list() k<-unique(storicoRegioni$denominazione_regione) length(k) ``` ``` ## [1] 21 ``` --- ```r for (i in 1:21){ r2[[i]]<- storicoRegioni %>% filter(data>as.Date("2020-09-01")) %>% ggplot(aes(x=data, y=terapia_intensiva, group=denominazione_regione))+ geom_line(col="grey", alpha=0.2, size=2)+ geom_line(data=storicoRegioni %>% filter(data>as.Date("2020-09-01"),denominazione_regione==k[i]), aes(y=terapia_intensiva, x=data),col="pink", size=2)+ theme_bw()+ labs(title = 'Terapia Intensiva. ', subtitle = k[i], y="Pazienti in TI", x="", caption="Fonte: Protezione Civile") } ``` --- ```r r2[[5]] ``` <img src="lezione10_files/figure-html/unnamed-chunk-37-1.png" width="40%" /> --- ```r library(animation) saveGIF( for (i in 1:21) plot(r2[[i]]), movie.name = "regioni_covid.gif" ) ``` ``` ## [1] TRUE ``` ---  ---