Skip to content
Snippets Groups Projects
Commit b7551c6a authored by Nauta, Lisanne's avatar Nauta, Lisanne
Browse files

pathogenflow model can return emissions per sanitation type per landuse area...

pathogenflow model can return emissions per sanitation type per landuse area per iso id from mapping tool input
parent e1d12ea0
No related branches found
No related tags found
No related merge requests found
iso;subarea;hdi;population;fraction_urban_pop;fraction_pop_under5;sheddingRate;shedding_duration;incidence_urban_under5;incidence_urban_5plus;incidence_rural_under5;incidence_rural_5plus;flushSewer_urb;flushSeptic_urb;flushPit_urb;flushOpen_urb;flushUnknown_urb;pitSlab_urb;pitNoSlab_urb;compostingTwinSlab_urb;compostingTwinNoSlab_urb;compostingToilet_urb;bucketLatrine_urb;containerBased_urb;hangingToilet_urb;openDefecation_urb;other_urb;isShared_urb;sewerLeak_urb;emptied_urb;isWatertight_urb;hasLeach_urb;coverBury_urb;emptiedTreatment_urb;emptyFrequency_urb;pitAdditive_urb;flushElsewhere_urb;pitVIP_urb;pitTraditional_urb;otherLatrine_urb;otherImproved_urb;otherUnimproved_urb;dontKnow_urb;pitLined_urb;pitUnlined_urb;flushSewer_rur;flushSeptic_rur;flushPit_rur;flushOpen_rur;flushUnknown_rur;pitSlab_rur;pitNoSlab_rur;compostingTwinSlab_rur;compostingTwinNoSlab_rur;compostingToilet_rur;bucketLatrine_rur;containerBased_rur;hangingToilet_rur;openDefecation_rur;other_rur;isShared_rur;sewerLeak_rur;emptied_rur;isWatertight_rur;hasLeach_rur;coverBury_rur;emptiedTreatment_rur;emptyFrequency_rur;pitAdditive_rur;flushElsewhere_rur;pitVIP_rur;pitTraditional_rur;otherLatrine_rur;otherImproved_rur;otherUnimproved_rur;dontKnow_rur;pitLined_rur;pitUnlined_rur;FractionPrimarytreatment;FractionSecondarytreatment;FractionTertiarytreatment;FractionQuaternarytreatment;FractionPonds;FractionNontreatment
1;Central;0.493;63206;1;0.177278887;1.00E+10;7;0.24;0.08;0.24;0.08;0.263426061;0.202395075;0.057237316;0.012221734;0.007753772;0.41097414;0.02447696;0;0;0.006835904;0;0;0;0.011578119;0.003100918;0.363873646;0;0.469944575;0;0.733457483;0;0.436780403;3;None;0;0;0;0;0;0;0;0.23077419;0.211512815;0.263426061;0.202395075;0.057237316;0.012221734;0.007753772;0.41097414;0.02447696;0;0;0.006835904;0;0;0;0.011578119;0.003100918;0.363873646;0;0.469944575;0;0.733457483;0;0.436780403;3;None;0;0;0;0;0;0;0;0.23077419;0.211512815;0.035;0.035;0;0;0.45;0.48
2;Kawempe;0.493;333024;1;0.177278887;1.00E+10;7;0.24;0.08;0.24;0.08;0.036860622;0.142274476;0.057601288;0.001679583;0.00524847;0.736130931;0.014416174;0;0;0.00033069;0;0;0.0001061;0.00459866;0.000745624;0.439653607;0;0.218648771;0;0.705524168;0;0.211244894;3;None;0;0;0;0;0;0;0;0.321520783;0.429357014;0.036860622;0.142274476;0.057601288;0.001679583;0.00524847;0.736130931;0.014416174;0;0;0.00033069;0;0;0.0001061;0.00459866;0.000745624;0.439653607;0;0.218648771;0;0.705524168;0;0.211244894;3;None;0;0;0;0;0;0;0;0.321520783;0.429357014;0.035;0.035;0;0;0.45;0.48
3;Makindye;0.493;385309;1;0.177278887;1.00E+10;7;0.24;0.08;0.24;0.08;0.028570368;0.259280693;0.082540034;0.003821692;0.017477095;0.574689697;0.024289707;0;0;0.001400786;0;0;3.45E-05;0.006082428;0.001834099;0.428658959;0;0.248507909;0;0.740031033;0;0.236410709;3;None;0;0;0;0;0;0;0;0.2588795;0.341499759;0.028570368;0.259280693;0.082540034;0.003821692;0.017477095;0.574689697;0.024289707;0;0;0.001400786;0;0;3.45E-05;0.006082428;0.001834099;0.428658959;0;0.248507909;0;0.740031033;0;0.236410709;3;None;0;0;0;0;0;0;0;0.2588795;0.341499759;0.035;0.035;0;0;0.45;0.48
4;Nakawa;0.493;317023;1;0.177278887;1.00E+10;7;0.24;0.08;0.24;0.08;0.098606697;0.282278627;0.065945258;0.002724668;0.016024352;0.49795729;0.027461236;0;0;0.000559863;0;0;0.000678506;0.006932757;0.000831023;0.389882378;0;0.196882531;0;0.788037462;0;0.190629622;3;None;0;0;0;0;0;0;0;0.215936282;0.310042107;0.098606697;0.282278627;0.065945258;0.002724668;0.016024352;0.49795729;0.027461236;0;0;0.000559863;0;0;0.000678506;0.006932757;0.000831023;0.389882378;0;0.196882531;0;0.788037462;0;0.190629622;3;None;0;0;0;0;0;0;0;0.215936282;0.310042107;0.035;0.035;0;0;0.45;0.48
5;Rubaga;0.493;383216;1;0.177278887;1.00E+10;7;0.24;0.08;0.24;0.08;0.004654201;0.164638786;0.089541423;0.001799026;0.010791608;0.688829209;0.031009589;0;0;0.000566465;0;0;2.01E-05;0.003735057;0.004392258;0.441673466;0;0.256076888;0;0.98927109;0;0.243857358;3;None;0;0;0;0;0;0;0;0.312687133;0.407713566;0.004654201;0.164638786;0.089541423;0.001799026;0.010791608;0.688829209;0.031009589;0;0;0.000566465;0;0;2.01E-05;0.003735057;0.004392258;0.441673466;0;0.256076888;0;0.98927109;0;0.243857358;3;None;0;0;0;0;0;0;0;0.312687133;0.407713566;0.035;0.035;0;0;0.45;0.48
...@@ -77,7 +77,6 @@ human.emissions.model.run <- function(scenario,pathogen,isoraster){ ...@@ -77,7 +77,6 @@ human.emissions.model.run <- function(scenario,pathogen,isoraster){
# calc corrected population # calc corrected population
pop_corrected <- correct.population(popurban_grid,popurban_grid,isoraster,HumanData) pop_corrected <- correct.population(popurban_grid,popurban_grid,isoraster,HumanData)
popurban_grid <- pop_corrected$urban
poprural_grid <- pop_corrected$rural poprural_grid <- pop_corrected$rural
# CALCULATION OF EMISSIONS PER SANITION TYPE AND SUBAREA # CALCULATION OF EMISSIONS PER SANITION TYPE AND SUBAREA
...@@ -245,6 +244,7 @@ calc.emissions <- function(scenario,pathogen,HumanData){ ...@@ -245,6 +244,7 @@ calc.emissions <- function(scenario,pathogen,HumanData){
int1<-integrate(f2,0,HumanData$storage_flush_urb[b[j]]) int1<-integrate(f2,0,HumanData$storage_flush_urb[b[j]])
HumanData$survival_pit_flush_urb[b[j]]<-int1$value/HumanData$storage_flush_urb[b[j]] HumanData$survival_pit_flush_urb[b[j]]<-int1$value/HumanData$storage_flush_urb[b[j]]
int1<-integrate(f2,0,HumanData$storage_flush_rur[b[j]]) int1<-integrate(f2,0,HumanData$storage_flush_rur[b[j]])
HumanData$survival_pit_flush_rur[b[j]]<-int1$value/HumanData$storage_flush_rur[b[j]] HumanData$survival_pit_flush_rur[b[j]]<-int1$value/HumanData$storage_flush_rur[b[j]]
...@@ -507,60 +507,13 @@ calc.wttp.emissions.subarea <- function(emissions,WWTP_inputs,HumanData){ ...@@ -507,60 +507,13 @@ calc.wttp.emissions.subarea <- function(emissions,WWTP_inputs,HumanData){
return(emissions) return(emissions)
} }
calc.water.emissions.grid <- function(emissions,isoraster){
pathogen_urban_water_pp<-data.frame(iso=emissions$iso,value=emissions$pathogen_urb_waterforgrid_pp)
pathogen_urban_water_pp_raster<-subs(isoraster, pathogen_urban_water_pp , subsWithNA=T)
pathogen_rural_water_pp<-data.frame(iso=emissions$iso,value=emissions$pathogen_rur_waterforgrid_pp)
pathogen_rural_water_pp_raster<-subs(isoraster, pathogen_rural_water_pp , subsWithNA=T)
pathogen_urban_water_grid<-pathogen_urban_water_pp_raster*popurban_grid
pathogen_rural_water_grid<-pathogen_rural_water_pp_raster*poprural_grid
temp<-data.frame(bla=NA,value=0)
pathogen_urban_water_grid<-subs(pathogen_urban_water_grid,temp,subsWithNA=F)
pathogen_rural_water_grid<-subs(pathogen_rural_water_grid,temp,subsWithNA=F)
temp<-data.frame(bla=NaN,value=0)
pathogen_urban_water_grid<-subs(pathogen_urban_water_grid,temp,subsWithNA=F)
pathogen_rural_water_grid<-subs(pathogen_rural_water_grid,temp,subsWithNA=F)
pathogen_water_grid<-pathogen_urban_water_grid+pathogen_rural_water_grid
return(pathogen_water_grid)
}
calc.land.emissions.grid <- function(emissions,isoraster){
#for emissions to land
pathogen_urban_land_pp<-data.frame(iso=emissions$iso,value=emissions$pathogen_urb_landforgrid_pp)
pathogen_urban_land_pp_raster<-subs(isoraster, pathogen_urban_land_pp , subsWithNA=T)
pathogen_rural_land_pp<-data.frame(iso=emissions$iso,value=emissions$pathogen_rur_landforgrid_pp)
pathogen_rural_land_pp_raster<-subs(isoraster, pathogen_rural_land_pp , subsWithNA=T)
pathogen_urban_land_grid<-pathogen_urban_land_pp_raster*popurban_grid
pathogen_rural_land_grid<-pathogen_rural_land_pp_raster*poprural_grid
temp<-data.frame(bla=NA,value=0)
pathogen_urban_land_grid<-subs(pathogen_urban_land_grid,temp,subsWithNA=F)
pathogen_rural_land_grid<-subs(pathogen_rural_land_grid,temp,subsWithNA=F)
temp<-data.frame(bla=NaN,value=0)
pathogen_urban_land_grid<-subs(pathogen_urban_land_grid,temp,subsWithNA=F)
pathogen_rural_land_grid<-subs(pathogen_rural_land_grid,temp,subsWithNA=F)
pathogen_land_grid<-pathogen_urban_land_grid+pathogen_rural_land_grid
return(pathogen_land_grid)
}
calc.emissions.grid <- function(isoraster,iso,emissions_forgrid_pp,pop_grid){ calc.emissions.grid <- function(isoraster,iso,emissions_forgrid_pp,pop_grid){
pathogen_pp<-data.frame(iso=iso,value=emissions_forgrid_pp) pathogen_pp<-data.frame(iso=iso,value=emissions_forgrid_pp)
pathogen_pp_raster<-subs(isoraster, pathogen_pp , subsWithNA=T) pathogen_pp_raster<-subs(isoraster, pathogen_pp , subsWithNA=T)
pathogen_grid <- pathogen_pp_raster * pop_grid pathogen_grid <- pathogen_pp_raster * pop_grid
# Why is this twice?
temp<-data.frame(bla=NA,value=0) temp<-data.frame(bla=NA,value=0)
pathogen_grid <- subs(pathogen_urban_water_grid,temp,subsWithNA=F) pathogen_grid <- subs(pathogen_grid,temp,subsWithNA=F)
pathogen_grid <- subs(pathogen_urban_water_grid,temp,subsWithNA=F)
return(pathogen_grid) return(pathogen_grid)
} }
...@@ -2,20 +2,113 @@ ...@@ -2,20 +2,113 @@
library(pathogenflows) library(pathogenflows)
pathogenflow.model.run <- function(input_data,pathogen){ pathogenflow.model.run <- function(input_data,pathogen){
emissions <- data.frame() emissions <- data.frame(iso=input_data$iso,subarea=input_data$subarea)
# 1) extract pathogen type from pathogen # 1) extract pathogen type from pathogen
pathogenType <- "Virus" pathogenType <- "Virus"
# 2a) prepare data for urban and rural area_types <- c("urban","rural")
human_age_types <- c("child","adult")
# 2b) call loadings function twice for urban and rural areas all_loadings <- list()
onsite_urban = data.frame() # 2) call loadings function 4 times for urban-adult/child prevalence and rural-adult/child prevalence
onsite_rural = data.frame() for(area_type in area_types){
rural_loadings <- pathogenflows::getLoadings(onsite_rural,pathogenType) for(human_age_type in human_age_types ){
urban_loadings <- pathogenflows::getLoadings(onsite_urban,pathogenType) #2a) prepare data for urban and rural
# 2c) postprocess output onsite_data <- pathogenflow.model.get.input(input_data,area_type,human_age_type)
file_out <- file.path(working.path.in,sprintf("onsite_%s_%s.csv",area_type,human_age_type))
write.csv(onsite_data,file = file_out)
#call loadings
loadings <- pathogenflows::getLoadings(file_out,pathogenType)
# store in list
all_loadings[[area_type]][[human_age_type]] <- loadings
}
}
# 3) postprocess output
# add child + adult loadings for sanitation and areas
# apply to area types urban/rural
for(area_type in names(all_loadings)){
area_loadings <- all_loadings[[area_type]]
adult <- area_loadings$adult$detailed
child <- area_loadings$child$detailed
# apply to all sub areas
for(i in 1:length(emissions$subarea)){
sub_area <- emissions$subarea[i]
ncols <- ncol(adult[[sub_area]])
sanitation_types <- adult[[sub_area]]$id
emissions_sanitation <- adult[[sub_area]][3:ncols] + child[[sub_area]][3:ncols]
# apply to all sanitation types
for(j in 1:length(sanitation_types)){
sanitation_type <- sanitation_types[j]
emissions_col_name_postfix <- sprintf("%s_%s",sanitation_type,area_type)
emissions_col_to_surface <- sprintf("%s_%s","to_surface",emissions_col_name_postfix)
emissions_col_sewerage <- sprintf("%s_%s","sewerage",emissions_col_name_postfix)
to_surface <- emissions_sanitation$toSurface[j]
to_sewerage <- emissions_sanitation$sewerage[j]
# store only to_surface and sewerage
emissions[[emissions_col_to_surface]][i] <- to_surface
emissions[[emissions_col_sewerage]][i] <- to_sewerage
}
}
}
# 3) create similair emissions data.frame as original human emissions # 3) create similair emissions data.frame as original human emissions
# 4) return emissions # 4) return emissions
return(emissions) return(emissions)
}
pathogenflow.model.get.input <- function(input,area_type,human_type){
#@Nynke: population is population per human type (adult/child) or total population?
col_names <- c("iso","scenario","region","population","sheddingRate","prevalence","flushSewer","flushSeptic","flushPit","flushOpen",
"flushUnknown","pitSlab","pitNoSlab","compostingTwinSlab","compostingTwinNoSlab","compostingToilet","bucketLatrine",
"containerBased","hangingToilet","openDefecation","other","isShared","sewerLeak","emptied","isWatertight","hasLeach","coverBury",
"emptiedTreatment","emptyFrequency","pitAdditive","flushElsewhere","pitVIP","pitTraditional","otherLatrine","otherImproved",
"otherUnimproved","dontKnow","pitLined", "pitUnlined")
onsite_data <- data.frame(matrix(ncol=length(col_names),nrow = dim(input)[1]))
colnames(onsite_data) <- col_names
onsite_data$iso <- input$iso
onsite_data$region <- input$subarea
onsite_data$sheddingRate <- input$sheddingRate
input_col_names <- colnames(input)
if(area_type=="urban"){
postfix <- "urb"
onsite_data$population <- input$population*input$fraction_urban_pop
}
else if(area_type=="rural"){
postfix <- "rur"
onsite_data$population <- input$population* (1- input$fraction_urban_pop)
}
# filter for urban and rural
filtered_cols <- input_col_names[str_ends(input_col_names,postfix)]
for(input_colname in filtered_cols){
# get corresponding colname for onsite_data
onsite_colname <- str_replace(input_colname,sprintf("_%s",postfix),"")
# check if it part of onsite_data
if(onsite_colname %in% col_names){
onsite_data[[onsite_colname]] <- input[[input_colname]]
}
}
incidence = 0
if(human_type == "child"){
onsite_data$population <- input$population * input$fraction_pop_under5
if(area_type == "urban"){
incidence <- input$incidence_urban_under5
}
else if(area_type == "rural"){
incidence <- input$incidence_rural_under5
}
}
else if(human_type == "adult"){
onsite_data$population <- input$population * (1-input$fraction_pop_under5)
if(area_type == "urban"){
incidence <- input$incidence_urban_5plus
}
else if(area_type == "rural"){
incidence <- input$incidence_rural_5plus
}
}
# @Nynke: Is this ok?
onsite_data$prevalence <- incidence*input$sheddingRate*input$shedding_duration
return(onsite_data)
} }
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment