R/define_observation_period_rds.R

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

#' Define observation period window
#'
#' @param str_drugname A string
#' @param str_drug_medications A string
#' @param str_drug_covariates A string
#' @param num_observation_time A number
#' @param str_observation_time A string
#' @param num_rxcui_ingr A number
#' @return A tibble \code{observation_period}
#' @export

define_observation_period_rds <- function(str_drugname, str_drug_medications, str_drug_covariates, num_observation_time, str_observation_time, num_rxcui_ingr) {

  #import medications and covariates
  medications <- readRDS(str_drug_medications)
  covariates <- readRDS(str_drug_covariates)

  #get observation periods for cases
  cols <- c('person_id', glue('first_{str_drugname}_exposure_date'), glue('first_{str_drugname}_adr'), 'groupc')
  case_covariates <- covariates %>% filter(groupc == 1)
  case_covariates <- case_covariates %>% select(all_of(cols))
  cols <- c('person_id', glue('{str_drugname}_start_date'), 'adr_end_date', 'groupc')
  names(case_covariates) <- cols
  drug_start_date <- as.character(glue('{str_drugname}_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
  cols <- c('person_id', glue('first_{str_drugname}_exposure_date'), glue('last_{str_drugname}_exposure_date'), 'groupc')
  control_covariates <- covariates %>% filter(groupc == 0)
  control_covariates <- control_covariates %>% select(all_of(cols))
  drug_start_date <- as.character(glue('first_{str_drugname}_exposure_date'))
  ##to `control_covariates`, add `str_observation_time_controls` from `first_{str_drugname}_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_{str_drugname}_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
  cols <- c("person_id", glue('first_{str_drugname}_exposure_date'), "end_date", "groupc")
  control_covariates <- control_covariates %>% select(all_of(cols))
  cols <- c("person_id", "start_date", "end_date", "groupc")
  names(control_covariates) <- cols

  #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)
}