#=============================================================================
# ASCP PLACEMENT IN HAITI : POSTPROCESSING AND PLOTTING THE RESULTS
#
# Plotting and postprocessing scenarios for CHW manuscript (April 2021)
#
# created by : Clara Champagne (clara.champagne@swisstph.ch), Emilie Pothin
# 2020-2021
#
# 0. Import datasets
# 1. Plot the data on maps
# 2. Plot the scenarios and calculate the capacities
# 3. Compare with current placement (GAP analysis)
# 4. Plot results of robustness check on scenario C
#
#=============================================================================
#=============================================================================
rm(list=ls())
############################################################################
# LOAD LIBRARIES
############################################################################
library(raster)
library(sp)
library(reshape)
library(ggplot2)
library(rgeos)
library(gdistance)
library(RColorBrewer)
library(foreign)
library(broom)
library(maptools)
library(readxl)
library(dplyr)
library(spatialEco)
library(stringr)
library(cowplot)
library(tidyverse)
library(CHWplacement)
############################################################################
# SET UP DIRECTORY PATHS
############################################################################
### Define input layers directory
dirMain="." # to be updated with the corresponding path
dirPlots=file.path(dirMain,"figures") # to be updated with the desired path
dirInputs=file.path(dirMain,"input_data")
dirOutputs=file.path(dirMain, "outputs")
dirSPA=file.path(dirInputs,"SPA") # to be updated with the corresponding path
dirScripts="." # to be updated with the corresponding path
source(file.path(dirScripts,"functions_Post_Processing_figures.R"))
############################################################################
# LOAD FUNCTIONS
############################################################################
newproj=NULL
newproj <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84"
############################################################################
# STEP 0: IMPORT RELEVANT DATASETS
############################################################################
#### Names of input layers
#population
pop.FileName=file.path(dirInputs, "popadj20_1km.tif")
#section communale shapefile
seccom.NameFile=file.path(dirInputs,"Section Communale/HTIadm4poly.shp")
# dowloading the friction surface. shp arguments speeds up by selecting only the pixels in the shapefile
friction.FileName=file.path(dirInputs,"friction_surface_v47_wo.tif")
# list of health facilities in the SPA survey
point.locations.spa.FileName=file.path(dirSPA,"Haiti_SPA_GPSPTS_HTGE7BFLSR/HTGE7BFLSR.shp")
######################
# IMPORT CHW FILES
dpt.list2=c("GrandeAnse"="Grande Anse", "Nippes"="Nippes",
"NordEst"= "Nord Est","NordOuest"= "Nord Ouest",
"SudEst"="Sud Est","Nord"="Nord",
"ArtiboniteSud"="Artibonite Sud","ArtiboniteNord"="Artibonite Nord",
"CentreNord"="Centre Nord","CentreSud"="Centre Sud",
"OuestO"="Ouest O","OuestE"="Ouest E",
"Sud"="Sud", "AireMetro"="Aire metropolitaine")
switch_dpt=function(this_dept){
return(ifelse(this_dept %in% c("ArtiboniteSud","ArtiboniteNord"),"Artibonite",
ifelse(this_dept %in% c("CentreSud","CentreNord"),"Centre",
ifelse(this_dept %in% c("OuestE","OuestO"),"Ouest", this_dept))))
}
# list of scenarios
CHW.positions.scenarioA.CSLCP=data.frame()
CHW.positions.scenarioB.CSLCP=data.frame()
CHW.positions.scenarioCin.CSLCP=data.frame()
CHW.positions.scenarioCout.CSLCP=data.frame()
CHW.positions.scenarioCin2.CSLCP=data.frame()
for (i in names(dpt.list2)){
print(i)
this.data=read.csv(file.path(dirOutputs,paste0("clscp_60_buffer30_capa25001000300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
this.data$out=1
CHW.positions.scenarioB.CSLCP=rbind(CHW.positions.scenarioB.CSLCP,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("clscp_60_buffer60_capa40004000300in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
this.data$out=0
CHW.positions.scenarioCin.CSLCP=rbind(CHW.positions.scenarioCin.CSLCP,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("clscp_60_buffer60_capa25001000300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
this.data$out=1
CHW.positions.scenarioCout.CSLCP=rbind(CHW.positions.scenarioCout.CSLCP,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("clscp_60_buffer60_capa40001000300in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
this.data$out=0
CHW.positions.scenarioCin2.CSLCP=rbind(CHW.positions.scenarioCin2.CSLCP,this.data)
}
for (i in names(dpt.list2)[1:13]){
print(i)
this.data=read.csv(file.path(dirOutputs,paste0("clscp_60_buffer0_capa25001000300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
this.data$out=1
CHW.positions.scenarioA.CSLCP=rbind(CHW.positions.scenarioA.CSLCP,this.data)
}
this.data=read.csv(file.path(dirOutputs,paste0("clscp_60_buffer0_capa40004000300in0urbs2000/positions_popcov_","AireMetro",".csv")))
this.data$metro=1
this.data$out=1
this.data$dpt="AireMetro"
CHW.positions.scenarioA.CSLCP=rbind(CHW.positions.scenarioA.CSLCP,this.data)
######################
# IMPORT shapefile
# charge shapefile
seccom.shp=raster::shapefile(seccom.NameFile)
seccom.shp=spTransform(seccom.shp,newproj)
plot(seccom.shp)
# define aire metropolitaine
seccom.shp@data$departement=seccom.shp@data$NAME_1
seccom.shp@data$departement[seccom.shp@data$NAME_2=="Port-Au-Prince" & seccom.shp@data$ID_4< 73072]="Aire metropolitaine"
seccom.shp@data$departement[seccom.shp@data$departement=="Ouest"]="Reste Ouest"
# shapefile at department level
seccom.shp.union <- unionSpatialPolygons(seccom.shp, seccom.shp@data$departement)
# some corrections on the shapefile
seccom.shp@data$NAME_4[seccom.shp@data$ID_4==73112]="1ère Varreux"
seccom.shp@data$NAME_4[seccom.shp@data$ID_4==73113]
seccom.shp@data$ID_4[seccom.shp@data$ID_4==73532 & seccom.shp@data$NAME_4=="6ème Les Cayemites"]=73532.5
######################
# IMPORT POPULATION
### charge population raster
# charge file
population=raster(pop.FileName,proj4string = CRS(newproj))
names(population)= 'popadj'
population.haiti=mask(crop(population, seccom.shp), seccom.shp)
sum(values(population.haiti), na.rm = T)
# define urban and rural areas
population.urb.hai=DefineUrban(population.raster=population.haiti,
rururb_cutoff=300, min_urbsize=2000)
population.urb.hai.dummy=mask((!is.na(population.urb.hai)), seccom.shp)
#calculate basic ratios and summary statistics on rural/urban
pop.haiti=sum(values(population.haiti), na.rm = TRUE)
pop.haiti.urb=sum(values(population.urb.hai), na.rm = TRUE)
pop.haiti.rur=sum(values(mask(population.haiti,population.urb.hai, inverse=T)), na.rm = TRUE)
pop.haiti.urb/pop.haiti
pop.haiti.urb/2500+pop.haiti.rur/1000
pop.metrop=sum(values(mask(population.haiti, subset(seccom.shp,departement=="Aire metropolitaine" ))), na.rm = TRUE)
pop.nometrop=sum(values(mask(population.haiti, subset(seccom.shp,departement!="Aire metropolitaine" ))), na.rm = TRUE)
pop.haiti.urb.nometrop=sum(values(mask(population.urb.hai, subset(seccom.shp,departement!="Aire metropolitaine" ))), na.rm = TRUE)
pop.haiti.rur.nometrop=sum(values(mask(mask(population.haiti,population.urb.hai, inverse=T), subset(seccom.shp,departement!="Aire metropolitaine" ))), na.rm = TRUE)
pop.metrop/pop.haiti
pop.haiti.urb.nometrop/pop.haiti
pop.haiti.rur.nometrop/pop.haiti
pop.haiti.urb.nometrop/2500+pop.haiti.rur.nometrop/1000+pop.metrop/4000
# calculate surface for urban and rural
surface=population-population
values(surface)=1
surface2=mask(surface, seccom.shp)
area=sum(!is.na(surface2[])) # total shapefile surface
area.pop=sum(!is.na(population.haiti[])) # total populated surface
area.pop.urb=sum(!is.na(population.urb.hai[])) # total populated urban surface
area.pop/area
area.pop.urb/area
area.pop.urb/area.pop
###########################################################
# IMPORT TRAVEL TIME AND COMPUTE TIME TO HEALTH FACILITIES
### Friction and travel time
# charge frition raster
friction=raster(friction.FileName,proj4string = CRS(newproj))
friction.haiti=raster::crop(friction,seccom.shp) # crop before to reduce map size
friction.haiti=raster::mask(friction.haiti,seccom.shp)
friction.haiti=projectRaster(friction.haiti,population.haiti) # have the same extend and cell number as population raster
population.haiti=mask(population.haiti,friction.haiti) # keep only points for which we have a friction value
# compute the transition matrix
T <- gdistance::transition(friction.haiti, function(x) 1/mean(x), 8)
Haiti.T.GC <- gdistance::geoCorrection(T)
# CREATE SUB CATEGORIES OF HEALTH FACILITIES
# compute walking time to health facilites
SPA.shp=shapefile(point.locations.spa.FileName)
SPA.shp=spTransform(SPA.shp,newproj)
CCS.shp=subset(SPA.shp,SPATYPEN=="dispensaire/centre communautaire de sante")
# CALCULATE TRAVEL TIMES AND CREATE MASKED LAYERS
#to all health facilities
points.spa <- as.matrix(SPA.shp@coords)
access.raster.spa <- gdistance::accCost(Haiti.T.GC, points.spa)
access.raster.spa=mask(access.raster.spa,seccom.shp)
#to dispensaries (centres communautaires de sant?)
points.spa.CCS <- as.matrix(CCS.shp@coords)
access.raster.spa.CCS <- gdistance::accCost(Haiti.T.GC, points.spa.CCS )
access.raster.spa.CCS =mask(access.raster.spa.CCS ,seccom.shp)
# descriptive statistics on population totals
GreaterThanBuffer=access.raster.spa.CCS
GreaterThanBuffer[GreaterThanBuffer<=60]<-NA
population.haiti.buffer=mask(population.haiti,GreaterThanBuffer)
population.urb.hai.buffer=mask(population.urb.hai,GreaterThanBuffer)
pop.outside.buffer=sum(values(population.haiti.buffer), na.rm = TRUE)
pop.urb.outside.buffer=sum(values(population.urb.hai.buffer), na.rm = TRUE)
pop.outside.buffer/pop.haiti
pop.urb.outside.buffer/pop.haiti
(pop.haiti-pop.outside.buffer)/4000
pop.urb.outside.buffer/2500 + (pop.outside.buffer-pop.urb.outside.buffer)/1000
(pop.haiti-pop.outside.buffer)/4000+ pop.urb.outside.buffer/2500 + (pop.outside.buffer-pop.urb.outside.buffer)/1000
GreaterThanBuffer30=access.raster.spa.CCS
GreaterThanBuffer30[GreaterThanBuffer30<=30]<-NA
population.haiti.buffer30=mask(population.haiti,GreaterThanBuffer30)
population.urb.hai.buffer30=mask(population.urb.hai,GreaterThanBuffer30)
pop.outside.buffer30=sum(values(population.haiti.buffer30), na.rm = TRUE)
pop.urb.outside.buffer30=sum(values(population.urb.hai.buffer30), na.rm = TRUE)
pop.outside.buffer30/pop.haiti
pop.urb.outside.buffer30/2500 + (pop.outside.buffer30-pop.urb.outside.buffer30)/1000
##########################################
# CUSTOMIZING LEGENDS
colormapDT0=data.frame(color=c('#ffffb2','#fed976','#feb24c','#fd8d3c','#fc4e2a','#e31a1c','#b10026'))
colormapDT0$value=c(1,100,500,1000,5000,10000,1000000)
colormapDT0$label=c(colormapDT0$value[-7],">10000")
colormapDTrurub=data.frame(color=c('#ffffb2','#b10026'))
colormapDTrurub$value=c(-0.1,1)
colormapDTrurub$label=c("rural","urban")
colormapDTb=data.frame(color=rev(c('#d73027','#fdae61','#fee090','#e0f3f8','#abd9e9','lightblue3')))
colormapDTb$value=c(30,45,60,90,120,Inf)
colormapDTb$label=c(colormapDTb$value[-6],">120")
colormapDTb2=data.frame(color=rev(c('#f46d43','#fdae61','#fee090','#e0f3f8','#abd9e9','#74add1')))
colormapDTb2$value=c(0.01,0.025,0.05,0.075,0.1,0.5)*1000
colormapDTb2$label=colormapDTb2$value
#=======================================================
# 1. PLOT THE MAPS OF DATA
#======================================================
map_rururb<-PlotMap(population.urb.hai.dummy,Title.legend=" ",shpFile=seccom.shp,colormapDT=colormapDTrurub)
map_rururb<-map_rururb+theme(legend.key.size = unit(0.8, "cm"),legend.position = c(0.12, 0.7),legend.text=element_text(size=10),legend.title=element_text(size=10))
map_rururb
ggsave(map_rururb, file=file.path(dirPlots,"S1_Fig.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
seccom.shp.union2=SpatialPolygonsDataFrame(seccom.shp.union,data.frame(dpt=unique(seccom.shp$departement)), match.ID = F)
seccom.shp.union2@data=data.frame(dpt=unique(seccom.shp$NAME_1))
all_coords=as.data.frame(coordinates(seccom.shp.union2))
all_coords$dpt=row.names(all_coords)
#=======================================================
# 2. EXTRACT SCENARIOS
#=======================================================
# Scenarios
CHW.positions.scenarioA.CSLCP=plot_scenario_all_cslscp(CHW.positions.scenarioA.CSLCP, "scenarioA")
CHW.positions.scenarioB.CSLCP=plot_scenario_all_cslscp(CHW.positions.scenarioB.CSLCP, "scenarioB")
CHW.positions.scenarioC.CSLCP=plot_scenario_all_cslscp(rbind(CHW.positions.scenarioCin.CSLCP,CHW.positions.scenarioCout.CSLCP), "scenarioC")
CHW.positions.scenarioC2.CSLCP=plot_scenario_all_cslscp(rbind(CHW.positions.scenarioCin2.CSLCP,CHW.positions.scenarioCout.CSLCP), "scenarioC2")
###################################
# a. PLOT SCENARIOS PER DEPARTMENT
###################################
plot_dpt_ouest=plot_dpt_summary("Ouest")
ggsave(plot_dpt_ouest, file=file.path(dirPlots,"figure_all_Ouest.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
plot_dpt_GA=plot_dpt_summary("GrandeAnse")
ggsave(plot_dpt_GA, file=file.path(dirPlots,"figure_all_GrandeAnse.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff") # Fig2
plot_dpt_Sud=plot_dpt_summary("Sud")
ggsave(plot_dpt_Sud, file=file.path(dirPlots,"figure_all_Sud.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
plot_dpt_SudEst=plot_dpt_summary("SudEst")
ggsave(plot_dpt_SudEst, file=file.path(dirPlots,"figure_all_SudEst.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
plot_dpt_Nord=plot_dpt_summary("Nord")
ggsave(plot_dpt_Nord, file=file.path(dirPlots,"figure_all_Nord.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
plot_dpt_NordEst=plot_dpt_summary("NordEst")
ggsave(plot_dpt_NordEst, file=file.path(dirPlots,"figure_all_NordEst.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
plot_dpt_NordOuest=plot_dpt_summary("NordOuest")
ggsave(plot_dpt_NordOuest, file=file.path(dirPlots,"figure_all_NordOuest.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
plot_dpt_Centre=plot_dpt_summary("Centre")
ggsave(plot_dpt_Centre, file=file.path(dirPlots,"figure_all_Centre.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
plot_dpt_Nippes=plot_dpt_summary("Nippes")
ggsave(plot_dpt_Nippes, file=file.path(dirPlots,"figure_all_Nippes.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
plot_dpt_Artibonite=plot_dpt_summary("Artibonite")
ggsave(plot_dpt_Artibonite, file=file.path(dirPlots,"figure_all_Artibonite.tiff"), width=7.5, height=7, compression="lzw", bg="white", dpi=300, device="tiff")
##########################################################
# b. CALCULATE CAPACITIES AND SUMMARY STATISTICS ON SCENARIOS
##########################################################
# combine all files
capacities.all=rbind(CHW.positions.scenarioA.CSLCP %>% mutate(scenario="A"),
CHW.positions.scenarioB.CSLCP %>% mutate(scenario="B"),
CHW.positions.scenarioC.CSLCP %>% mutate(scenario="C"),
CHW.positions.scenarioC2.CSLCP %>% mutate(scenario="C2"))%>%
mutate(categories=factor(ifelse(metro==1, "Metropolitan", ifelse(is.rural==1, "Rural", "Urban"))),
urbrur=factor(ifelse(is.rural==0, "Urban", "Rural")),
close2CCS=factor(ifelse(out==0, "(close to\nCCS)", "(far from\nCCS)")))
capacities.all$categories=factor(capacities.all$categories, levels=c("Metropolitan","Urban","Rural"))
#total per scenarios
total_per_scen=data.frame(table(capacities.all$scenario))
names(total_per_scen)=c("scenario", "totalCHW")
print(total_per_scen)
# total and proportion per rural/urban/metropolitan
total_per_category=data.frame(table(capacities.all$categories,capacities.all$scenario)) %>%
rename(category=Var1, scenario=Var2,count=Freq) %>%
left_join(total_per_scen, by="scenario") %>%
mutate(prop=round(100*count/totalCHW))
print(total_per_category)
# plot total CHW numbers
total_per_category %>%
mutate(totalCHW2=ifelse(category=="Metropolitan", total_per_category$totalCHW, NA),
category2=factor(category, levels=c("Metropolitan","Urban","Rural"))) %>%
ggplot(aes(x = scenario, y = count, fill =scenario, alpha= category2)) + # Create stacked bar chart
geom_bar(stat = "identity")+
scale_fill_manual(name="" ,values=c("darkorange", "darkgreen", "dodgerblue", "dodgerblue4"), guide=F)+
scale_alpha_manual(name="" ,values=c(1,0.7,0.4), labels=c("Metropolitan","Urban","Rural"), drop=F)+
labs(x="", y="Number of CHWs")+theme_bw()+
geom_text(aes(label = totalCHW2 , y=totalCHW2), vjust=-0.25, size=3, show.legend = FALSE)+
theme(axis.text = element_text(size=9),
axis.title = element_text(size=9), legend.text = element_text(size=10)) -> ggp2
ggp2
# plot average inh. per CHW
test_df=capacities.all %>%
mutate(categories_merge=factor(ifelse(scenario=="A", as.character(categories),as.character(urbrur)),levels=c("Metropolitan","Urban","Rural")) ,
scenario_far=ifelse(scenario %in% c("A"), scenario,paste0(scenario,"\n",close2CCS ))) %>%
group_by(scenario,close2CCS,categories_merge,scenario_far) %>%
summarise(mean=mean(capacities), q75=quantile(capacities, 0.9), q25=quantile(capacities, 0.05) )
test_df_all=capacities.all %>%
group_by(scenario) %>%
summarise(mean=mean(capacities), q75=quantile(capacities, 0.9), q25=quantile(capacities, 0.05) )%>%
mutate(scenario_far=paste0(scenario, "_Total"), close2CCS="Total", categories_merge="Total")
test_df_plot=rbind(test_df, test_df_all)
test_df_plot$scenario_far=factor(test_df_plot$scenario_far, levels=c("A_Total","A","B_Total", "B\n(far from\nCCS)","C_Total","C\n(close to\nCCS)","C\n(far from\nCCS)","C2_Total","C2\n(close to\nCCS)","C2\n(far from\nCCS)" ))
test_df_plot$categories_merge=factor(test_df_plot$categories_merge, levels=c("Total", "Metropolitan", "Urban", "Rural" ))
test_df_plot=arrange(test_df_plot, scenario_far)
test_df_plot$x.seq=c(1.2,2,2.5,3,4.2,5,5.5,6.7,7.5,8,8.7,9.2,10.4,11.2,11.7,12.4,12.9)
ggplot(test_df_plot, aes(x=x.seq, y=mean, fill=scenario_far, color=scenario_far, alpha=categories_merge, ymin=q25, ymax=q75, group=(categories_merge)))+
scale_alpha_manual(name="" ,values=c(0,1,0.7,0.4))+
geom_bar(stat="identity", position = position_dodge() )+
geom_errorbar(position = position_dodge(.9), alpha=1, width=0.2)+
ylim(-200,4100)+
geom_text(aes(x=1.2, y=0, label="Total \n "), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=4.2, y=0, label="Total \n "), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=6.7, y=0, label="Total \n "), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=10.4, y=0, label="Total \n "), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=5.2, y=0, label=" far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=7.7, y=0, label=" close \nto CCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=8.9, y=0, label=" far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=11.4, y=0, label=" close \nto CCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=12.6, y=0, label=" far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
scale_x_continuous(breaks = c(1.5, 4.85, 7.95, 11.65), labels=c("A", "B", "C", "C2"))+
scale_fill_manual(values = c("darkorange","darkorange", "darkgreen", "darkgreen","dodgerblue", "dodgerblue", "dodgerblue","dodgerblue4","dodgerblue4", "dodgerblue4"), guide=F)+
scale_color_manual(values = c("darkorange","darkorange", "darkgreen", "darkgreen","dodgerblue", "dodgerblue", "dodgerblue","dodgerblue4","dodgerblue4", "dodgerblue4"), guide=F)+
labs(y="Inhabitants per CHW", x="",
caption="Error bars indicate the 5% and 95% quantiles\nof the distribution over all CHWs.")+
theme_bw()+
guides(alpha = guide_legend(override.aes = list(colour = "black", size = 0.5)))+
theme(axis.text = element_text(size=9),
axis.title = element_text(size=9),
plot.caption = element_text(size=8), legend.text = element_text(size=9))-> plot_average
plot_average
# compbine both plots
plot2=plot_grid(ggp2+theme(legend.position = "none"),plot_average+theme(legend.position = "none"),
labels=c("1.","2."),ncol=2,scale=0.9, rel_widths = c(0.6,1),label_size = 20 )
legend <- get_legend(
# create some space to the left of the legend
plot_average + theme(legend.box.margin = margin(0, 0, 0, 0), legend.position = "bottom")
)
all_2legend=plot_grid(plot2,legend, ncol=1, rel_heights = c(1,0.07))
ggsave(all_2legend, file=file.path(dirPlots, "Fig3.tiff"), width=7.5, height=4, compression="lzw", bg="white", dpi=300, device="tiff")
dim(readTIFF(file.path(dirPlots, "Fig3.tiff")))
# supplementary plot on the number of CHW with few inh.
# get totals for C and C2
test_df_small_all=capacities.all %>% filter(scenario %in% c("C", "C2")) %>%
mutate(is.small=(capacities<100)) %>%
group_by(scenario) %>%
summarise(prop_100=sum(is.small))%>%
mutate(scenario_far=paste0(scenario, "_Total"), close2CCS="Total", categories_merge="Metropolitan")
# get totals per categories
test_df_small=capacities.all %>%
mutate(categories_merge=factor(ifelse(scenario=="A", as.character(categories),as.character(urbrur)),levels=c("Metropolitan","Urban","Rural")),
scenario_far=ifelse(scenario %in% c("A"), scenario,paste0(scenario,"\n",close2CCS )),
is.small=(capacities<100)) %>%
group_by(scenario,close2CCS,categories_merge,scenario_far, out) %>%
summarise(prop_100=sum(is.small))
test_df_plot_small=rbind(test_df_small, test_df_small_all)%>%
left_join(total_per_scen) %>% mutate(percentage=100*prop_100 /totalCHW )
test_df_plot_small$scenario_far=factor(test_df_plot_small$scenario_far, levels=c("A","B\n(far from\nCCS)","C_Total","C\n(close to\nCCS)","C\n(far from\nCCS)","C2_Total","C2\n(close to\nCCS)","C2\n(far from\nCCS)" ))
test_df_plot_small=arrange(test_df_plot_small, scenario_far)
test_df_plot_small$x.seq=c(1,1,1,3,3,5,6,6,7,7,8,9,9,10,10)
test_df_plot_small%>%
ggplot(aes(x=x.seq, y=percentage, fill=scenario_far, alpha=categories_merge, color=scenario))+
scale_alpha_manual(name="" ,values=c(1,0.7,0.4))+
geom_bar(stat="identity")+
scale_fill_manual(values = c("darkorange", "darkgreen", "white","dodgerblue","dodgerblue", "white", "dodgerblue4", "dodgerblue4"), guide=F)+
scale_color_manual(values = c("darkorange", "darkgreen", "dodgerblue", "dodgerblue4"), guide=F)+
labs(y="% of all CHWs in scenario\nwith <100 assigned inh.", x="")+
geom_text(aes(x=3, y=0, label="far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=5, y=0, label="Total\n "), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=6, y=0, label="close\nto CCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=7, y=0, label=" far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=8, y=0, label="Total\n "), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=9, y=0, label="close\nto CCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=10, y=0, label=" far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
scale_x_continuous(breaks = c(1, 3, 6, 9), labels=c("A", "B", "C", "C2"))+
scale_y_continuous(breaks = c(0, 0.5, 1, 1.5, 2, 2.5),labels = c("0%", "0.5%", "1%", "1.5%", "2%", "2.5%"), limits = c(-0.1,2.5))+
theme_bw()+
theme(axis.text = element_text(size=10),
axis.title = element_text(size=10), legend.text = element_text(size=10)) -> plot_small
plot_small
# supplementary plot on the number of CHW reaching the threshold
# get totals for C and C2
test_df_threshold_ungroup= capacities.all %>%
mutate(categories_merge=factor(ifelse(scenario=="A", as.character(categories),as.character(urbrur)),levels=c("Metropolitan","Urban","Rural")),
scenario_far=ifelse(scenario %in% c("A"), scenario,paste0(scenario,"\n",close2CCS )),
is.threshold4000=(capacities>=3995),
is.threshold2500=(capacities>=2495 & capacities<=2500 ),
is.threshold1000=(capacities>=995 & capacities<=1000 ),
threshold4000=((categories_merge =="Metropolitan") | (scenario=="C" & close2CCS == "(close to\nCCS)") | (scenario=="C2" & close2CCS == "(close to\nCCS)" & categories_merge =="Urban")),
threshold2500=(categories_merge =="Urban" & close2CCS == "(far from\nCCS)"),
threshold1000=(categories_merge =="Rural" & close2CCS == "(far from\nCCS)") | (scenario=="C2" & close2CCS == "close to CCS" & categories_merge =="Rural"),
test=as.numeric(threshold2500)+as.numeric(threshold4000)+as.numeric(threshold1000),
is.threshold=((threshold4000 &is.threshold4000)|(is.threshold2500&threshold2500)|(is.threshold1000&threshold1000)),
threshold=ifelse(threshold4000, 4000, ifelse(threshold2500, 2500, 1000)))
# get totals per categories
test_df_threshold= test_df_threshold_ungroup%>%
group_by(scenario,close2CCS,categories_merge,threshold,scenario_far) %>%
summarise(prop_4000=sum(is.threshold4000),
prop_2500=sum(is.threshold2500),
prop_1000=sum(is.threshold1000),
prop_threshold=sum(is.threshold),
test1=min(test), test2=max(test))
test_df_threshold_all= test_df_threshold_ungroup%>% filter(scenario %in% c("C", "C2")) %>%
group_by(scenario) %>%
summarise(prop_4000=sum(is.threshold4000),
prop_2500=sum(is.threshold2500),
prop_1000=sum(is.threshold1000),
prop_threshold=sum(is.threshold),
test1=min(test), test2=max(test))%>%
mutate(scenario_far=paste0(scenario, "_Total"), close2CCS="Total", categories_merge="Metropolitan")
test_df_plot_threshold=rbind(test_df_threshold, test_df_threshold_all)%>%
left_join(total_per_scen) %>% mutate(percentage=100*prop_threshold /totalCHW )
test_df_plot_threshold$scenario_far=factor(test_df_plot_threshold$scenario_far, levels=c("A","B\n(far from\nCCS)","C_Total","C\n(close to\nCCS)","C\n(far from\nCCS)","C2_Total","C2\n(close to\nCCS)","C2\n(far from\nCCS)" ))
test_df_plot_threshold=arrange(test_df_plot_threshold, scenario_far)
test_df_plot_threshold$x.seq=c(1,1,1,3,3,5,6,6,7,7,8,9,9,10,10)
test_df_plot_threshold%>%
ggplot(aes(x=x.seq, y=percentage, fill=scenario_far, color=scenario, alpha=categories_merge))+
scale_alpha_manual(name="" ,values=c(1,0.7,0.4))+
geom_bar(stat="identity")+
scale_fill_manual(values = c("darkorange", "darkgreen", "white","dodgerblue","dodgerblue", "white", "dodgerblue4", "dodgerblue4"), guide=F)+
scale_color_manual(values = c("darkorange", "darkgreen", "dodgerblue", "dodgerblue4"), guide=F)+
geom_text(aes(x=3, y=0, label="far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=5, y=0, label="Total\n "), vjust=1.2, size=1.7, color3="black", show.legend = FALSE)+
geom_text(aes(x=6, y=0, label="close\nto CCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=7, y=0, label=" far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=8, y=0, label="Total\n "), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=9, y=0, label="close\nto CCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
geom_text(aes(x=10, y=0, label=" far from\nCCS"), vjust=1.2, size=1.7, color="black", show.legend = FALSE)+
scale_x_continuous(breaks = c(1, 3, 6, 9), labels=c("A", "B", "C", "C2"))+
guides(pattern = guide_legend(override.aes = list(fill = "white")),
alpha = guide_legend(override.aes = list(pattern = "none"))) +
labs(y="% of all CHWs in scenario\nreaching the threshold population", x="")+
theme_bw()+
scale_y_continuous(breaks = c(0,10, 20, 30, 40,50, 60),labels = c("0%","10%", "20%", "30%", "40%","50%", "60%"), limits = c(-3,NA))+
theme(axis.text = element_text(size=10),
axis.title = element_text(size=10), legend.text = element_text(size=10)) -> plot_threshold
plot_threshold
# combine both plots
plot3=plot_grid(plot_threshold+theme(legend.position = "none"),plot_small+theme(legend.position = "none"),
labels=c("1.","2."),ncol=2,scale=0.9,label_size = 20 )
legend2 <- get_legend( plot_threshold + theme(legend.box.margin = margin(0, 0, 0, 0), legend.position = "bottom"))
all_3legend=plot_grid(plot3,legend, ncol=1, rel_heights = c(1,0.07))
ggsave(all_3legend, file=file.path(dirPlots, "S2_Fig.tiff"), width=7.5, height=4, compression="lzw", bg="white", dpi=300, device="tiff")
dim(readTIFF(file.path(dirPlots, "S2_Fig.tiff")))
########################
# Descriptive stats
# mean capacity per scenario
capacities.all %>%
group_by(scenario) %>%
dplyr::summarize( mean = mean(capacities),median = median(capacities), max=max(capacities), min=min(capacities),
q1=quantile(capacities, probs=0.25), q3=quantile(capacities, probs=0.75),
q025=quantile(capacities, probs=0.025), q975=quantile(capacities, probs=0.975),
q5=quantile(capacities, probs=0.05), q95=quantile(capacities, probs=0.95)) %>%
as.data.frame() %>% mutate(categories="Total")
# mean capacity per scenario per rural/urban/metropolitan
capacities.all %>%
group_by(scenario, categories) %>%
dplyr::summarize( mean = round(mean(capacities)),median = median(capacities),
max=max(capacities), min=min(capacities),
q1=quantile(capacities, probs=0.25), q3=quantile(capacities, probs=0.75),
q025=quantile(capacities, probs=0.025), q975=quantile(capacities, probs=0.975),
q5=quantile(capacities, probs=0.05), q95=quantile(capacities, probs=0.95)) %>%
as.data.frame()
mytable50=table(capacities.all$capacities<50, capacities.all$scenario)
mytable100=table(capacities.all$capacities<100, capacities.all$scenario)
prop.table(mytable50,2)
prop.table(mytable100,2)
table(capacities.all$capacities<100, capacities.all$scenario)
#=======================================================
# 3. GAP ANALYSIS
#=======================================================
##############
# SPA DATA
# Manipulate SPA data
# merge with the shapefile for GPS coordinates
data.spa=read.dta(file.path(dirSPA,"/HTFC7ADTSP/HTFC7AFLSP.DTA"))
data.spa$SPAFACID=data.spa$facil
data.spa=merge(data.spa, SPA.shp@data, all=TRUE)
#keep only facilities with CHWs and rename departments for merging
data.spa.withCHW=data.spa[data.spa$q3201b>0 & is.na(data.spa$q3201b)==FALSE,]
data.spa.withCHW$dept=data.spa.withCHW$departf
data.spa.withCHW$dept=gsub("-"," ",data.spa.withCHW$dept)
data.spa.withCHW$dept=gsub("grand","grande",data.spa.withCHW$dept)
data.spa.withCHW$dept=gsub("...aire métropolitaine","aire metropolitaine",data.spa.withCHW$dept)
data.spa.withCHW$dept=gsub("...reste ouest","reste ouest",data.spa.withCHW$dept)
# ASCP/ASC et superviseurs
data.spa.asc.list=read.dta(file.path(dirSPA,"/HTCS7ADTSP/HTCS7AFLSP.DTA"))
data.spa.asc.list=data.spa.asc.list[,c(1,300:398)]
data.spa.asc.list.melt=na.omit(melt(data.spa.asc.list, id.vars = "facil"))
data.spa.ascp=as.data.frame(table(data.spa.asc.list.melt$facil,data.spa.asc.list.melt$value))
data.spa.ascp=cast(data.spa.ascp, Var1~Var2)
names(data.spa.ascp)=c("facil","asc","ascp","superviseur")
data.spa.ascp$chw=data.spa.ascp$asc+data.spa.ascp$ascp #chw correspond to asc+ascp
data.spa.withCHW=merge(data.spa.ascp,data.spa.withCHW, all.x=TRUE)
# total numbers per department
spa.departements=aggregate((data.spa.withCHW$chw),by= list(dept=data.spa.withCHW$dept), FUN=sum)
names(spa.departements)=c("dept","nbCHW")
spa.departements$dept=gsub("...aire métropolitaine", "aire metropolitaine",spa.departements$dept)
#merge with section communale shapefile
dept=unique(seccom.shp@data[,c(2,12)])
dept$dept=tolower(dept$departement)
spa.departements=merge(spa.departements,dept, all=TRUE)
spa.departements$nbCHW_cut=cut(spa.departements$nbCHW, breaks=c(0,100,200,300,400,500,600,10000),include.lowest=TRUE, right=FALSE)
levels(spa.departements$nbCHW_cut)=c("<100","100-200","200-300","300-400","400-500","500-600", ">=600")
# have information on ASC and supervisors per department
ascp.spa.departements=aggregate((data.spa.withCHW$ascp),by= list(dept=data.spa.withCHW$dept), FUN=sum); names(ascp.spa.departements)=c("dept","ascp")
asc.spa.departements=aggregate((data.spa.withCHW$asc),by= list(dept=data.spa.withCHW$dept), FUN=sum); names(asc.spa.departements)=c("dept","asc")
superviseurs.spa.departements=aggregate((data.spa.withCHW$superviseur),by= list(dept=data.spa.withCHW$dept), FUN=sum); names(superviseurs.spa.departements)=c("dept","superviseurs")
CHW.spa.dpt=merge(spa.departements,ascp.spa.departements)
CHW.spa.dpt=merge(CHW.spa.dpt,asc.spa.departements)
CHW.spa.dpt=merge(CHW.spa.dpt,superviseurs.spa.departements)
CHW.spa.dpt$ascp.prop=CHW.spa.dpt$ascp/CHW.spa.dpt$nbCHW
CHW.spa.dpt$asc.prop=CHW.spa.dpt$asc/CHW.spa.dpt$nbCHW
spa.departements$case="SPA"
######################
# CARTOGRAPHIE
# values extracted from the Cartographie report.
# Because the Ouest department was not splitted in the report, I recalculated the numbers based on the various tables in the report.
# in RESTE OUEST : I found 285 ASCPs intégrés et 35 ASC intégrés (+ 2 ASCs are benevoles, so there are 37 ASCs in total, but only 35 intégrés) amounting to 320
# in METROPOLITAN AREA (Carrefour, Cité Soleil, Petion Ville, Delmas, Petion Ville, Tabarre): I found 1004 ASCPs intégrés and 107 ASC intégrés (+ 12 ASCs are benevoles, so there are 119 ASCs in total, but only 107 intégrés) amounting to 1111
cartographie_dpt=data.frame(departement=c("Aire metropolitaine", "Artibonite","Centre","Grande Anse","Nippes", "Nord","Nord Est","Nord Ouest","Reste Ouest", "Sud","Sud Est"),
nbCHW=c(1111,689,442,383,99,323,280,211,320,315,164))
#merge with section communale shapefile
dept=unique(seccom.shp@data[,c(2,12)])
cartographie_dpt=merge(cartographie_dpt,dept, all=TRUE)
cartographie_dpt$nbCHW_cut=cut(cartographie_dpt$nbCHW, breaks=c(0,100,200,300,400,500,600,10000),include.lowest=TRUE, right=FALSE)
levels(cartographie_dpt$nbCHW_cut)=c("<100","100-200","200-300","300-400","400-500","500-600", ">=600")
cartographie_dpt$case="Cartography"
#############################
# GAP PER DEPARTMENT
compare=capacities.all %>% group_by(dpt, scenario) %>% summarise(nbCHW=n())
compare$departement=as.character(compare$dpt)
compare$departement[compare$departement=="AireMetro"]="Metr. Area"
compare$departement[compare$departement=="GrandeAnse"]="Grande-Anse"
compare$departement[compare$departement=="NordEst"]="Nord-Est"
compare$departement[compare$departement=="NordOuest"]="Nord-Ouest"
compare$departement[compare$departement=="SudEst"]="Sud-Est"
compare$departement[compare$departement=="Ouest"]="Rest Ouest"
compare_data=spa.departements[c("nbCHW","departement","case")]
compare_data=merge(compare_data,cartographie_dpt, all=TRUE)
compare_data$departement[compare_data$departement=="Aire metropolitaine"]="Metr. Area"
compare_data$departement[compare_data$departement=="Grande Anse"]="Grande-Anse"
compare_data$departement[compare_data$departement=="Nord Est"]="Nord-Est"
compare_data$departement[compare_data$departement=="Nord Ouest"]="Nord-Ouest"
compare_data$departement[compare_data$departement=="Sud Est"]="Sud-Est"
compare_data$departement[compare_data$departement=="Reste Ouest"]="Rest Ouest"
p=ggplot( ) +
geom_bar(
data = compare_data
, aes(y = fct_reorder(departement, nbCHW), x = nbCHW, fill = case )
, stat = "identity"
, alpha = 0.5
, position = position_dodge(0.5) ) +
geom_point(
data = compare
, aes(y = departement, x = nbCHW, pch = scenario, col = scenario ), cex = 3)+
labs( y = ""
, x = "Number of agents"
, fill = "Current placement"
, pch ="Suggested scenarios"
, color = "Suggested scenarios"
, title = "")+
scale_fill_manual( values = c("grey55","grey21"))+
scale_color_manual( values = c("darkorange","darkgreen","dodgerblue","darkblue"))+
scale_shape_manual( values = c(19, 17, 15, 8))+
theme_minimal()+
theme(axis.text = element_text(size=12),
#axis.text.x = element_text(angle = 45),
axis.title = element_text(size=12),
legend.text = element_text(size=12),
legend.title = element_text(size=12)) + guides(shape = guide_legend(override.aes = list(size = 5)))
p
ggsave(p, file=file.path(dirPlots,"Fig4.tiff"), width=7.5, height=6, compression="lzw", bg="white", dpi=300, device="tiff")
dim(readTIFF(file.path(dirPlots, "Fig4.tiff")))
#############################
# GAP PER SECTION COMMUNALE
#total numbers per section communale
SPA.shp.seccom <- point.in.poly(SPA.shp, seccom.shp)
# convert to data frame, keeping your data
SPA.shp.seccom<- as.data.frame(SPA.shp.seccom) %>%
select(NAME_1, NAME_2, ID_4, NAME_4, departement, SPAFACID)
myvars=c("SPAFACID","chw","asc","ascp","superviseur", "q3201b")
SPA.shp.seccom=merge(SPA.shp.seccom,data.spa.withCHW[myvars], all=TRUE)
SPA.shp.seccom=SPA.shp.seccom[SPA.shp.seccom$chw>0 & is.na(SPA.shp.seccom$chw)==FALSE,]
spa.seccom=SPA.shp.seccom %>%
group_by(ID_4)%>%
summarise(nbCHWSPA=sum(chw, na.rm = TRUE),asc=sum(asc, na.rm = TRUE),ascp=sum(ascp, na.rm = TRUE),superviseur=sum(superviseur, na.rm = TRUE))%>%
filter(is.na(ID_4)==F)
spa.seccom.sp=sp::merge(seccom.shp,spa.seccom)
#plot the gap per section communale
plot.GapscenarioA.seccom=PlotGapScenarioSeccom(CHW.positions.scenarioA.CSLCP[,1:2])
plot.GapscenarioB.seccom=PlotGapScenarioSeccom(CHW.positions.scenarioB.CSLCP[,1:2])
plot.GapscenarioC.seccom=PlotGapScenarioSeccom(CHW.positions.scenarioC.CSLCP[,1:2])
plot.GapscenarioC2.seccom=PlotGapScenarioSeccom(CHW.positions.scenarioC2.CSLCP[,1:2])
# combined plot for scenario C
# create the plots for all scenarios
plot.CHW.positions.scenarioC.CSLCP=plot_scenario_all_cslscp_plots(rbind(CHW.positions.scenarioCin.CSLCP,CHW.positions.scenarioCout.CSLCP), "scenarioC")
figure5=plot_grid(plot.CHW.positions.scenarioC.CSLCP$map_seccom,plot.GapscenarioC.seccom$plot, labels=c("1.", "2.") )
ggsave(figure5, file=file.path(dirPlots,"Fig5.tiff"), width=7.5, height=4.5, compression="lzw", bg="white", dpi=300, device="tiff")
dim(readTIFF(file.path(dirPlots, "Fig5.tiff")))
plot.CHW.positions.scenarioA.CSLCP=plot_scenario_all_cslscp_plots(rbind(CHW.positions.scenarioA.CSLCP), "scenarioA")
plot.CHW.positions.scenarioB.CSLCP=plot_scenario_all_cslscp_plots(rbind(CHW.positions.scenarioB.CSLCP), "scenarioB")
plot.CHW.positions.scenarioC2.CSLCP=plot_scenario_all_cslscp_plots(rbind(CHW.positions.scenarioCin2.CSLCP,CHW.positions.scenarioCout.CSLCP), "scenarioC2")
figure5_A=plot_grid(plot.CHW.positions.scenarioA.CSLCP$map_seccom+theme(legend.text=element_text(size=7), legend.key.size =unit(.2, "in"), legend.title =element_text(size=9)),
plot.GapscenarioA.seccom$plot+theme(legend.text=)+theme(legend.text=element_text(size=7), legend.key.size =unit(.15, "in"), legend.title =element_text(size=9) ),
labels=c(" 1.", "2."), label_size = )
figure5_B=plot_grid(plot.CHW.positions.scenarioB.CSLCP$map_seccom+theme(legend.text=element_text(size=7), legend.key.size =unit(.2, "in"), legend.title =element_text(size=9)),
plot.GapscenarioB.seccom$plot+theme(legend.text=element_text(size=7), legend.key.size =unit(.15, "in"), legend.title =element_text(size=9)),
labels=c(" 1.", "2.") )
figure5_C2=plot_grid(plot.CHW.positions.scenarioC2.CSLCP$map_seccom+theme(legend.text=element_text(size=7), legend.key.size =unit(.2, "in"), legend.title =element_text(size=9)),
plot.GapscenarioC2.seccom$plot+theme(legend.text=element_text(size=7), legend.key.size =unit(.15, "in"), legend.title =element_text(size=9)),
labels=c(" 1.", "2.") )
figure5_all_supp=plot_grid(figure5_A, figure5_B, figure5_C2, nrow = 3, labels = c("A.", "B.", "C2."))
ggsave(figure5_all_supp, file=file.path(dirPlots,"S3_fig.tiff"), width=6.5, height=8.75, compression="lzw", bg="white", dpi=300, device="tiff")
dim(readTIFF(file.path(dirPlots, "S3_fig.tiff")))
#=======================================================
# 3. ROBUSTNESS CHECK ON SCENARIO C
#=======================================================
################################################
# Charge the scenario files
###############################################
# change radius
Cin_rad54=data.frame()
Cout_rad54=data.frame()
Cin_rad66=data.frame()
Cout_rad66=data.frame()
for (i in names(dpt.list2)){
print(i)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_54_buffer60_capa40004000300in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_rad54=rbind(Cin_rad54,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_54_buffer60_capa25001000300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_rad54=rbind(Cout_rad54,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_66_buffer60_capa40004000300in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_rad66=rbind(Cin_rad66,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_66_buffer60_capa25001000300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_rad66=rbind(Cout_rad66,this.data)
}
# change buffer to CCS
Cin_buff54=data.frame()
Cout_buff54=data.frame()
Cin_buff66=data.frame()
Cout_buff66=data.frame()
for (i in names(dpt.list2)){
print(i)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer54_capa40004000300in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_buff54=rbind(Cin_buff54,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer54_capa25001000300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_buff54=rbind(Cout_buff54,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer66_capa40004000300in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_buff66=rbind(Cin_buff66,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer66_capa25001000300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_buff66=rbind(Cout_buff66,this.data)
}
# change capacity
Cin_capaP=data.frame()
Cout_capaP=data.frame()
Cin_capaM=data.frame()
Cout_capaM=data.frame()
for (i in names(dpt.list2)){
print(i)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa44004400300in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_capaP=rbind(Cin_capaP,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa27501100300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_capaP=rbind(Cout_capaP,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa36003600300in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_capaM=rbind(Cin_capaM,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa2250900300in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_capaM=rbind(Cout_capaM,this.data)
}
# change urban definition
Cin_clump270=data.frame()
Cout_clump270=data.frame()
Cin_clump330=data.frame()
Cout_clump330=data.frame()
for (i in names(dpt.list2)){
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa40004000270in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_clump270=rbind(Cin_clump270,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa25001000270in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_clump270=rbind(Cout_clump270,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa40004000330in1urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_clump330=rbind(Cin_clump330,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa25001000330in0urbs2000/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_clump330=rbind(Cout_clump330,this.data)
}
# change urban definition
Cin_urb2200=data.frame()
Cout_urb2200=data.frame()
Cin_urb1800=data.frame()
Cout_urb1800=data.frame()
for (i in names(dpt.list2)){
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa40004000300in1urbs2200/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_urb2200=rbind(Cin_urb2200,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa25001000300in0urbs2200/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_urb2200=rbind(Cout_urb2200,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa40004000300in1urbs1800/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cin_urb1800=rbind(Cin_urb1800,this.data)
this.data=read.csv(file.path(dirOutputs,paste0("SA/clscp_60_buffer60_capa25001000300in0urbs1800/positions_popcov_",i,".csv")))
this.data$metro=ifelse(i=="AireMetro" , 1, 0)
this.data$dpt=switch_dpt(i)
Cout_urb1800=rbind(Cout_urb1800,this.data)
}
scenarioC=plot_scenario_all_cslscp(rbind(CHW.positions.scenarioCin.CSLCP,CHW.positions.scenarioCout.CSLCP) %>%
mutate(capacity=my.list.capa.here), "scenarioC_baseline") %>% mutate(updown="baseline")
scenarioCrad54=plot_scenario_all_cslscp_new_names(rbind(Cin_rad54 %>% mutate(out=0),Cout_rad54 %>% mutate(out=1)), "scenarioC_rad54")%>% mutate(updown="-10%", sensi1="rad")
scenarioCrad66=plot_scenario_all_cslscp_new_names(rbind(Cin_rad66 %>% mutate(out=0),Cout_rad66 %>% mutate(out=1)), "scenarioC_rad66") %>% mutate(updown="+10%", sensi1="rad")
scenarioCcapaM=plot_scenario_all_cslscp_new_names(rbind(Cin_capaM %>% mutate(out=0),Cout_capaM %>% mutate(out=1)), "scenarioC_capaM")%>% mutate(updown="-10%", sensi1="cap")
scenarioCcapaP=plot_scenario_all_cslscp_new_names(rbind(Cin_capaP %>% mutate(out=0),Cout_capaP %>% mutate(out=1)), "scenarioC_capaP")%>% mutate(updown="+10%", sensi1="cap")
scenarioCbuff54=plot_scenario_all_cslscp_new_names(rbind(Cin_buff54 %>% mutate(out=0),Cout_buff54 %>% mutate(out=1)), "scenarioC_buff55")%>% mutate(updown="-10%", sensi1="buf")
scenarioCbuff66=plot_scenario_all_cslscp_new_names(rbind(Cin_buff66 %>% mutate(out=0),Cout_buff66 %>% mutate(out=1)), "scenarioC_buff65")%>% mutate(updown="+10%", sensi1="buf")
scenarioCclump270=plot_scenario_all_cslscp_new_names(rbind(Cin_clump270 %>% mutate(out=0),Cout_clump270 %>% mutate(out=1)), "scenarioC_clump200")%>% mutate(updown="-10%", sensi1="clu")
scenarioCclump330=plot_scenario_all_cslscp_new_names(rbind(Cin_clump330 %>% mutate(out=0),Cout_clump330 %>% mutate(out=1)), "scenarioC_clump400")%>% mutate(updown="+10%", sensi1="clu")
scenarioCurb1800=plot_scenario_all_cslscp_new_names(rbind(Cin_urb1800 %>% mutate(out=0),Cout_urb1800 %>% mutate(out=1)), "scenarioC_urb1950")%>% mutate(updown="-10%", sensi1="urb")
scenarioCurb2200=plot_scenario_all_cslscp_new_names(rbind(Cin_urb2200 %>% mutate(out=0),Cout_urb2200 %>% mutate(out=1)), "scenarioC_urb2050")%>% mutate(updown="+10%", sensi1="urb")
################################################
# Combine the files to create national level summary plots
###############################################
capacities.all.sensi=rbind(scenarioC %>% mutate(sensi1="rad", my.list.capa.here=NULL),
scenarioC %>% mutate(sensi1="buf", my.list.capa.here=NULL),
scenarioC %>% mutate(sensi1="cap", my.list.capa.here=NULL),
scenarioC %>% mutate(sensi1="clu", my.list.capa.here=NULL),
scenarioC %>% mutate(sensi1="urb", my.list.capa.here=NULL),
scenarioCrad54 ,scenarioCrad66,
scenarioCbuff54 ,scenarioCbuff66 ,
scenarioCcapaM ,scenarioCcapaP ,
scenarioCclump270 ,scenarioCclump330,
scenarioCurb1800 ,scenarioCurb2200 ) %>%
mutate(categories=factor(ifelse(metro==1, "Metropolitan", ifelse(is.rural==1, "Rural", "Urban"))),
urbrur=factor(ifelse(is.rural==0, "Urban", "Rural")),
close2CCS=factor(ifelse(out==0, "Close to\nCCS", "Far from\nCCS")),
updown=factor(updown, levels=c("-10%", "baseline", "+10%")),
sensi=factor(sensi1, levels=c("bas","cap", "rad","buf","clu","urb"),
labels=c("Baseline","Max. population","Max. walking time","Distance to CCS","Min. density for\nurban areas", "Min. population\nfor urban areas") ),
case=paste0(sensi1, "_",updown )
)
###################
#total per scenarios
total_per_scen_sensi=data.frame(table(capacities.all.sensi$case))
names(total_per_scen_sensi)=c("case", "totalCHW")
print(total_per_scen_sensi)
total_per_category_sensi=capacities.all.sensi %>%
group_by(case, sensi,sensi1, updown,categories)%>%
summarise(count=n())%>%
left_join(total_per_scen_sensi, by="case") %>%
mutate(prop=round(100*count/totalCHW),
totalCHW2=ifelse(categories=="Metropolitan",totalCHW, NA))
print(total_per_category_sensi)
total_per_category_sensi %>%
ggplot(aes(x = updown, y = count, alpha= categories)) + # Create stacked bar chart
geom_bar(stat = "identity", fill="dodgerblue")+
scale_alpha_manual(name="" ,values=c(1,0.7,0.4))+
labs(x="", y="Number of CHWs")+theme_bw()+ylim(0,5400)+
geom_text(aes(label = totalCHW2 , y=totalCHW2), vjust=-0.25, size=3, show.legend = FALSE)+
facet_wrap(.~sensi, scales="free_x", ncol=3)+
theme(axis.text.x = element_text(size=7),
axis.text.y = element_text(size=9, face = "bold"),
axis.title = element_text(size=9),
legend.text = element_text(size=9),
legend.position = "bottom",
strip.text = element_text(size = 9, face = "bold"),
strip.background = element_rect(fill="white") ) -> ggp2_sensi
ggp2_sensi
base.value=unique(total_per_category_sensi$totalCHW[total_per_category_sensi$updown=="baseline"])
width <- 0.95
tornado_plot=total_per_category_sensi %>%
filter(updown != "baseline", categories=="Metropolitan") %>%
# create the columns for geom_rect
mutate(Parameter=factor(sensi, levels=c( "Min. population\nfor urban areas","Min. density for\nurban areas","Distance to CCS", "Max. walking time", "Max. population")) ,
ymin=pmin(100*(totalCHW-base.value)/base.value,0),
ymax=pmax(100*(totalCHW-base.value)/base.value,0),
xmin=as.numeric(Parameter)-width/2,
xmax=as.numeric(Parameter)+width/2) %>%
ggplot() +
geom_rect(aes(ymax=ymax, ymin=ymin, xmax=xmax, xmin=xmin, fill=updown)) +
theme_bw() +
theme(axis.title.y=element_blank(), legend.position = 'bottom',
axis.text.x = element_text(size=8),
axis.text.y = element_text(size=8, face = "bold"),
axis.title = element_text(size=8),
legend.text = element_text(size=8),
legend.title = element_text(size=8)) +
geom_hline(yintercept = 0) +
scale_x_continuous(breaks=c(1,2,3,4,5),
labels = c( "Min. population\nfor urban areas","Min. density for\nurban areas","Distance to CCS", "Max. walking time", "Max. population")) +
scale_fill_manual(values=c("lightblue","darkblue"))+labs(y="% change in the number of CHWs", fill= "Parameter value")+
coord_flip()+ theme(plot.margin = unit(c(0,2,10,0), "lines"))
sensi_tornado=plot_grid(ggp2_sensi, tornado_plot, rel_widths = c(1, 0.6), rel_heights = c(1, 0.6), scale = 0.9, labels = c("1.", "2."), label_size = 20)
ggsave(sensi_tornado, file=file.path(dirPlots,"S4_fig.tiff"), width=7.5, height=6, compression="lzw", bg="white", dpi=300, device="tiff")
dim(readTIFF(file.path(dirPlots, "S4_fig.tiff")))
######################################################
# mean capacity per scenario per rural/urban/metropolitan
capacities.all.sensi %>% #filter(out==1)%>%
mutate(scenario_far=interaction(updown,close2CCS)) %>%
group_by(scenario,close2CCS,case, updown, sensi,scenario_far,urbrur) %>%
summarise(mean=mean(capacities), q75=quantile(capacities, 0.9), q25=quantile(capacities, 0.05) )%>%
ggplot(aes(x=close2CCS, y=mean, fill=updown, color=updown, ymin=q25, ymax=q75, group=interaction(updown,urbrur), alpha=(urbrur)))+
scale_alpha_manual(name="" ,values=c(0.4,0.7))+
geom_bar(stat="identity", position ="dodge" ,color=NA)+
geom_errorbar(position = position_dodge(.9), alpha=1, width=0.2)+
ylim(0,4500)+theme_bw()+
facet_wrap(.~sensi, scales="free_x", ncol=3)+
scale_fill_manual(values = c("lightblue", "dodgerblue","darkblue"), name="")+
scale_color_manual(values = c("lightblue3", "dodgerblue","darkblue"), guide=F)+
labs(y="Inhabitants per CHW", x="", caption="Error bars indicate the 5% and 95% quantiles of the distribution over all CHWs.")+
theme(axis.text.x = element_text(size=10),
axis.text.y = element_text(size=10),
axis.title = element_text(size=12),
plot.caption = element_text(size=12),
legend.text = element_text(size=12),
legend.position = "bottom",
strip.text = element_text(size = 12, face = "bold"),
strip.background = element_rect(fill="white") ) -> plot_average_sensi
plot_average_sensi
ggsave(plot_average_sensi, file=file.path(dirPlots,"S5_Fig.tiff"), width=7.5, height=6, compression="lzw", bg="white", dpi=300, device="tiff")
dim(readTIFF(file.path(dirPlots, "S5_fig.tiff")))
################################################
# Compare with SPA and Cartographie per department
###############################################
compare_sensi=capacities.all.sensi %>% group_by(dpt, updown, sensi) %>% summarise(nbCHW=n())
compare_sensi$departement=as.character(compare_sensi$dpt)
compare_sensi$departement[compare_sensi$departement=="AireMetro"]="Metr. Area"
compare_sensi$departement[compare_sensi$departement=="GrandeAnse"]="Grande-Anse"
compare_sensi$departement[compare_sensi$departement=="NordEst"]="Nord-Est"
compare_sensi$departement[compare_sensi$departement=="NordOuest"]="Nord-Ouest"
compare_sensi$departement[compare_sensi$departement=="SudEst"]="Sud-Est"
compare_sensi$departement[compare_sensi$departement=="Ouest"]="Rest Ouest"
p=ggplot(data=compare_sensi, aes(x=departement, y=nbCHW, color=updown)) +
facet_wrap(.~sensi, ncol=3)+
geom_bar(
data = compare_data
, aes(x = fct_reorder(departement, nbCHW), y = nbCHW, fill = case )
, stat = "identity"
, alpha = 0.5, color=NA
, position = position_dodge(0.5) ) +
geom_point(stat="identity", shape=15, size=2)+
xlab("")+theme_bw()+
ylab("Number of CHWs")+coord_flip()+
scale_color_manual(values = c("lightblue", "dodgerblue","darkblue"), name="Scenario C:")+
scale_fill_manual( values = c("grey55","grey21"), name="Current placement:")+
theme(axis.text.x = element_text(size=10),
axis.text.y = element_text(size=10, face = "bold"),
#axis.text.x = element_text(angle = 45),
axis.title = element_text(size=10),
legend.text = element_text(size=10),
legend.title = element_text(size=10),
legend.position = "bottom",
strip.text = element_text(size = 10, face = "bold"),
strip.background = element_rect(fill="white") )
p
ggsave(p, file=file.path(dirPlots,"S6_Fig.tiff"), width=7.5, height=7.5, compression="lzw", bg="white", dpi=300, device="tiff")
dim(readTIFF(file.path(dirPlots, "S6_fig.tiff")))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.