class: center, middle, inverse, title-slide # Laboratorio Bio-demografico ## Lezione 8 ### Nicola Barban <br> Alma Mater Studiorum Università di Bologna <br> Dipartimento di Scienze Statistiche ### 3 Marzo 2021<br> <img src="../img/UniBo-Universita-di-Bologna.png" style="width:20.0%" /> --- --- # Outline ## Dati ## Pacchetti R --- # Carico dati regionali ```r library(readr) library(tidyverse) regioni <- read_csv("regioni.csv", skip = 1) %>% select(Regione, eta=Età, maschi=`Totale Maschi` , femmine=`Totale Femmine`) %>% filter(eta!="Totale") %>% mutate(eta=as.numeric(eta)) #View(regioni) ``` --- # Creo classi di età (5 anni) ```r regioni5eta<-regioni %>% mutate(eta5=cut(eta, breaks=c(0,5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80,85,90,95,101), right = FALSE)) %>% group_by(Regione, eta5) %>% summarize(maschi=sum(maschi), femmine=sum(femmine)) ``` --- ```r g1 <- ggplot(subset(regioni5eta, Regione=="Veneto"), aes(x = eta5)) + geom_bar(aes(y=femmine/1000, fill="#990099"), stat = "identity",) + geom_bar(aes(y=maschi/1000 *(-1), fill="#009900"), stat = "identity") + coord_flip() + labs(title="Regione Veneto, 2020", x = "Età - intervalli 5 anni", y = "Popolazione (in migliaia)", caption = "Dati ISTAT, Bilancio Popolazione 2020") + theme_bw() + scale_fill_manual(name = "Sesso", label = c("Maschi", "Femmine"), values = c("#009900", "#990099"))+ theme( legend.position="bottom") ``` --- # Piramide di popolazione ```r g1 ``` <img src="lezione8_files/figure-html/unnamed-chunk-4-1.png" width="40%" /> --- # Creo frequenze relative ```r regioniTot <- read_csv("regioni.csv", skip = 1) %>% filter(Età=="Totale") %>% select(Regione, Tot.maschi=`Totale Maschi` , Tot.femmine=`Totale Femmine`) #View(regioni) regioni5eta <- left_join(regioni5eta,regioniTot, by="Regione" ) glimpse(regioni5eta) ``` ``` ## Rows: 400 ## Columns: 6 ## Groups: Regione [20] ## $ Regione <chr> "Abruzzo", "Abruzzo", "Abruzzo", "Abruzzo", "Abruzzo", "Abruzzo"… ## $ eta5 <fct> "[0,5)", "[5,10)", "[10,15)", "[15,20)", "[20,25)", "[25,30)", "… ## $ maschi <dbl> 23981, 27984, 29423, 30437, 32356, 35116, 36745, 39727, 45175, 4… ## $ femmine <dbl> 22693, 26329, 27893, 27908, 29528, 33083, 35450, 38791, 44585, 5… ## $ Tot.maschi <dbl> 631743, 631743, 631743, 631743, 631743, 631743, 631743, 631743, … ## $ Tot.femmine <dbl> 662198, 662198, 662198, 662198, 662198, 662198, 662198, 662198, … ``` --- ```r g1.f <- ggplot(subset(regioni5eta, Regione=="Veneto"), aes(x = eta5)) + geom_bar(aes(y=femmine/Tot.femmine, fill="#990099"), stat = "identity",) + geom_bar(aes(y=maschi/Tot.maschi *(-1), fill="#009900"), stat = "identity") + coord_flip() + labs(title="Regione Veneto, 2020", x = "Età - intervalli 5 anni", caption = "Dati ISTAT, Bilancio Popolazione 2020") + theme_bw() + scale_fill_manual(name = "Sesso", label = c("Maschi", "Femmine"), values = c("#009900", "#990099"))+ theme( legend.position="bottom") + scale_y_continuous( "", labels = function(br) abs(br)) ## solo valori positivi ``` --- # Piramide di popolazione (freq. relative) ```r g1.f ``` <img src="lezione8_files/figure-html/unnamed-chunk-7-1.png" width="40%" /> --- # Creo funzione ```r plot_piramide<-function(dati=regioni5eta, regione){ ggplot(subset(regioni5eta, Regione==regione), aes(x = eta5)) + geom_bar(aes(y=femmine/Tot.femmine, fill="#990099"), stat = "identity",) + geom_bar(aes(y=maschi/Tot.maschi *(-1), fill="#009900"), stat = "identity") + coord_flip() + labs(title=paste("Regione ",regione, sep=""), x = "Età - intervalli 5 anni", y = "Popolazione", caption = "Dati ISTAT, Bilancio Popolazione 2020") + theme_bw() + scale_fill_manual(name = "Sesso", label = c("Maschi", "Femmine"), values = c("#009900", "#990099"))+ theme( legend.position="bottom") + scale_y_continuous( "", labels = function(br) abs(br)) } ``` --- # uso la funzione `plot_piramide()` ```r plot_piramide(regione="Emilia-Romagna") ``` <img src="lezione8_files/figure-html/unnamed-chunk-9-1.png" width="40%" /> --- # indice dipendenza anziani *Indice Dipendenza Anziani* : rapporto tra popolazione di 65 anni e più e popolazione in età attiva (15-64 anni), moltiplicato per 100. --- ```r plot_piramide(regione="Emilia-Romagna")+ geom_rect(aes(xmin = 3, xmax = 13, ymin = -.2, ymax = .2), alpha=0.05, fill="pink")+ geom_rect(aes(xmin = 13, xmax = 21, ymin = -.2, ymax = .2), alpha=0.05, fill="grey")+ annotate("text", x=16, y=.1, label= paste("Anziani"))+ annotate("text", x=6, y=.1, label= paste("Età attiva")) ``` <img src="lezione8_files/figure-html/unnamed-chunk-10-1.png" width="40%" /> --- # creo funzione per calcolare Indice Dip. Anziani ```r IDA<-function(data, old, young){ rate<- data %>% summarise(IDA=100*sum(old)/sum(young)) return(rate) } ``` --- # calcolo IDA in tutte le regioni ```r regioni_tot <-regioni %>% mutate(tot=maschi+femmine, old= (eta >=65)*tot, young =(eta <65 &eta>=15)*tot) ``` --- ```r rate.veneto<-IDA(data=subset(regioni_tot, Regione=="Veneto"), old=old, young=young) ``` --- # Estraggo nomi regioni ```r nomi.regioni<-unique(regioni$Regione) nomi.regioni ``` ``` ## [1] "Piemonte" "Valle d'Aosta/Vallée d'Aoste" ## [3] "Lombardia" "Trentino-Alto Adige/Südtirol" ## [5] "Veneto" "Friuli-Venezia Giulia" ## [7] "Liguria" "Emilia-Romagna" ## [9] "Toscana" "Umbria" ## [11] "Marche" "Lazio" ## [13] "Abruzzo" "Molise" ## [15] "Campania" "Puglia" ## [17] "Basilicata" "Calabria" ## [19] "Sicilia" "Sardegna" ``` --- # ciclo for ```r for (i in 1:10){ print(i^2) } ``` ``` ## [1] 1 ## [1] 4 ## [1] 9 ## [1] 16 ## [1] 25 ## [1] 36 ## [1] 49 ## [1] 64 ## [1] 81 ## [1] 100 ``` --- Creo tabella con IDA ```r tabella_IDA <- tibble(regione=nomi.regioni, indice=0) tabella_IDA ``` ``` ## # A tibble: 20 x 2 ## regione indice ## <chr> <dbl> ## 1 Piemonte 0 ## 2 Valle d'Aosta/Vallée d'Aoste 0 ## 3 Lombardia 0 ## 4 Trentino-Alto Adige/Südtirol 0 ## 5 Veneto 0 ## 6 Friuli-Venezia Giulia 0 ## 7 Liguria 0 ## 8 Emilia-Romagna 0 ## 9 Toscana 0 ## 10 Umbria 0 ## 11 Marche 0 ## 12 Lazio 0 ## 13 Abruzzo 0 ## 14 Molise 0 ## 15 Campania 0 ## 16 Puglia 0 ## 17 Basilicata 0 ## 18 Calabria 0 ## 19 Sicilia 0 ## 20 Sardegna 0 ``` --- ```r for ( i in 1:20){ tabella_IDA$indice[i]<-IDA(data=subset(regioni_tot, Regione==nomi.regioni[i]), old=old, young=young)[[1]] } print(tabella_IDA) ``` ``` ## # A tibble: 20 x 2 ## regione indice ## <chr> <dbl> ## 1 Piemonte 41.8 ## 2 Valle d'Aosta/Vallée d'Aoste 38.5 ## 3 Lombardia 35.9 ## 4 Trentino-Alto Adige/Südtirol 33.0 ## 5 Veneto 36.5 ## 6 Friuli-Venezia Giulia 43.0 ## 7 Liguria 47.7 ## 8 Emilia-Romagna 38.4 ## 9 Toscana 41.5 ## 10 Umbria 42.0 ## 11 Marche 40.4 ## 12 Lazio 34.3 ## 13 Abruzzo 38.3 ## 14 Molise 39.7 ## 15 Campania 28.9 ## 16 Puglia 34.9 ## 17 Basilicata 36.3 ## 18 Calabria 34.2 ## 19 Sicilia 33.5 ## 20 Sardegna 37.8 ``` --- # Grafico IDA ```r tabella_IDA %>% ggplot(aes(x=fct_reorder(regione,indice), y=indice)) + geom_bar(stat="identity", fill="purple")+ coord_flip()+ theme_bw()+ xlab("Regione")+ ylab("Indice Dipendenza Anziani") ``` <img src="lezione8_files/figure-html/unnamed-chunk-18-1.png" width="40%" /> --- Includo indice nella piramide ```r indiceER<-round(IDA(data=subset(regioni_tot, Regione=="Emilia-Romagna"), old=old, young=young),2)[[1]] plot_piramide(regione="Emilia-Romagna")+ annotate("text", x=20, y=.05, label= paste("Indice Dipendenza Anziani =",indiceER,sep="") ) ``` <img src="lezione8_files/figure-html/unnamed-chunk-19-1.png" width="40%" /> --- # Creo piramidi di popolazione per tutte le regioni ```r for ( i in 1:20){ indice_temp<-round(IDA(data=subset(regioni_tot, Regione==nomi.regioni[i]), old=old, young=young),2)[[1]] plot_piramide(regione=nomi.regioni[i])+ annotate("text", x=20, y=0.05, label= paste("Indice Dipendenza Anzianità =",indice_temp,sep="") )+ ggsave(paste("Piramide_di_popolazione_",i, ".pdf", sep="" )) } ``` --- # Creo mappa indice dipendenza anziani ### Shape files da: https://www4.istat.it/it/archivio/209722 ```r library(sf) geo_reg <- st_read("Reg01012018_g_WGS84.shp") ``` ``` ## Reading layer `Reg01012018_g_WGS84' from data source `/Users/nicolabarban/Dropbox/Teaching/2021/labSOCIODEMO/webpage/LaboratorioBioDemografico2021/lezione8/Reg01012018_g_WGS84.shp' using driver `ESRI Shapefile' ## Simple feature collection with 20 features and 6 fields ## geometry type: MULTIPOLYGON ## dimension: XY ## bbox: xmin: 313279.3 ymin: 3933846 xmax: 1312016 ymax: 5220292 ## projected CRS: WGS 84 / UTM zone 32N ``` ```r head(geo_reg) ``` ``` ## Simple feature collection with 6 features and 6 fields ## geometry type: MULTIPOLYGON ## dimension: XY ## bbox: xmin: 313279.3 ymin: 4847853 xmax: 819674.3 ymax: 5220292 ## projected CRS: WGS 84 / UTM zone 32N ## COD_RIP COD_REG DEN_REG SHAPE_LENG SHAPE_AREA SHAPE_LEN ## 1 1 1 Piemonte 1235676.2 25393876361 1235676.2 ## 2 1 2 Valle d'Aosta 311139.3 3258906689 311139.3 ## 3 1 3 Lombardia 1410209.0 23862410838 1410209.0 ## 4 2 5 Veneto 1056150.1 18343262708 1056150.1 ## 5 2 4 Trentino-Alto Adige 800893.7 13607548177 800893.7 ## 6 1 7 Liguria 825467.9 5415023333 825467.9 ## geometry ## 1 MULTIPOLYGON (((457749.5 51... ## 2 MULTIPOLYGON (((390652.6 50... ## 3 MULTIPOLYGON (((595652.4 51... ## 4 MULTIPOLYGON (((768124 5175... ## 5 MULTIPOLYGON (((743267.7 52... ## 6 MULTIPOLYGON (((459010.2 49... ``` --- # Merge data ```r tabella_IDA <-tabella_IDA %>% mutate(DEN_REG=regione) %>% mutate(DEN_REG = recode(DEN_REG, "Valle d'Aosta/Vallée d'Aoste"="Valle d'Aosta" , "Trentino-Alto Adige/Südtirol"="Trentino-Alto Adige" , "Friuli-Venezia Giulia"="Friuli Venezia Giulia", )) IDA_reg<-left_join(geo_reg,tabella_IDA, by="DEN_REG" ) ``` --- ```r library(tmap) library(viridis) mapIDA<-tm_shape(IDA_reg) + tm_polygons(title="Indice Dipendenza Anziani", col="indice", palette = "-viridis", n=6)+ tm_style("white")+ tm_layout(legend.outside = TRUE) ``` --- ```r mapIDA ``` <img src="lezione8_files/figure-html/unnamed-chunk-24-1.png" width="80%" /> --- # World Population Prospect ```r install.packages('wpp2019') ``` ``` ## Error in install.packages : Updating loaded packages ``` ```r library(wpp2019) data(popF) data(popM) POP<-full_join(popF, popM, by=c("country_code", "age", "name"), suffix=c("F", "M")) ``` --- # reshape long and wide ```r POP_long<- POP %>% pivot_longer(cols=-(1:3),names_to="Y", values_to="pop") POP_long<-POP_long %>% mutate(year=as.numeric(substr(Y,1,4)), sex= substr(Y,5,6)) %>% select(-Y) POP_wide<-POP_long %>% arrange(name,year, sex) %>% pivot_wider( names_from=sex , values_from =pop) ``` --- ```r newlevels=c( "0-4" , "5-9", "10-14", "15-19" ,"20-24" ,"25-29" ,"30-34", "35-39" ,"40-44" ,"45-49", "50-54" ,"55-59", "60-64" ,"65-69" ,"70-74", "75-79", "80-84", "85-89", "90-94","95-99", "100+" ) POP_wide<- POP_wide %>% mutate(age=fct_relevel(POP_wide$age,newlevels)) ``` --- ```r plot_piramideW<-function(dati=POP_wide, paese="Italy", anno="1950"){ dati %>% filter(name==paese, year==anno) %>% ggplot(aes(x = age)) + geom_bar(aes(y=F, fill="#990099"), stat = "identity",) + geom_bar(aes(y=M*(-1), fill="#009900"), stat = "identity") + coord_flip() + labs(title=paste(" ",paese, " anno ", anno, sep=""), x = "Età - intervalli 5 anni", y = "Popolazione", caption = "Dati WPP 2018") + theme_bw() + scale_fill_manual(name = "Sesso", label = c("Maschi", "Femmine"), values = c("#009900", "#990099"))+ theme( legend.position="bottom") + scale_y_continuous( "", labels = function(br) abs(br)) } ``` --- ```r plot_piramideW(paese="Italy", anno=1950) ``` <img src="lezione8_files/figure-html/unnamed-chunk-29-1.png" width="40%" /> --- ```r plot_piramideW(paese="India", anno=1950) ``` <img src="lezione8_files/figure-html/unnamed-chunk-30-1.png" width="40%" /> --- ```r library(ggpubr) China1960<-plot_piramideW(paese="China", anno=1960) China1980<-plot_piramideW(paese="China", anno=1980) China2000<-plot_piramideW(paese="China", anno=2000) China2020<-plot_piramideW(paese="China", anno=2020) ``` --- ```r ggarrange(China1960,China1980, China2000,China2020, ncol = 2, nrow = 2) ``` <img src="lezione8_files/figure-html/unnamed-chunk-32-1.png" width="40%" />