Function to update FRR fitting input in Spectrum PJNZ file

pjnz-frr-input-update.R

## Requires library eppasm

dpsub <- function(dp, tag, rows, cols, tagcol = 1) {
  dp[which(dp[, tagcol] == tag) + rows, cols]
}


read_frr_fit_input <- function(pjnz) {

  dp <- eppasm::read_dp(pjnz)

  yr_start <- as.integer(dpsub(dp, "<FirstYear MV2>", 2, 4))
  yr_end <- as.integer(dpsub(dp, "<FinalYear MV2>", 2, 4))
  proj.years <- yr_start:yr_end
  timedat.idx <- 4 + 1:length(proj.years) - 1

  status_ascertained <- as.numeric(dpsub(dp, "<FRRFitInput MV>", 2, timedat.idx))
  anc_prevalence <- as.numeric(dpsub(dp, "<FRRFitInput MV>", 3, timedat.idx))

  data.frame(
    year = proj.years,
    status_ascertained,
    anc_prevalence
  )
}


#' Update FRR fitting prevalence input in PJNZ .DP file
#'
#' @param pjnz path to base PJNZ file
#' @param pjnz_new path to new PJNZ file
#' @param eppd_new new EPP data set; constructed by `read_frr_fit_input()`
#'
#' @examples
#'
#' ## Step 1: Read FRR fitting input datea
#' pjnz <- "~/Downloads/mwi-xml-test.pjnz"
#' frrd <- read_frr_fit_input(pjnz)
#'
#' ## Step 2: Update the EPP ANC data
#' ##   * Do not change data.frame structure
#' ##   * It should be okay to remove rows that are unchanged
#'
#' frrd_new <- frrd
#'
#' frrd_new$status_ascertained <- floor(0.85 * frrd$status_ascertained)
#' frrd_new$anc_prevalence <- 0.85 * frrd$anc_prevalence
#'
#' ## Step 3: Write a new PJNZ file with updated FRR fitting data
#' ##   * Requires the base file
#'
#' update_frr_fit_input("~/Downloads/mwi-xml-test.pjnz",
#'                      "~/Downloads/mwi-xml_updated-frr-input.pjnz",
#'                       frrd_new)
#'
update_frr_fit_input <- function(pjnz, pjnz_new, frr_input_new) {

  ## Read raw DP file with `readLines()` (instead of read.csv())
  dpfile <- grep(".DP$", unzip(pjnz, list = TRUE)$Name, value = TRUE)
  dpl <- readLines(unz(pjnz, dpfile))

  dp <- read.csv(text = dpl, as.is = TRUE)
  yr_start <- as.integer(dpsub(dp, "<FirstYear MV2>", 2, 4))
  yr_end <- as.integer(dpsub(dp, "<FinalYear MV2>", 2, 4))
  proj.years <- yr_start:yr_end
  timedat.idx <- 4 + 1:length(proj.years) - 1


  ## Construct new line string for FRR input with same number of commas

  frrinput_tag_idx <- grep("<FRRFitInput MV>", dpl)
  cidx <- match(proj.years, frr_input_new$year)

  n_new <- rep(0, length(proj.years))
  prev_new <- rep(0.0, length(proj.years))

  n_new[cidx] <- frr_input_new$status_ascertained
  prev_new[cidx] <- frr_input_new$anc_prevalence

  n_new_line <- paste0(",<Value>,,",
                       paste0(n_new, collapse = ","),
                       paste0(rep(",", ncol(dp) - length(prev_new) - 3), collapse = ""))
  prev_new_line <- paste0(",,,",
                          paste0(prev_new, collapse = ","),
                          paste0(rep(",", ncol(dp) - length(prev_new) - 3), collapse = ""))

  stopifnot(ncol(read.csv(text = prev_new_line)) == ncol(dp))
  stopifnot(ncol(read.csv(text = n_new_line)) == ncol(dp))

  dpl[[frrinput_tag_idx+2]] <- n_new_line
  dpl[[frrinput_tag_idx+3]] <- prev_new_line


  ## Update <Projection Valid MV2> flag to trigger re-projection
  pv_tag_idx <- grep("<ProjectionValid MV2>", dpl)
  dpl[pv_tag_idx + 2] <- gsub("0", "1", dpl[pv_tag_idx + 2])

  ## Save new PJNZ file
  ## Note:: temp saving in the working directory is a bit sloppy.
  file.copy(pjnz, pjnz_new)
  writeLines(dpl, dpfile)
  on.exit(file.remove(dpfile))
  utils::zip(pjnz_new, dpfile)

  pjnz_new
}