R/define_observation_period.R

In patrickwu510/ddiwas: What the Package Does (One Line, Title Case)

#' Define observation period window
#' Last updated: 2020-06-22
#'
#' @param drug_name A string
#' @param medications A tibble
#' @param covariates A tibble
#' @param num_observation_time A number
#' @param str_observation_time A string
#' @param num_rxcui_ingr A number
#' @param cols_adr_exposure A vector
#' @param cols_start_end A vector
#' @param cols_selected A vector
#' @param cols_obs_controls A vector
#' @return A tibble \code{observation_period}
#' @export

define_observation_period <- function(drug_name, medications, covariates, num_observation_time, str_observation_time, str_observation_time_controls, num_rxcui_ingr, cols_adr_exposure, cols_start_end, cols_selected, cols_obs_controls) {

  #get observation periods for cases
  case_covariates <- covariates %>%
    filter(groupc == 1) %>%
    select(all_of(cols_adr_exposure))
  names(case_covariates) <- cols_start_end
  drug_start_date <- as.character(glue('{drug_name}_start_date'))
  ##to `case_covariates`, add `str_observation_time` from `adr_end_date`
  case_covariates[[str_observation_time]] <- case_covariates$adr_end_date-days(num_observation_time)
  ##set observation time start date
  case_covariates$start_date <- if_else(case_covariates[[drug_start_date]] < case_covariates[[str_observation_time]],
                                        case_covariates[[str_observation_time]],
                                        case_covariates[[drug_start_date]])
  ##remove some columns
  case_covariates <- case_covariates %>%
    select(person_id, start_date, adr_end_date, groupc)
  ##rename columns
  names(case_covariates) <- c("person_id", "start_date", "end_date", "groupc")
  ##calculate `obs_length` between 'start_date' and 'end_date'
  case_covariates$obs_length <- as.numeric(case_covariates$end_date-case_covariates$start_date)

  #get observation periods for controls
  control_covariates <- covariates %>%
    filter(groupc == 0) %>%
    select(all_of(cols_selected), groupc)
  drug_start_date <- as.character(glue('first_{drug_name}_exposure_date'))
  ##to `control_covariates`, add `str_observation_time_controls` from `first_{drug_name}_exposure_date`, forward
  control_covariates[[str_observation_time_controls]] <- control_covariates[[drug_start_date]]+days(num_observation_time)
  ##set end of observation period to last date of object drug exposure if it occurs less than 365 days after first date of exposure to object drug
  last_drug_exposure <- as.character(glue('last_{drug_name}_exposure_date'))
  control_covariates$end_date <- if_else(control_covariates[[last_drug_exposure]] < control_covariates[[str_observation_time_controls]],
                                         control_covariates[[last_drug_exposure]],
                                         control_covariates[[str_observation_time_controls]])
  ##remove irrelevant columns
  control_covariates <- control_covariates %>%
    select(all_of(cols_obs_controls))
  names(control_covariates) <- c("person_id", "start_date", "end_date", "groupc")
  #calculate `obs_length` between 'start_date' and 'end_date'
  control_covariates$obs_length <- as.numeric(control_covariates$end_date-control_covariates$start_date)
  #bind case and controls covariates
  observation_period <- bind_rows(case_covariates, control_covariates)

  return(observation_period)
}