initial commit

.Rbuildignore

+^renv$
+^renv\.lock$
+^.*\.Rproj$
+^\.Rproj\.user$
+^data-raw$

.Rprofile

+source("renv/activate.R")

.gitignore

+.Rhistory
+.RData
+.Rproj.user/
+
+gadm
+output
+inst/extdata/uga

DESCRIPTION

+Package: glowpa
+Title: The GloWPa (Global Waterborne Pathogen) model. 
+Version: 0.0.0.9000
+Authors@R: c(
+    person("Lisanne", "Nauta", , "lisanne.nauta@wur.nl", role = c("cre","aut"),
+           comment = c(ORCID = "0009-0003-0250-2952")),
+    person("Nynke", "Hofstra", , "nynke.hofstra@wur.nl", role = c("aut"),
+           comment = c(ORCID = "0000-0002-0409-5145"))
+  )
+Description: The GloWPa (Global Waterborne Pathogen) model simulates emissions of pathogens 
+  to surface water. These pathogens are known to be a leading cause of diarrhoeal diseases 
+  among people that are exposed to high concentrations. GloWPa focuses on human and 
+  livestock emissions of pathogens that end up in surface water systems through various pathways. 
+  Special attention is paid to the storage and removal of pathogens in manure storage facilities 
+  or wastewater treatment systems.
+License: MIT + file LICENSE
+Encoding: UTF-8
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.2.3
+Suggests: 
+    lintr (>= 3.1.1),
+    styler (>= 1.10.2),
+    testthat (>= 3.0.0),
+    geodata,
+    sf,
+    ncdf4
+Config/testthat/edition: 3
+Imports: 
+    configr,
+    dplyr,
+    logger,
+    lubridate,
+    pathogenflows (>= 0.0.0.91),
+    terra
+Depends: 
+    R (>= 2.10)
+LazyData: true
+Remotes: 
+    git::https://git.wur.nl/glowpa/pathogenflows.git@be452603dc14512b57c3288635bec0960f7d9ce4

LICENSE

+YEAR: 2023
+COPYRIGHT HOLDER: glowpa authors

LICENSE.md

+# MIT License
+
+Copyright (c) 2023 glowpa authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

LICENSE.txt

+MIT License
+
+Copyright (c) 2023 glowpa authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

+# Generated by roxygen2: do not edit by hand
+
+export(glowpa_init)
+export(glowpa_start)
+export(run)
+export(settings)

R/domain.R

+domain_set <- function(){
+  logger::log_debug(sprintf('Read domain from isoraster: %s',run$settings$input$isoraster))
+  domain <- terra::rast(run$settings$input$isoraster)
+  names(domain) <- c("isoraster")
+  run$domain <- domain
+  domain_res <- terra::res(domain)
+  domain_extent <- terra::ext(domain)
+  logger::log_info(sprintf('Using extent: %s (xmin, xmax, ymin, ymax)', domain_extent))
+  logger::log_info(sprintf('Using resolution [%s,%s] (x,y)',domain_res[1],domain_res[2]))
+}

R/glowpa.R

+#' @export
+run <- new.env()
+
+#' glowpa_init
+#'
+#' @return
+#' @export
+#'
+#' @examples
+glowpa_init <- function(file) {
+  # TODO: find way to clear the env
+  run$settings <- defaults
+  run$pathogens <- pathogens
+  logger_init()
+  settings_load(file)
+  logger_apply_settings()
+  logger::log_info(
+    paste0(strrep("#", 34), " LICENSE ", strrep("#", 35)),
+    namespace = "header"
+  )
+  license_txt <- readLines(system.file("LICENSE.txt", package = "glowpa"))
+  for (i_line in seq_along(license_txt)) {
+    logger::log_info(license_txt[i_line], namespace = "header")
+  }
+  logger::log_info(paste0(strrep("#", 80), "\n"), namespace = "header")
+  sinfo <- sessionInfo()
+  logger::log_info(sprintf("\tPlatform: %s",sinfo$platform), namespace= "header")
+  logger::log_info(sprintf("\tRunning: %s",sinfo$running), namespace= "header")
+  logger::log_info(sprintf("\tR version: %s",sinfo$R.version$version.string), namespace= "header")
+  logger::log_info(sprintf("\tGloWPa version: %s",packageVersion("glowpa")),namespace= "header")
+  logger::log_info(sprintf("\tpathogenflows version: %s",packageVersion("pathogenflows")),namespace= "header")
+  logger::log_info(paste0(strrep("#", 80), "\n"), namespace = "header")
+  logger::log_info(sprintf("Current working directory: %s", getwd()))
+  logger::log_info(sprintf("Use settings from %s", file))
+  pathogen_init()
+  settings_display()
+  validate()
+}
+
+#' glowpa_start
+#'
+#' @return
+#' @export
+#'
+#' @examples
+glowpa_start <- function() {
+  logger::log_info("Start simulation")
+  run$timing <- list()
+  run$timing$start <- Sys.time()
+  # set the domain
+  domain_set()
+  params_set()
+  init_global_struct()
+  population_set()
+  # return the emissions from the sanitation to land, surface water, and waste water treatment
+  df_human_emissions <- human_emissions()
+  # update the global emissions structure from human sources
+  pathways_humans(df_human_emissions)
+  pathways_humans_rast(df_human_emissions)
+  # return the emissions from the land causes by overland runoff
+  out_land_emissions <- land_emissions(df_human_emissions)
+  # update the global emissions structure from land sources
+  pathways_land(out_land_emissions)
+  pathways_land_rast(out_land_emissions)
+
+  output_write()
+
+  run$timing$end <- Sys.time()
+  logger::log_info("Finished simulation")
+}

R/human.R

+human_emissions <- function() {
+  if(!requireNamespace("pathogenflows", quietly = TRUE)){
+    msg <- "Cannot run pathogenflows. The package pathogenflows is not installed."
+    logger::log_fatal(msg)
+    stop(msg)
+  }
+  logger::log_info('Run pathogenflows')
+  emissions <- data.frame(iso=run$params$iso)
+  # create combinations
+  loops <- expand.grid(area_type=CONSTANTS$AREA_TYPES,human_age_type=CONSTANTS$HUMAN_AGE_TYPES,stringsAsFactors = FALSE)
+  # all_loadings is a list of all loadings output for each combination
+  all_loadings <- apply(loops,1,FUN = function(elem){
+    area_type <- elem[1]
+    age_group <- elem[2]
+    logger::log_info(
+      sprintf("get %s loadings for %s population in age group %s",
+              tolower(run$settings$pathogen_params$pathogen_type),area_type,age_group))
+    # prepare input data for pathogenflows
+    onsite_data <- human_get_input(area_type,age_group)
+    loadings <- pathogenflows::getLoadings(onsite_data,run$settings$pathogen_params$pathogen_type)
+    return(loadings)
+  })
+  loadings_df <- data.frame(matrix(nrow = nrow(run$params) * nrow(all_loadings[[1]]$det[[1]]) * nrow(loops), ncol = 7))
+  colnames(loadings_df) <- c("sanitation_type","to_surface","to_sewerage","to_fecalSludge","iso","human_age_type","area_type")
+  # postprocess output data from pathogenflows
+  row_start <- 1
+  for(i_combination in 1:nrow(loops)){
+    area_type <- loops[i_combination,]$area_type
+    human_age_type <- loops[i_combination,]$human_age_type
+    for(i_subarea in 1:nrow(run$params)){
+      loadings_per_sanitation <- all_loadings[[i_combination]]$det[[i_subarea]]
+      loadings_per_sanitation <- loadings_per_sanitation  %>% dplyr::select(id, toSurface, sewerage, fecalSludge) %>%
+        dplyr::rename(sanitation_type = id, to_surface = toSurface, to_fecalSludge = fecalSludge, to_sewerage = sewerage)
+      loadings_per_sanitation$iso <- run$params$iso[i_subarea]
+      loadings_per_sanitation$human_age_type <- human_age_type
+      loadings_per_sanitation$area_type <- area_type
+
+      row_end <- row_start + nrow(loadings_per_sanitation) - 1
+      loadings_df[row_start:row_end,] <- loadings_per_sanitation
+      # raise row_start
+      row_start <- row_end + 1
+    }
+  }
+
+  emitted_fraction_col <- sprintf("fEmitted_inEffluent_after_treatment_%s",tolower(run$settings$pathogen_params$pathogen_type))
+  if(emitted_fraction_col %in% colnames(run$params)){
+    emitted_fraction_after_treatment <- run$params[[emitted_fraction_col]]
+  }
+  else{
+    emitted_fraction_after_treatment <- run$params$fEmitted_inEffluent_after_treatment
+  }
+
+  df_emissions_sanitation <- loadings_df %>% dplyr::group_by(iso,sanitation_type,area_type) %>%
+    dplyr::summarise(
+      to_surface = sum(to_surface, na.rm=TRUE),
+      to_sewerage = sum(to_sewerage, na.rm = TRUE),
+      to_fecalSludge = sum(to_fecalSludge, na.rm = TRUE), .groups="drop")
+
+
+  # run the waste waster treatment module
+  df_emissions_wwtp <- wwtp_run(df_emissions_sanitation)
+  # update the global data structure
+  pathways_wwtp(df_emissions_wwtp)
+
+  partly_dumped_on_land <- c(
+    "flushSeptic","flushPit","pitSlab","pitNoSlab","compostingToilet")
+
+  direct_to_water_rur <- c(
+    "bucketLatrine", "containerBased", "openDefecation"
+  )
+
+  df_emissions_sanitation$onsiteDumpedland <- dplyr::left_join(df_emissions_sanitation,run$params) %>%
+    dplyr::mutate(onsiteDumpedLand = dplyr::case_when(
+      area_type == "urban" & sanitation_type %in% partly_dumped_on_land  ~ onsiteDumpedland_urb,
+      area_type == "rural" & sanitation_type %in% partly_dumped_on_land ~ onsiteDumpedland_rur,
+      area_type == "rural" & sanitation_type %in% direct_to_water_rur ~ 0,
+      .default = 0), .keep="none") %>%
+    dplyr::ungroup() %>% dplyr::pull()
+
+  # calculate the emissions from the sanitation types, from the fraction which
+  # is not dumped on land, which directly flows to the surface water
+  df_emissions_sanitation <- df_emissions_sanitation %>%
+    dplyr::mutate(
+      to_surface_water = dplyr::case_when(
+        sanitation_type == "flushSewer" ~ to_surface,
+        sanitation_type != "flushSewer" ~ to_surface * (1 - onsiteDumpedland)
+      ),
+      to_land = dplyr::case_when(
+        sanitation_type != "flushSewer" ~ to_surface * onsiteDumpedland
+      )
+    )
+
+  df_emissions_humans <-
+    dplyr::left_join(
+      df_emissions_wwtp,
+      df_emissions_sanitation,
+      by = dplyr::join_by(iso, area_type, sanitation_type)
+    ) %>%
+    dplyr::select(
+      iso,
+      area_type,
+      sanitation_type,
+      to_sewerage,
+      to_fecalSludge,
+      to_surface_water,
+      to_land,
+      out_sewerage,
+      out_fecalSludge
+    )
+  return(df_emissions_humans)
+
+}
+
+human_get_input <- function(area_type, human_age_type){
+  onsite_data <- data.frame(
+    matrix(
+      ncol=length(CONSTANTS$PATHOGENFLOWS_PARAMS),
+      nrow = nrow(run$params),
+      dimnames = list(
+        run$params$iso,
+        CONSTANTS$PATHOGENFLOWS_PARAMS
+        )
+      )
+    )
+  # set gid
+  onsite_data$gid <- run$params$iso
+  # set sheddingRate
+  shedding_rate_col <- sprintf("sheddingRate_%s", tolower(run$settings$pathogen_params$pathogen_type))
+  if(shedding_rate_col %in% colnames(run$params)){
+    shedding_rate <- run$params[[shedding_rate_col]]
+  }
+  else{
+    shedding_rate <- run$params$sheddingRate
+  }
+  # set sheddingDuration
+  shedding_duration_col <- sprintf("shedding_duration_%s",tolower(run$settings$pathogen_params$pathogen_type))
+  # in case the sheddingDuration is specified by pathogen type
+  if(shedding_duration_col %in% colnames(run$params)){
+    shedding_duration <- run$params[[shedding_duration_col]]
+  }
+  else{
+    shedding_duration <- run$params$shedding_duration
+  }
+  # set population
+  onsite_data$population <- run$params$population
+  area_postfix <- ""
+  if(area_type == "urban"){
+    area_postfix <- "_urb"
+    # set population for urban
+    onsite_data$population <- run$params$population * run$params$fraction_urban_pop
+  }
+  else if(area_type == "rural"){
+    area_postfix <- "_rur"
+    # set population for rural
+    onsite_data$population <- run$params$population * (1 - run$params$fraction_urban_pop)
+  }
+  else{
+    logger::log_warn(sprintf("no properties found for area type '%s'", area_type))
+  }
+
+  # select all columns ending with rur or urb and have matching names with the pathogenflows params
+  area_type_params <- run$params %>%
+    dplyr::select(dplyr::ends_with(area_postfix) & dplyr::contains(CONSTANTS$PATHOGENFLOWS_PARAMS)) %>%
+    # remove the _urb or _rur from the run params colnames
+    dplyr::rename_with(~gsub(area_postfix,"",.))
+  # set the selected data
+  onsite_data[colnames(area_type_params)] <- area_type_params
+
+  # define age group properties
+  age_postfix <- ""
+  if(human_age_type == "child"){
+    age_postfix <- "under5"
+    # set population for age group
+    onsite_data$population <- onsite_data$population * run$params$fraction_pop_under5
+  }
+  else if(human_age_type == "adult"){
+    age_postfix <- "5plus"
+    # set population for age group
+    onsite_data$population <- onsite_data$population * (1-run$params$fraction_pop_under5)
+  }
+  else{
+    logger::log_warn(sprintf("no properties found for age type '%s'", human_age_type))
+  }
+  incidence <- 0
+  # process the incidence
+  # for urban childs under 5: population*fraction_urban_pop*fraction_pop_under5*incidence_urban_under5*sheddingRate*sheddingDuration
+  # for rural childs under 5: population*(1-fraction_urban_pop)*fraction_pop_under5*incidence_rural_under5*sheddingRate*sheddingDuration
+  # for urban people above 5: population*fraction_urban_pop*(1-fraction_pop_under5)*incidence_urban_5plus*sheddingRate*sheddingDuration
+  # for rural people above 5: population*(1-fraction_urban_pop)*(1-fraction_pop_under5)*incidence_rural_5plus*sheddingRate*sheddingDuration
+  incidence_col <- sprintf("incidence_%s_%s",area_type,age_postfix)
+  incidence_col_pathogen <- sprintf("incidence_%s_%s_%s",area_type,age_postfix,tolower(run$settings$pathogen_params$pathogen_type))
+  if(incidence_col_pathogen %in% colnames(run$params)){
+    incidence <- run$params[[incidence_col_pathogen]]
+  }
+  else if(incidence_col %in% colnames(run$params)){
+    incidence <- run$params[[incidence_col]]
+  }
+  else{
+    logger::log_warn('No specific incidence found. Continue with incidence = 0')
+  }
+  onsite_data$excreted <- onsite_data$population * shedding_rate * shedding_duration * incidence
+  return(onsite_data)
+}
+
+# human_emissions_sanitation <- function(df_human_emissions, df_human_land_emissions){
+#   # calculate the emissions from humans through various sanitation pathways to
+#   # the surface water. The emissions come from the calculated emissions from
+#   # humans direct to the surface water, out the waste water treatment (sewerage and fecal sludge)
+#   # and from overland runoff
+#   df_sanitation <- df_human_emissions %>%
+#     dplyr::left_join(df_human_land_emissions,
+#                      by = dplyr::join_by(iso, area_type, sanitation_type)) %>%
+#     # aggregate over the area type
+#     dplyr::group_by(iso, sanitation_type) %>%
+#     dplyr::summarise(
+#       to_surface_water = sum(
+#         # emissions from sanitation types which (partly) flows direct to surface water
+#         to_surface_water,
+#         # emissions after treatment from sanitation types connected to the sewerage system
+#         out_sewerage,
+#         # emissions after treatment from sanitation types which use fecal sludge management
+#         out_fecalSludge,
+#         # emission from overland runoff of sanitation types which are (partly) dumped on land
+#         out_land, na.rm = TRUE))
+#   run$emissions$df_sanitation = df_sanitation
+# }

R/init.R

+init_global_struct <- function(){
+
+  PATHWAYS <- data.frame(
+    rbind(
+      c("humans2land","humans","land"),
+      c("humans2water","humans","surface_water"),
+      c("wwtp2water","wwtp","surface_water"),
+      c("humans2wwtp","humans","wwtp"),
+      c("land2water","land","surface_water"))
+  )
+  colnames(PATHWAYS) <- c("pathway","source","sink")
+
+  df_human_pathways <- data.frame(
+    expand.grid(run$params$iso, PATHWAYS[,1], CONSTANTS$SANITATION_TYPES)
+  )
+  colnames(df_human_pathways) <- c("iso", "pathway", "sanitation_type")
+  df_human_pathways <- df_human_pathways %>%
+    dplyr::left_join(PATHWAYS, by = dplyr::join_by('pathway'))
+  df_human_pathways$value <- NA
+
+  run$emissions <- list(
+    pathways = list(
+      rast = terra::rast(
+        rep(run$domain$isoraster,4),
+        names=c("wwtp2water","humans2land","humans2water","land2water"),
+        vals=NA),
+      df_humans = df_human_pathways
+    )
+  )
+}

R/land.R

+
+land_emissions <- function(df_human_emissions){
+
+  df_human_land_emissions <- df_human_emissions %>%
+    dplyr::mutate(out_land = to_land * run$settings$constants$runoff_fraction)
+
+  return(
+    list(
+      df_human = df_human_land_emissions
+    )
+  )
+}

R/logger.R

+logger_init <- function() {
+  logger::log_layout(logger::layout_blank, namespace = "header")
+  log_layout <- logger::layout_glue_generator(
+    format = "{level}\t {format(time,\"%Y-%m-%d %H:%M:%S\")}:\t {msg}"
+  )
+  logger::log_appender(logger::appender_console)
+  logger::log_layout(log_layout)
+  logger::log_debug("Logger initialized")
+}
+
+logger_apply_settings <- function() {
+  logger::log_threshold(run$settings$logger$threshold)
+  if (!is.null(run$settings$logger$file)) {
+    # create the log file
+    f_out <- file.create(run$settings$logger$file, recursive = TRUE, overwrite = TRUE)
+    # wait for the file to be created
+    Sys.sleep(2)
+    # the log file is overwritten so we use append = TRUE to write log messages
+    # from the 'header' and 'global namespace'
+    logger::log_appender(
+      logger::appender_file(
+        run$settings$logger$file,
+        append = TRUE
+      ),
+      index = 2
+    )
+    logger::log_appender(
+      logger::appender_file(
+        run$settings$logger$file,
+        append = TRUE
+      ),
+      namespace = "header",
+      index = 2
+    )
+    # apply same layout as the console logger
+    logger::log_layout(logger::log_layout(),index = 2)
+  }
+}

R/output.R

+output_write <- function(){
+  output_table_humans()
+  output_grids()
+}
+
+output_table_pathways <- function(){
+
+}
+
+output_table_compartments <- function(){
+
+}
+
+output_table_humans <- function(){
+  logger::log_debug('Process human emissions output')
+  df_human_emissions <- run$emissions$pathways$df_humans %>%
+    dplyr::group_by(iso, sanitation_type) %>%
+    dplyr::filter(sink == 'surface_water') %>%
+    dplyr::summarise(surface_water = sum(value, na.rm = TRUE), .groups = 'drop')
+
+  df_humans_by_iso <- df_human_emissions %>%
+    dplyr::group_by(iso)
+
+  iso_codes <- dplyr::group_keys(df_humans_by_iso) %>%
+    dplyr::pull()
+
+  df_out <- df_humans_by_iso %>%
+    # create new data.frame for each iso entry
+    dplyr::group_map(
+      # transpose -> sanitation types will be moved from rows to columns
+      ~ data.frame(data.frame(t(.x$surface_water))) %>%
+        `colnames<-` (.x$sanitation_type )) %>%
+    # apply a rowbind to the resulting list of data.frames
+    dplyr::bind_rows() %>%
+    # add the iso codes
+    dplyr::mutate(iso = iso_codes) %>%
+    # move iso column to first column
+    dplyr::relocate(iso)
+
+  out_path <- output_get_path(run$settings$output$table$human)
+  msg <- sprintf('Write human emissions table data to %s', out_path)
+  logger::log_info(msg)
+  write.csv(df_out, out_path, row.names = FALSE)
+}
+
+output_grids <- function(){
+  # write surface water
+  out_path <- output_get_path(run$settings$output$grid$surface_water)
+  rast_surface_water <- sum(
+    run$emissions$pathways$rast$humans2water,
+    run$emissions$pathways$rast$land2water,
+    run$emissions$pathways$rast$wwtp2water, na.rm = TRUE)
+  rast_name <- sprintf('%s in surface water', run$settings$pathogen)
+  names(rast_surface_water) <- c(rast_name)
+  logger::log_info(sprintf('Write surface water emissions raster data to %s', out_path))
+  terra::writeRaster(rast_surface_water, out_path, overwrite = TRUE)
+}
+
+output_get_path <- function(out_filename){
+  out_path <- out_filename
+  if('dir' %in% names(run$settings$output)){
+    out_path <- file.path(run$settings$output$dir, out_filename)
+  }
+  return(out_path)
+}

R/params.R

+params_set <- function(){
+  # reset params
+  run$params <- NULL
+  logger::log_info('Read parameter file')
+  params <- readRDS(run$settings$input$parameters)
+  validate_params(params)
+  # store the parameters in the run
+  run$params <- params
+}

R/pathogen.R

+pathogen_init <- function() {
+  if ("pathogen" %in% names(run$settings$input)) {
+    logger::log_info(
+      sprintf("Read pathogen inputs from %s", run$settings$input$pathogen)
+    )
+    user_pathogens <- readRDS(run$settings$input$pathogen)
+    run$pathogens <- user_pathogens
+  }
+  pathogen_set()
+}
+
+pathogen_set <- function() {
+  # select the pathogen from the pathogen inputs
+  p <- run$pathogens[run$pathogens$name == run$settings$pathogen, ]
+  if (nrow(p) == 0) {
+    msg <- sprintf(
+      "Could not find %s in the pathogen inputs", run$settings$pathogen
+    )
+    logger::log_fatal(msg)
+    stop(msg)
+  }
+  if (nrow(p) > 1) {
+    logger::log(
+      sprintf("Multiple entries of %s are found in the pathogen inputs.
+              Selecting first occurence", run$settings$pathogen)
+    )
+  }
+  # select first occurrence
+  p <- p[1, ]
+  run$settings$pathogen_params <- as.list(p)
+}

R/pathways.R

+
+pathways_humans <- function(df_human_emissions){
+
+  df_human_pathways <- df_human_emissions %>%
+    dplyr::rowwise() %>%
+    dplyr::mutate(
+      to_wwtp = sum(to_fecalSludge, to_sewerage, na.rm = TRUE)) %>%
+    dplyr::group_by(iso, sanitation_type) %>%
+    dplyr::summarise(
+      humans2land = sum(to_land, na.rm = TRUE),
+      humans2wwtp = sum(to_wwtp, na.rm = TRUE),
+      humans2water = sum(to_surface_water, na.rm = TRUE),
+      .groups = "drop"
+    )
+
+  # update the human pathways in global data structure
+  run$emissions$pathways$df_humans <- run$emissions$pathways$df_humans %>%
+    dplyr::group_by(pathway) %>%
+    dplyr::mutate(
+      value = dplyr::case_when(
+        pathway == 'humans2land' ~ df_human_pathways %>% dplyr::select(humans2land) %>%
+          dplyr::pull(),
+        pathway == 'humans2wwtp' ~ df_human_pathways %>% dplyr::select(humans2wwtp) %>%
+          dplyr::pull(),
+        pathway == 'humans2water' ~ df_human_pathways %>% dplyr::select(humans2water) %>%
+          dplyr::pull(),
+        .default = value
+      )
+    )
+}
+
+pathways_wwtp <- function(df_wwtp_emissions){
+  # summarise the surface water emissions from the wwtp over the sanitation_type and area_type
+  df_wwtp_pathways <- df_wwtp_emissions %>%
+    dplyr::rowwise() %>%
+    dplyr::mutate(to_surface_water = sum(out_sewerage, out_fecalSludge, na.rm = TRUE)) %>%
+    dplyr::group_by(iso, sanitation_type) %>%
+    dplyr::summarise(wwtp2water = sum(to_surface_water, na.rm = TRUE), .groups = 'drop')
+
+  run$emissions$pathways$df_humans <- run$emissions$pathways$df_humans %>%
+    dplyr::group_by(pathway) %>%
+    dplyr::mutate(
+      value = dplyr::case_when(
+        pathway == 'wwtp2water' ~ df_wwtp_pathways %>% dplyr::select(wwtp2water) %>% dplyr::pull(),
+        .default = value
+      )
+    )
+}
+
+pathways_land <- function(land_emissions){
+  # summarise the surface water emissions from land over the area types
+  df_human_land_pathways <- land_emissions$df_human %>%
+    dplyr::group_by(iso, sanitation_type) %>%
+    dplyr::summarise(land2water = sum(to_surface_water, na.rm = TRUE), .groups = 'drop')
+  # update the values for all land2water rows when pathway is land2water
+  run$emissions$pathways$df_humans <- run$emissions$pathways$df_humans %>%
+    dplyr::group_by(pathway) %>%
+    dplyr::mutate(
+      value = dplyr::case_when(
+        pathway == 'land2water' ~ df_human_land_pathways %>% dplyr::select(land2water) %>%
+          dplyr::pull(),
+        .default = value
+      )
+    )
+}
+
+pathways_humans_rast <- function(df_human_emissions){
+  # calculate the emissions from humans direct to surface water
+  df_humans2water <- df_human_emissions %>%
+    dplyr::group_by(iso, area_type) %>%
+    dplyr::summarise(humans2water = sum(to_surface_water, na.rm = TRUE), .groups = 'drop')
+
+  df_population <- run$params %>% dplyr::select(iso, pop_grid_urban, pop_grid_rural)
+  df_humans2water <- df_humans2water %>%
+    dplyr::group_by(area_type) %>%
+    dplyr::mutate(humans2water_pp = dplyr::case_when(
+      area_type == 'urban' ~ humans2water / (df_population %>% dplyr::select(pop_grid_urban) %>% dplyr::pull()),
+      area_type == 'rural' ~ humans2water / (df_population %>% dplyr::select(pop_grid_rural) %>% dplyr::pull()),
+      .default = NA)) %>%
+    dplyr::mutate(
+      humans2water_pp = replace(humans2water_pp, !is.finite(humans2water_pp),0)
+    )
+
+  rast_humans2water <- df_humans2water %>%
+    dplyr::group_by(area_type) %>%
+    dplyr::select(humans2water_pp, iso, area_type) %>%
+    dplyr::group_map(~{ terra::subst(
+      run$domain$isoraster,
+      from=.x$iso,
+      to=.x$humans2water_pp, others=0 ,names= paste('humans2water_pp',.y, sep = "_"))}) %>%
+    terra::rast()
+
+  rast_humans2water$humans2water_rural <- rast_humans2water$humans2water_pp_rural * run$populations$rural
+  rast_humans2water$humans2water_urban <- rast_humans2water$humans2water_pp_urban * run$populations$urban
+
+  rast_humans2water$humans2water <- sum(rast_humans2water$humans2water_rural, rast_humans2water$humans2water_urban, na.rm = TRUE)
+  # update the raster in the global structure
+  run$emissions$pathways$rast$humans2water <- rast_humans2water$humans2water
+}
+
+pathways_land_rast <- function(land_emissions){
+  df_human_land2water <- land_emissions$df_human %>%
+    dplyr::group_by(iso, area_type) %>%
+    dplyr::summarise(
+      land2water = sum(to_surface_water, na.rm = TRUE)
+    )
+  df_population <- run$params %>% dplyr::select(iso, pop_grid_urban, pop_grid_rural)
+
+  # calculate the land2water emissions per person for each area type
+  df_human_land2water <- df_human_land2water %>%
+    dplyr::group_by(area_type) %>%
+    dplyr::mutate(
+      land2water_pp = dplyr::case_when(
+        area_type == 'urban' ~ land2water / df_population %>% dplyr::select(pop_grid_urban) %>% dplyr::pull(),
+        area_type == 'rural' ~ land2water / df_population %>% dplyr::select(pop_grid_rural) %>% dplyr::pull(),
+        .default = NA
+      )) %>% dplyr::mutate(
+        land2water_pp = replace(land2water_pp, !is.finite(land2water_pp),0)
+      )
+  # rasterize the land2water emissions per person from rural and urban areas
+  rast_land2water <- df_human_land2water %>%
+    dplyr::group_by(area_type) %>%
+    dplyr::select(land2water_pp, iso, area_type) %>%
+    dplyr::group_map(~{ terra::subst(
+      run$domain$isoraster,
+      from=.x$iso,
+      to=.x$land2water_pp, others=0 ,names= paste('land2water_pp',.y, sep = "_"))}) %>%
+    terra::rast()
+  # multiply by the gridded population
+  rast_land2water$land2water_urban <- rast_land2water$land2water_pp_urban * run$populations$urban
+  rast_land2water$land2water_rural <- rast_land2water$land2water_pp_rural * run$populations$rural
+  # sum the land2water emissions from rural and urban areas
+  rast_land2water$land2water <- sum(rast_land2water$land2water_urban, rast_land2water$land2water_rural, na.rm = TRUE)
+  # update the raster in global structure
+  run$emissions$pathways$rast$land2water <- rast_land2water$land2water
+}
+
+pathways_wwtp_rast <- function(df_emissions_wwtp, df_wwtp_inputs = NULL){
+  rast_wwtp2water <- NULL
+  if(run$settings$wwtp == 'POINT' && is.null(df_wwtp_inputs)){
+    msg <- 'waste water treatment plant input data required when running wwtp in POINT mode'
+    logger::log_fatal(msg)
+    stop(msg)
+  }
+  else if(run$settings$wwtp == 'POINT'){
+    rast_wwtp2water = wwtp_point_emissions_to_grid(df_emissions_wwtp, df_wwtp_inputs)
+  }
+  else if(run$emissions$wwtp == 'AREA'){
+    rast_wwtp2water = wwtp_area_emissions_to_grid(df_emissions_wwtp)
+  }
+  if(!is.null(rast_wwtp2water)){
+    run$emissions$pathways$rast$wwtp2water <- rast_wwtp2water
+  }
+}

R/population.R

+population_set <- function(){
+  logger::log_debug('Read population data')
+  populations <- terra::rast(unlist(run$settings$input$population))
+  names(populations) <- names(run$settings$input$population)
+  validate_population(populations)
+  populations_corrected <- population_correct(populations)
+  run$populations <- populations_corrected
+}
+
+population_correct <- function(populations){
+  logger::log_debug('Correct gridded population data')
+  # calculate summed urban and rural population by iso value from the gridded population data
+  summed_populations <- lapply(populations,terra::zonal,z=run$domain$isoraster,fun='sum',na.rm=TRUE)
+  # convert to a dataframe
+  summed_populations <- data.frame(summed_populations)
+  # clean and specify different column names. filter only iso values from input parameters
+  summed_populations <- data.frame(
+    iso=summed_populations$isoraster,
+    pop_grid_urban=summed_populations$urban,
+    pop_grid_rural=summed_populations$rural) %>% dplyr::filter(iso %in% run$params$iso)
+  # merge results with parameters
+  merged_params <- merge(run$params,summed_populations,by = 'iso')
+  # replace the parameters with the merged parameters
+  run$params <- merged_params
+  # calculate the urban and rural population from the parameters
+  urban_pop <- run$params$fraction_urban_pop * run$params$population
+  rural_pop <- (1 - run$params$fraction_urban_pop) * run$params$population
+  # calculate the difference between gridded population data and population from the parameters
+  diff_urban <- urban_pop / run$params$pop_grid_urban
+  diff_rural <- rural_pop / run$params$pop_grid_rural
+  # replace NA values as result from division by zero.
+  diff_urban <- data.frame(iso = run$params$iso, value = diff_urban) %>% replace(is.na(.),0)
+  diff_rural <- data.frame(iso = run$params$iso, value = diff_rural) %>% replace(is.na(.),0)
+  # create rasters with the difference factor
+  diff_urban_rast <- terra::subst(run$domain$isoraster, diff_urban$iso, diff_urban$value)
+  diff_rural_rast <- terra::subst(run$domain$isoraster, diff_rural$iso, diff_rural$value)
+  # finally correct the gridded population with the found differences
+  populations$urban <- populations$urban * diff_urban_rast
+  populations$rural <- populations$rural * diff_rural_rast
+  return(populations)
+}
+
+

R/settings.R

+#' settings_load
+#'
+#' @param file
+#'
+#' @return
+#'
+#' @examples
+settings_load <- function(file) {
+  # validate the file
+  is_yaml <- configr::is.yaml.file(file)
+  if (!is_yaml) {
+    msg <- "GloWPa settings must be a valid yaml file"
+    logger::log_fatal(msg)
+    stop(msg)
+  }
+  glowpa_settings <- configr::read.config(file)
+  settings_apply(glowpa_settings)
+}
+
+#' settings
+#'
+#' @return
+#' @export
+#'
+#' @examples
+settings <- function() {
+  return(run$settings)
+}
+
+settings_restore <- function() {
+  logger::log_info("Restore default GloWPa settings.")
+  settings_apply(defaults)
+}
+
+settings_apply <- function(glowpa_settings) {
+  global_settings <- modifyList(defaults, glowpa_settings)
+  run$settings <- global_settings
+}
+
+settings_display <- function() {
+  settings_str <- yaml::as.yaml(run$settings)
+  logger::log_info(paste("Use settings:\n", settings_str))
+}