R/population.R

In pik-piam/magpie4: MAgPIE outputs R package for MAgPIE version 4.x

#' @title population
#' @description reads population out of a MAgPIE gdx file
#'
#' @export
#'
#' @param gdx          GDX file
#' @param file         a file name the output should be written to using write.magpie
#' @param level        Level of regional aggregation; "reg" (regional),
#'                     "glo" (global), "regglo" (regional and global)
#'                     or any other aggregation level defined in superAggregate
#' @param age          if TRUE, population is split up by age groups
#' @param sex          if TRUE, population is split up by sex
#' @param bmi_groups   if TRUE, the population will be split up in body-mass-index groups.
#' @param dir          for gridded outputs: magpie output directory which contains
#'                     a mapping file (rds or spam) disaggregation
#' @param spamfiledirectory deprecated. please use \code{dir} instead
#'
#' @return population as MAgPIE object (million people)
#'
#' @author Florian Humpenoeder, Benjamin Bodirsky, Isabelle Weindl
#'
#' @importFrom magclass colSums getYears dimSums
#' @importFrom gdx readGDX
#'
#' @seealso \code{\link{reportPopulation}}
#' @examples
#' \dontrun{
#' x <- population(gdx)
#' }
#'
population <- function(gdx, file = NULL, level = "reg", age = FALSE, sex = FALSE,
                       bmi_groups = FALSE, dir = ".", spamfiledirectory = "") {

  dir <- getDirectory(dir, spamfiledirectory)

  pop <- readGDX(gdx, "im_demography", format = "first_found", react = "warning")
  pop <- pop + 0.000001

  # Check: sum of decomposition of population (im_demography) must be equal to population
  pop2 <- readGDX(gdx, "im_pop_iso", format = "first_found", react = "warning")
  # add one person to each country + age group to avoid division by zeros
  if (sum(abs(dimSums(pop, dim = 3) - pop2)) > 10) {
    warning(paste0("datasets for demogragphy and population diverge by: ",
                   round(sum(abs(dimSums(pop, dim = 3) - pop2)) / length(getYears(pop))),
                   " Mio people on average per time step"))
  }


  # subset years
  pop <- pop[, readGDX(gdx, "t"), ]

  underaged <- readGDX(gdx, "underaged15")
  working   <- readGDX(gdx, "working15")
  retired   <- readGDX(gdx, "retired15")
  adults    <- setdiff(readGDX(gdx, "age"), underaged)

  if (age == FALSE) {

    pop <- dimSums(pop, dim = "age")

  } else if (age == "adults") {

    pop <- pop[, , adults]
    pop <- dimSums(pop, dim = "age")

  } else if (age == "underaged") {

    pop <- pop[, , underaged]
    pop <- dimSums(pop, dim = "age")

  } else if (age == "working") {

    pop <- pop[, , working]
    pop <- dimSums(pop, dim = "age")

  } else if (age == "retired") {

    pop <- pop[, , retired]
    pop <- dimSums(pop, dim = "age")

  } else if (age != TRUE) {

    pop <- pop[, , age]
    pop <- dimSums(pop, dim = "age")

  }

  if (sex == FALSE) {

    pop <- dimSums(pop, dim = "sex")

  } else if (sex != TRUE) {

    pop <- pop[, , sex]
    pop <- dimSums(pop, dim = "sex")

  }

  if (bmi_groups == TRUE) {

    bmiShr <- anthropometrics(gdx = gdx, indicator = "bmi_shr", level = "iso",
                               sex = sex, age = age, bmi_groups = TRUE)

    pop <- pop * bmiShr

  } else if (bmi_groups != FALSE) {

    bmiShr <- anthropometrics(gdx = gdx, indicator = "bmi_shr", level = "iso",
                               sex = sex, age = age, bmi_groups = TRUE)
    pop     <- pop * bmiShr
    pop     <- pop[, , bmi_groups]
    pop     <- dimSums(pop, dim = "bmi_group15")
  }

  pop <- gdxAggregate(gdx, pop, to = level, absolute = TRUE,
                      dir = dir, weight = "land", types = "urban")

  out(pop, file)
}