basepop_five() for early dates, hold 1950 mort constant to back-extrapolate

[peterdavjohnson]

As a temporary fix, for both mortality and fertility, replace any earlier dates with the last available date (1955 for mortality and 1950 for fertility). See attached mod of the two Fetch subs within basepop.R

# test downLoad mods for basepop
library(tidyverse)

downloadnLx <- function(nLx, country, gender, nLxDatesIn) {
  requireNamespace("fertestr", quietly = TRUE)
  requireNamespace("magrittr", quietly = TRUE)
  verbose <- getOption("basepop_verbose", TRUE)
  if (!is.null(nLx)) {
    # TR: ensure colnames passed
    nLx <- as.matrix(nLx)
    colnames(nLx) <- nLxDatesIn
    n             <- nrow(nLx)
    Age           <- c(0,1,seq(5,(n-2)*5,by=5))
    rownames(nLx) <- Age
    return(nLx)
  }

  if (is.null(nLx)){

    if (is.null(country)) stop("You need to provide a country to download the data for nLx")

    if (verbose) {
      cat(paste0("Downloading nLx data for ", country, 
                 ", years ", paste(nLxDatesIn,collapse=", "), 
                 ", gender ", gender), sep = "\n")
    }
    . <- NULL
    nLx <-
      lapply(nLxDatesIn, function(x) {

        if (x < 1955) {
          if (verbose) {
            cat(paste0("year ", x, " changed to 1955\n"))
          }

          x <- 1955
        }

        fertestr::FetchLifeTableWpp2019(country, x, gender)$Lx
      }) %>% do.call("cbind", .) %>% as.matrix()

    colnames(nLx) <- nLxDatesIn
    n             <- nrow(nLx)
    Age           <- c(0,1,seq(5,(n-2)*5,by=5))
    rownames(nLx) <- Age
    return(nLx)
  }
}

downloadAsfr <- function(Asfrmat, country, AsfrDatesIn) {
  requireNamespace("fertestr", quietly = TRUE)
  verbose <- getOption("basepop_verbose", TRUE)

  if (!is.null(Asfrmat)) {
    # TR: can we assume colnames are AsfrDatesIn ?
    return(Asfrmat)
  }

  if (is.null(country)) stop("You need to provide a country to download the data for Asfrmat")

  tmp <-
    lapply(AsfrDatesIn, function(x) {

      if (verbose) {
        cat(paste0("Downloading Asfr data for ", country, ", year ", x), sep = "\n")
      }

      if (x < 1950) {
        if (verbose) {
          cat(paste0("year ", x, " changed to 1950\n"))
        }
        x <- 1950
      }

      res        <- fertestr::FetchFertilityWpp2019(country, x)["asfr"]
      names(res) <- NULL
      as.matrix(res)[2:nrow(res), , drop = FALSE]
    }) 

  Asfrmat           <- do.call(cbind, tmp)
  colnames(Asfrmat) <- AsfrDatesIn
  Asfrmat
}

Lx55 <- downloadnLx(NULL, "Ghana", "female", c(1955.0, 1963.0))
Lx50 <- downloadnLx(NULL, "Ghana", "female", c(1950.0, 1963.0))
Lx40 <- downloadnLx(NULL, "Ghana", "female", c(1940.0, 1963.0))

asfr50 <- downloadAsfr(NULL, "Ghana", c(1950))
asfr40 <- downloadAsfr(NULL, "Ghana", c(1940))

[timriffe]

Hi @peterdavjohnson this should now be handled, could you please give a try?