R/add_whichReset.R

In Certara.Xpose.NLME: Enhances 'xpose' Diagnostics for Pharmacometric Models from 'Certara.RsNLME' and Phoenix NLME

#' @importFrom magrittr %>%
#' @importFrom rlang !!
#' @importFrom rlang .data
.add_whichReset <- function(input, mapping) {
  inputColnames <- colnames(input)
  if ("WhichReset" %in% inputColnames) {
    warning("WhichReset column exists in the input data and will be overwritten in xpose database.")
  }

  ResetRow <- mapping[grepl("(?<=^|\\n)\\s*reset\\s*\\([^\\n]+\\)", mapping, perl = TRUE)]
  if (length(ResetRow) == 0) {
    input$WhichReset <- 0
  } else if (length(ResetRow) > 1) {
    stop("More than one mapping for the reset is found:\n", paste(mapping, collapse = "\n"))
  } else {
    # reset column is mapped; find out what is inside
    # remove not significant symbols
    pattern <- paste0("(", c("\\s", '\\\"', "\\'"), ")", collapse = "|")
    ResetRow <- gsub(pattern, "", ResetRow)
    ResetValues <- strsplit(ResetRow, "(,c\\()|(\\)\\))")[[1]][2]
    ResetValuesArray <- as.integer(strsplit(ResetValues, ",")[[1]])
    resetColumn <- dplyr::sym(lookupMappedColumn(inputColnames, mapping, "reset"))
    # increment for each subject if the value is within prespecified limits but not the first row
    input <-
      input %>%
      dplyr::group_by(.data$ID) %>%
      dplyr::mutate(WhichReset = cumsum(!!resetColumn >= ResetValuesArray[1] &
        !!resetColumn <= ResetValuesArray[1] &
        dplyr::row_number() != 1)) %>%
      dplyr::ungroup()
  }

  input
}