population-study-design.R

#' @title addStudyParameters
#' @param population `Population` object
#' @param simulation `Simulation` object
#' @param studyDesignFile file name of study design table
#' @export
#' @import ospsuite
#' @family workflow helpers
addStudyParameters <- function(population, simulation, studyDesignFile) {
  validateIsOfType(population, "Population")
  validateIsOfType(simulation, "Simulation")
  validateIsString(studyDesignFile)

  studyDesign <- loadStudyDesign(studyDesignFile, population, simulation)

  initialTargetValues <- rep(NA, population$count)
  populationData <- ospsuite::populationToDataFrame(population)

  for (target in studyDesign$targets) {
    parameterPath <- target$name

    updatedTargetValues <- updateTargetValues(initialTargetValues, target$values, studyDesign$source, populationData)

    population$setParameterValues(parameterPath, updatedTargetValues)
  }
  # Since population is updated R6 object, no need to export it
  return(invisible())
}

#' @title loadStudyDesign
#' @description Load a StudyDesign object from a file containing a study design table
#' In this table, Line 1 is path,  Line 2 is unit, Line 3 is type and subsequent lines are values.
#' The cells for type can include "SOURCE" OR "TARGET". "SOURCE" type can also include subtype "MIN", "MAX" or "EQUALS".
#' In the current version, unit is expected to be intern units of simulation.
#' @param studyDesignFile file name of study design table
#' @param population `Population` object
#' @param simulation `Simulation` object
#' @return A `StudyDesign` object`
#' @export
loadStudyDesign <- function(studyDesignFile, population, simulation) {
  validateIsOfType(population, "Population")
  validateIsOfType(simulation, "Simulation")
  validateIsString(studyDesignFile)

  designData <- read.csv(studyDesignFile, header = FALSE, stringsAsFactors = FALSE)

  studyDesign <- StudyDesign$new(designData, population, simulation)

  return(studyDesign)
}

# Defines study design format
studyDesignPathLine <- 1
studyDesignUnitLine <- 2
studyDesignTypeLine <- 3

#' @title updateTargetValues
#' @param values initial vector to update
#' @param targetValues vector of values to be assigned using `sourceExpressions`
#' @param sourceExpressions study design expressions to be evaluated
#' @param data population data as data.frame
#' @import ospsuite
#' @keywords internal
updateTargetValues <- function(values, targetValues, sourceExpressions, data) {
  validateIsSameLength(targetValues, sourceExpressions)
  validateIsOfType(data, "data.frame")
  validateIsOfLength(values, nrow(data))

  for (sourceIndex in seq_along(sourceExpressions)) {
    sourceFilter <- eval(sourceExpressions[sourceIndex])

    values[sourceFilter] <- targetValues[sourceIndex]
  }
  return(values)
}

#' @title StudyDesign
#' @description StudyDesign
#' @field source expressions used on source data
#' @field targets list of targets of expressions and associated values
#' @keywords internal
StudyDesign <- R6::R6Class(
  "StudyDesign",
  cloneable = FALSE,
  public = list(
    source = NULL,
    targets = NULL,

    #' @description Create a new `StudyDesign` object.
    #' @param data data.frame read from study design file
    #' @param population `Population` object
    #' @param simulation `Simulation` object
    #' @return `StudyDesign` class object
    initialize = function(data, population, simulation) {
      validateIsOfType(population, "Population")
      validateIsOfType(simulation, "Simulation")
      self$targets <- mapStudyDesignTargets(data, population, simulation)
      self$source <- mapStudyDesignSources(data, population, simulation)

      for (target in self$targets) {
        validateIsSameLength(target$values, self$source)
      }
    },

    #' @description Print study design features
    #' @return data.frame
    print = function() {
      studyDesign <- data.frame(source = as.character(self$source))
      for (target in self$targets) {
        studyDesign <- cbind.data.frame(studyDesign, target$print())
      }
      print(studyDesign)
    }
  )
)

#' @title StudyDesignTarget
#' @description StudyDesignTarget
#' @field name path name of study design target
#' @field values values assigned to study design target
#' @keywords internal
StudyDesignTarget <- R6::R6Class(
  "StudyDesign",
  cloneable = FALSE,
  public = list(
    name = NULL,
    values = NULL,

    #' @description Create a new `StudyDesign` object.
    #' @param name path name of study design target
    #' @param values values assigned to study design target.
    #' `values` must be the same length as source condition expressions
    #' @return `StudyDesignTarget` class object
    initialize = function(name, values) {
      validateIsString(name)
      validateIsNumeric(values)

      self$name <- name
      self$values <- values
    },

    #' @description Print study design target features
    #' @return data.frame
    print = function() {
      target <- data.frame(self$values)
      names(target) <- self$name
      return(target)
    }
  )
)

#' @title mapStudyDesignSources
#' @param data data.frame read from a study design file
#' @param population `Population` object
#' @param simulation `Simulation` object
#' @return vector of expressions assigning target values
#' Must be the same length as target values
#' @import utils
#' @keywords internal
mapStudyDesignSources <- function(data, population, simulation) {
  sourceFilter <- grepl("SOURCE", data[studyDesignTypeLine, ])
  validateIsPositive(sum(sourceFilter))
  # Enforce data.frame with drop = FALSE
  sourceData <- data[, sourceFilter, drop = FALSE]
  sourceExpressions <- NULL

  for (columnIndex in seq(1, ncol(sourceData))) {
    path <- sourceData[studyDesignPathLine, columnIndex]
    values <- as.numeric(utils::tail(sourceData[, columnIndex], -studyDesignTypeLine))

    sourceType <- sourceData[studyDesignTypeLine, columnIndex]
    expressionType <- sourceTypeToExpressionType(sourceType)

    # Covariates are part of population but are not included in simulations
    # For all other paths, they will be checked using getQuantity and converted to base unit
    if (!path %in% population$allCovariateNames) {
      pathQuantity <- ospsuite::getQuantity(path, simulation)
      unit <- sourceData[studyDesignUnitLine, columnIndex]
      values <- ospsuite::toBaseUnit(pathQuantity, values, unit, simulation$molWeightFor(path))
    }

    sourceExpressionsByColumn <- paste0("data[,'", path, "']", expressionType, values)
    sourceExpressionsByColumn[is.na(values)] <- "TRUE"

    ifNotNull(
      sourceExpressions,
      sourceExpressions <- paste(sourceExpressions, sourceExpressionsByColumn, sep = " & "),
      sourceExpressions <- sourceExpressionsByColumn
    )
  }
  return(parse(text = sourceExpressions))
}

sourceTypeToExpressionType <- function(sourceType) {
  validateIsString(sourceType)
  expressionType <- NULL
  if (grepl("MIN", sourceType)) {
    expressionType <- " >= "
  }
  if (grepl("MAX", sourceType)) {
    expressionType <- " < "
  }
  if (grepl("EQUALS", sourceType)) {
    expressionType <- " == "
  }
  if (is.null(expressionType)) {
    validateIsIncluded(sourceType, c("MIN", "MAX", "EQUALS"))
  }
  return(expressionType)
}

#' @title mapStudyDesignTargets
#' @param data data.frame read from a study design file
#' @param population `Population` object
#' @param simulation `Simulation` object
#' @return list of `StudyDesignTarget` objects
#' @import utils
#' @keywords internal
mapStudyDesignTargets <- function(data, population, simulation) {
  targetFilter <- grepl("TARGET", data[studyDesignTypeLine, ])
  validateIsPositive(sum(targetFilter))
  # Enforce data.frame with drop = FALSE
  targetData <- data[, targetFilter, drop = FALSE]
  target <- vector(mode = "list", length = ncol(targetData))

  for (columnIndex in seq(1, ncol(targetData))) {
    path <- targetData[studyDesignPathLine, columnIndex]
    values <- as.numeric(utils::tail(targetData[, columnIndex], -studyDesignTypeLine))

    # Covariates are part of population but are not included in simulations
    # For all other paths, they will be checked using getQuantity and converted to base unit
    if (!path %in% population$allCovariateNames) {
      pathQuantity <- ospsuite::getQuantity(path, simulation)
      unit <- targetData[studyDesignUnitLine, columnIndex]
      values <- ospsuite::toBaseUnit(pathQuantity, values, unit, simulation$molWeightFor(path))
    }
    target[[columnIndex]] <- StudyDesignTarget$new(path, values)
  }
  return(target)
}