R/get_covColNames.R

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

# get the name of the column mapped to covariate
getCovColNames <- function(Lines, categoricalFlag = FALSE) {
  linNos <- grep("^\\W*covr\\W*\\(", Lines)
  CovColNames <- c()
  for (lineIndex in linNos) {
    line <- Lines[lineIndex]
    tokens <- unlist(strsplit(line, split = "(", fixed = TRUE))
    if (length(tokens) >= 2) {
      covarName <-
        regmatches(tokens[2],
                   gregexpr("(?<=\")(.*?)(?=\")", tokens[2], perl = TRUE))[[1]]
    } else {
      stop("please check the cols1.txt file:\n",
           Lines)
    }

    if (length(tokens) > 2) {
      # second open bracket means categorical covariate
      isCategorical <- TRUE
    } else {
      isCategorical <- FALSE
    }

    if (isCategorical == categoricalFlag) {
      CovColNames <- c(CovColNames, covarName)
    }
  }

  CovColNames
}

# get the names of the covariates used in the model
# got this from cols1 since otherwise the model with any unmapped cov
# won't work
getCovModelNames <- function(Lines) {
  linNos <- grep("^\\W*covr\\W*\\(", Lines)
  CovNames <- c()
  for (lineIndex in linNos) {
    line <- gsub("^\\W*covr\\W*\\(", "", Lines[lineIndex])
    covarName <- trimws(strsplit(line, "<-")[[1]][1])
    CovNames <- c(CovNames, covarName)
  }

  CovNames
}

get_catcovNames <- function(cols1.txt, mappedCovariates) {
  catcovColNames <-
    getCovColNames(cols1.txt, categoricalFlag = TRUE)
  if (!is.null(catcovColNames)) {
    if (any(catcovColNames %in% mappedCovariates)) {
      catcovNames <-
        names(mappedCovariates)[mappedCovariates %in% catcovColNames]
    } else {
      catcovNames <- NULL
    }
  } else {
    catcovNames <- NULL
  }

  catcovNames
}

get_contcovNames <- function(cols1.txt, mappedCovariates) {
  contcovColNames <-
    getCovColNames(cols1.txt, categoricalFlag = FALSE)
  if (!is.null(contcovColNames)) {
    if (any(contcovColNames %in% mappedCovariates)) {
      contcovNames <-
        names(mappedCovariates)[mappedCovariates %in% contcovColNames]
    } else {
      contcovNames <- NULL
    }
  } else {
    contcovNames <- NULL
  }

  contcovNames
}