R/rxode_conversion.R

In campsismod: Generic Implementation of a PK/PD Model

#' Get code for rxode2
#'
#' @param model Campsis model
#' @return corresponding model code for rxode2
#' @export
rxode_code <- function(model) {
  records <- model@model
  properties <- model@compartments@properties
  propertiesCode <- NULL
  if (properties %>% length() > 0) {
    for (property in properties@list) {
      compartmentIndex <- property@compartment
      compartment <- model@compartments %>% find(Compartment(index = compartmentIndex))
      equation <- property %>% to_string(model = model, dest = "rxode2")
      propertiesCode <- propertiesCode %>% append(equation)
    }
  }

  # All records to character vector
  code <- NULL
  for (record in records@list) {
    for (statement in record@statements@list) {
      code <- code %>% append(statement %>% to_string(dest = "rxode2"))
    }
    if (is(record, "ode_record")) {
      code <- code %>% append(propertiesCode)
    }
  }
  return(code)
}

#' Get the parameters vector for rxode2.
#'
#' @param model Campsis model
#' @return named vector with THETA values
#' @export
rxode_params <- function(model) {
  type <- "theta"
  params <- model@parameters
  if (params %>% length() == 0) {
    retValue <- numeric(0)
    names(retValue) <- character(0)
    return(retValue) # Must be named numeric, otherwise rxode2 complains
  }
  max_index <- params %>% select("theta") %>% max_index()

  # Careful, as.numeric(NA) is important...
  # If values are all integers, rxode2 gives a strange error message:
  # Error in rxSolveSEXP(object, .ctl, .nms, .xtra, params, events, inits,  :
  # when specifying 'thetaMat', 'omega', or 'sigma' the parameters cannot be a 'data.frame'/'matrix'

  retValue <- rep(as.numeric(NA), max_index)
  names <- rep("", max_index)

  for (i in seq_len(max_index)) {
    param <- params %>% get_by_index(Theta(index = i))
    if (length(param) == 0) {
      stop(paste0("Missing param ", i, "in ", type, " vector"))
    } else {
      retValue[i] <- param@value
      names[i] <- param %>% get_name_in_model()
    }
  }
  names(retValue) <- names

  return(retValue)
}

#' Get the OMEGA/SIGMA matrix for rxode2.
#'
#' @param model Campsis model or Campsis parameters
#' @param type either omega or sigma
#' @return omega/sigma named matrix
#' @export
rxode_matrix <- function(model, type = "omega") {
  if (is(model, "campsis_model")) {
    subset <- model@parameters %>%
      select(type)
  } else if (is(model, "parameters")) {
    subset <- model %>%
      select(type)
  } else {
    stop("model must be either a Campsis model or a parameters object")
  }

  if (subset %>% length() == 0) {
    return(matrix(data = numeric(0), nrow = 0, ncol = 0))
  }

  # Standardise parameters
  subset <- subset %>%
    standardise()

  # Retrieve max index
  max_index <- subset %>%
    max_index()
  matrix <- matrix(0L, nrow = max_index, ncol = max_index)
  names <- rep("", max_index)

  # Fill in matrix
  for (elem in subset@list) {
    matrix[elem@index, elem@index2] <- elem@value
    matrix[elem@index2, elem@index] <- elem@value
    if (elem@index == elem@index2) {
      names[elem@index] <- elem %>% get_name_in_model()
    }
  }

  assertthat::assert_that(all(names != ""), msg = sprintf("At least one %s is missing.", toupper(type)))

  rownames(matrix) <- names
  colnames(matrix) <- names
  return(matrix)
}