R/enrich.R

In tame: Timing, Anatomical, Therapeutic and Chemical Based Medication Clustering

#' Enrich Clustering Parameter
#'
#' Enrich the parameter information in a clustering with user-defined data.
#'
#' @param object A medic object for enrichment.
#' @param additional_data A data frame with additional data that may be
#'   (left-)joined onto the `parameters` in `object`.
#' @param by A character vector of variables to join by. This variables is
#'    passed to the `by` term in a [dplyr::left_join()] and inherits its
#'    behavior:
#'
#'    If `NULL`, the default, the join will perform a natural join, using all
#'    variables in common across the `parameters` and
#'    `additional_data`.
#'
#'    To join by different variables on `parameters` and
#'    `additional_data`, use a named vector. For example,
#'    `by = c("k" = "cluster_size")` will match `parameters$k` to
#'    `additional_data$cluster_size`.
#'
#'    To join by multiple variables, use a vector with length > 1. For example,
#'    `by = c("k", "summation_method")` will match `parameters$k` to
#'    `additional_data$k` and `parameters$summation_method` to \cr
#'    `additional_data$summation_method`. Use a named vector to match different
#'    variables in `parameters` and `additional_data`.
#'
#'    For example, `by = c("k" = "cluster_size", "summation_method" = "sm")`
#'    will match `parameters$k` to `additional_data$cluster_size` and
#'    `parameters$summation_method` to `additional_data$sm`.
#'
#' @details
#' The `enrich()` function is a joining function used for enriching the
#' clustering characteristics with user-defined data. This function is used in
#' all of the investigative functions with a `additional_data` statement such as
#' [`summary()`], [`cluster_frequency()`] and [`medication_frequency()`].
#'
#' @return
#' An object of class \emph{medic}.
#'
#'
#' @examples
#' clust <- medic(
#'    complications,
#'    id = id,
#'    atc = atc,
#'    timing = first_trimester:third_trimester,
#'    k = 3:5
#' )
#'
#' new_parameters <- data.frame(k = 3:5, size = c("small", "small", "large"))
#'
#' enrich(clust, new_parameters)
#'
#' @export
enrich <- function(object, additional_data = NULL, by = NULL) {
  if (!is.null(additional_data)) {
    if (is.null(by)) {
      bys <- intersect(
        names(additional_data),
        names(object$parameters)
      )
    } else {
      bys <- by
    }
    new <- object
    new$parameters <- new$parameters %>%
      dplyr::left_join(additional_data, by = bys)
    return(new)
  }
  return(object)
}