Function to export proportion aware of status by age and sex from .shiny90 output file

shiny90-datapack-extract.R

#' Export proportion aware by five year age group from Shiny90
#'
#' Export estimates for proportion aware of status from a Shiny90
#' output file to five-year age groups 15-19 to 50+.
#'
#' @param shiny90_path file path to .shiny90 digest file.
#' @param out_path output path to save CSV of proportion aware.
#' @param year year(s) to generate estimates; an integer or a vector of integers.
#'
#' @return
#' Path name to saved CSV file (`out_path`). As a side effect the function
#' saves a CSV file to this location.
#'
#' @details
#' This function requires the 'first90' package from
#' https://github.com/mrc-ide/first90release. Install this via:
#'
#' `devtools::install_github("mrc-ide/first90release")`
#'
#' The 'artnum' divided by 'plhiv' columns in the output will give
#' a different ART coverage than Spectrum output for the same year
#' because these outputs are based on the internal mid-year ART
#' coverage in Spectrum, while Spectrum reports an end of year (Dec 31)
#' ART coverage.
#'
#' @examples
#'
#' library(first90)
#'
#' path <- "~/Downloads/Mozambique.zip.shiny90"
#' out_path <- "~/Downloads/moz_shiny90_datapack.csv"
#'
#' shiny90_datapack_age_sex(path, out_path, year = 2019)
#'
shiny90_datapack_age_sex <- function(shiny90_path, out_path, year = 2019) {

  exdir <- tempfile()
  unzip(shiny90_path, exdir = exdir)

  name <- readLines(file.path(exdir, "country.txt"))[1]
  spec <- lapply(list.files(file.path(exdir, "spectrum_data"), "rds$", full.names = TRUE), readRDS)
  spec <- lapply(spec, "[[", "data")
  fp <- first90::prepare_inputs_from_extracts(spec)
  fp$popadjust <- FALSE

  par <- readRDS(file.path(exdir, "model_outputs/par.rds"))

  fpsim <- first90::create_hts_param(par, fp)
  mod <- first90::simmod(fpsim)

  age_groups <- c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-99")

  val <- expand.grid(area = name,
                     year = year,
                     sex = c("female", "male"),
                     agegr = age_groups,
                     hivstatus = "positive",
                     stringsAsFactors = FALSE)
  df <- first90::add_ss_indices(val, fp$ss)

  plhiv <- numeric(nrow(df))
  artnum  <- numeric(nrow(df))
  aware <- numeric(nrow(df))

  for (i in seq_along(df$haidx)) {
    haidx <- df$haidx[i] + 1:df$hagspan[i] - 1
    sidx <- if (df$sidx[i] == 0) { 1:2 } else { df$sidx[i] }
    paidx <- fp$ss$agfirst.idx[df$haidx[i]] + 1:sum(fp$ss$h.ag.span[haidx]) - 1L

    artnum[i] <- sum(attr(mod, "artpop")[ , , df$haidx[i] + 1:df$hagspan[i] - 1, sidx, df$yidx[i]])
    plhiv[i] <- artnum[i] + sum(attr(mod, "hivpop")[ , df$haidx[i] + 1:df$hagspan[i] - 1, sidx, df$yidx[i]])
    aware[i] <- artnum[i] + sum(attr(mod, "diagnpop")[, df$haidx[i] + 1:df$hagspan[i] - 1, sidx, df$yidx[i]])
  }

  val$plhiv <- plhiv
  val$aware <- aware
  val$artnum <- artnum
  val$proportion_aware <- first90::diagnosed(mod, fp, df)

  val$agegr[val$agegr == "50-99"] <- "50+"

  write.csv(val, out_path, row.names = FALSE, na = "")

  out_path
}