R/get_shrinkages.R

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

get_epsilonShrinkage <- function(nlme7engineLines) {
  # Eps shrinkage
  epsShrinkageLines <-
    nlme7engineLines[grep("Epsilon shrinkage for", nlme7engineLines)]
  if (length(epsShrinkageLines) == 0)
    return(NA)
  epsShrinkageLinesSplitted <-
    strsplit(epsShrinkageLines, "(\\s)")
  # shrinkage -> for -> name of shrinkage
  epsShrinkageLinesNames <-
    sapply(epsShrinkageLinesSplitted, function(x) {
      x[which(x == "shrinkage", arr.ind = TRUE) + 2]
    })
  # value is the last in the row
  epsShrinkageLinesValues <-
    sapply(epsShrinkageLinesSplitted, function(x) {
      dplyr::last(x)
    })
  epsShrinkageTibble <-
    tibble::tibble(epsShrinkageLinesNames, epsShrinkageLinesValues) %>%
    dplyr::arrange(epsShrinkageLinesNames)

  epsShrinkage <- paste(
    epsShrinkageTibble$epsShrinkageLinesNames,
    "=",
    epsShrinkageTibble$epsShrinkageLinesValues,
    collapse = ", "
  )

  epsShrinkage
}

get_etaShrinkage <- function(nlme7engineLines, rnames) {
  # Eta shrinkage
  etaShrinkageLines <-
    nlme7engineLines[grep("eta-shrinkage", nlme7engineLines)]
  if (length(etaShrinkageLines) == 0)
    return(NA)

  if (length(etaShrinkageLines) != length(rnames)) {
    warning(
      "Please check the data, \n",
      "the number of rnadom effects names,",
      length(rnames),
      "\nis not equal to the number of eta shrinkages reported, ",
      length(etaShrinkageLines)
    )
  }

  etaShrinkageArray <- c()
  for (etaShrinkageLine in etaShrinkageLines) {
    curEtaShrinkage <-
      trimws(unlist(strsplit(etaShrinkageLine, split = "="))[[2]])
    etaShrinkageArray <- c(etaShrinkageArray, curEtaShrinkage)
  }

  # change the order to alphabetical since xpose do so during faceting
  etaShrinkageTibble <-
    tibble::tibble(rnames, etaShrinkageArray) %>%
    dplyr::arrange(rnames)
  etaShrinkage <-
    paste(etaShrinkageTibble$rnames,
          "=",
          etaShrinkageTibble$etaShrinkageArray,
          collapse = ", ")

  etaShrinkage
}