library(tibble)
library(dplyr)
library(lubridate)
adqs <- tribble(
~USUBJID, ~PARAMCD, ~AVALC, ~ADY,
"1", "NO SLEEP", "N", 1,
"1", "WAKE UP", "N", 2,
"1", "FALL ASLEEP", "N", 3,
"2", "NO SLEEP", "N", 1,
"2", "WAKE UP", "Y", 2,
"2", "WAKE UP", "Y", 3,
"2", "FALL ASLEEP", "N", 4,
"3", "NO SLEEP", NA_character_, 1
)
# Add a new record for each USUBJID storing the the worst sleeping problem.
derive_extreme_event(
adqs,
by_vars = exprs(USUBJID),
events = list(
event(
condition = PARAMCD == "NO SLEEP" & AVALC == "Y",
set_values_to = exprs(AVALC = "No sleep", AVAL = 1)
),
event(
condition = PARAMCD == "WAKE UP" & AVALC == "Y",
set_values_to = exprs(AVALC = "Waking up more than three times", AVAL = 2)
),
event(
condition = PARAMCD == "FALL ASLEEP" & AVALC == "Y",
set_values_to = exprs(AVALC = "More than 30 mins to fall asleep", AVAL = 3)
),
event(
condition = all(AVALC == "N"),
set_values_to = exprs(
AVALC = "No sleeping problems", AVAL = 4
)
),
event(
condition = TRUE,
set_values_to = exprs(AVALC = "Missing", AVAL = 99)
)
),
tmp_event_nr_var = event_nr,
order = exprs(event_nr, desc(ADY)),
mode = "first",
set_values_to = exprs(
PARAMCD = "WSP",
PARAM = "Worst Sleeping Problems"
)
)
# Use different mode by event
adhy <- tribble(
~USUBJID, ~AVISITN, ~CRIT1FL,
"1", 1, "Y",
"1", 2, "Y",
"2", 1, "Y",
"2", 2, NA_character_,
"2", 3, "Y",
"2", 4, NA_character_
) %>%
mutate(
PARAMCD = "ALKPH",
PARAM = "Alkaline Phosphatase (U/L)"
)
derive_extreme_event(
adhy,
by_vars = exprs(USUBJID),
events = list(
event(
condition = is.na(CRIT1FL),
set_values_to = exprs(AVALC = "N")
),
event(
condition = CRIT1FL == "Y",
mode = "last",
set_values_to = exprs(AVALC = "Y")
)
),
tmp_event_nr_var = event_nr,
order = exprs(event_nr, AVISITN),
mode = "first",
keep_source_vars = exprs(AVISITN),
set_values_to = exprs(
PARAMCD = "ALK2",
PARAM = "ALKPH <= 2 times ULN"
)
)
# Derive confirmed best overall response (using event_joined())
# CR - complete response, PR - partial response, SD - stable disease
# NE - not evaluable, PD - progressive disease
adsl <- tribble(
~USUBJID, ~TRTSDTC,
"1", "2020-01-01",
"2", "2019-12-12",
"3", "2019-11-11",
"4", "2019-12-30",
"5", "2020-01-01",
"6", "2020-02-02",
"7", "2020-02-02",
"8", "2020-02-01"
) %>%
mutate(TRTSDT = ymd(TRTSDTC))
adrs <- tribble(
~USUBJID, ~ADTC, ~AVALC,
"1", "2020-01-01", "PR",
"1", "2020-02-01", "CR",
"1", "2020-02-16", "NE",
"1", "2020-03-01", "CR",
"1", "2020-04-01", "SD",
"2", "2020-01-01", "SD",
"2", "2020-02-01", "PR",
"2", "2020-03-01", "SD",
"2", "2020-03-13", "CR",
"4", "2020-01-01", "PR",
"4", "2020-03-01", "NE",
"4", "2020-04-01", "NE",
"4", "2020-05-01", "PR",
"5", "2020-01-01", "PR",
"5", "2020-01-10", "PR",
"5", "2020-01-20", "PR",
"6", "2020-02-06", "PR",
"6", "2020-02-16", "CR",
"6", "2020-03-30", "PR",
"7", "2020-02-06", "PR",
"7", "2020-02-16", "CR",
"7", "2020-04-01", "NE",
"8", "2020-02-16", "PD"
) %>%
mutate(
ADT = ymd(ADTC),
PARAMCD = "OVR",
PARAM = "Overall Response by Investigator"
) %>%
derive_vars_merged(
dataset_add = adsl,
by_vars = exprs(USUBJID),
new_vars = exprs(TRTSDT)
)
derive_extreme_event(
adrs,
by_vars = exprs(USUBJID),
tmp_event_nr_var = event_nr,
order = exprs(event_nr, ADT),
mode = "first",
source_datasets = list(adsl = adsl),
events = list(
event_joined(
description = paste(
"CR needs to be confirmed by a second CR at least 28 days later",
"at most one NE is acceptable between the two assessments"
),
join_vars = exprs(AVALC, ADT),
join_type = "after",
first_cond_upper = AVALC.join == "CR" &
ADT.join >= ADT + 28,
condition = AVALC == "CR" &
all(AVALC.join %in% c("CR", "NE")) &
count_vals(var = AVALC.join, val = "NE") <= 1,
set_values_to = exprs(
AVALC = "CR"
)
),
event_joined(
description = paste(
"PR needs to be confirmed by a second CR or PR at least 28 days later,",
"at most one NE is acceptable between the two assessments"
),
join_vars = exprs(AVALC, ADT),
join_type = "after",
first_cond_upper = AVALC.join %in% c("CR", "PR") &
ADT.join >= ADT + 28,
condition = AVALC == "PR" &
all(AVALC.join %in% c("CR", "PR", "NE")) &
count_vals(var = AVALC.join, val = "NE") <= 1,
set_values_to = exprs(
AVALC = "PR"
)
),
event(
description = paste(
"CR, PR, or SD are considered as SD if occurring at least 28",
"after treatment start"
),
condition = AVALC %in% c("CR", "PR", "SD") & ADT >= TRTSDT + 28,
set_values_to = exprs(
AVALC = "SD"
)
),
event(
condition = AVALC == "PD",
set_values_to = exprs(
AVALC = "PD"
)
),
event(
condition = AVALC %in% c("CR", "PR", "SD", "NE"),
set_values_to = exprs(
AVALC = "NE"
)
),
event(
description = "set response to MISSING for patients without records in ADRS",
dataset_name = "adsl",
condition = TRUE,
set_values_to = exprs(
AVALC = "MISSING"
),
keep_source_vars = exprs(TRTSDT)
)
),
set_values_to = exprs(
PARAMCD = "CBOR",
PARAM = "Best Confirmed Overall Response by Investigator"
)
) %>%
filter(PARAMCD == "CBOR")
Run the code above in your browser using DataLab