Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closes #23: ADVS template program #35

Merged
merged 10 commits into from
Nov 6, 2024
276 changes: 276 additions & 0 deletions inst/templates/ad_advs.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,276 @@
# Name: ADVS
#
# Label: Vital Signs Analysis dataset
#
# Input: adsl, vs


# Attach/load required packages ----
library(admiral)
library(admiralmetabolic)
library(tibble)
library(dplyr)
library(stringr)


# Define project options/variables ----
# Use the admiral option functionality to store subject key variables in one
# place (note: `subject_keys` defaults to STUDYID and USUBJID)
set_admiral_options(subject_keys = exprs(STUDYID, USUBJID))
AndersAskeland marked this conversation as resolved.
Show resolved Hide resolved

# Store ADSL variables required for derivations as an R object, enabling
# simplified usage throughout the program
adsl_vars <- exprs(TRTSDT, TRTEDT, TRT01P, TRT01A)


# Read in data ----
# See the "Read in Data" vignette section for more information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#readdata)

# Read data
vs_metabolic <- admiralmetabolic::vs_metabolic
yurovska marked this conversation as resolved.
Show resolved Hide resolved
adsl <- admiral::admiral_adsl

# Convert SAS missing character values to NA
advs <- vs_metabolic %>%
convert_blanks_to_na()
adsl <- adsl %>%
convert_blanks_to_na()

# Merge ADSL variables (stored in `adsl_vars`) needed for ADVS
advs <- advs %>%
derive_vars_merged(
dataset_add = adsl,
new_vars = adsl_vars,
by_vars = get_admiral_option("subject_keys")
)

# Define parameter look-up table used for merging parameter codes to ADVS
param_lookup <- tribble(
~VSTESTCD, ~PARAMCD, ~PARAM, ~PARAMN, ~PARCAT1, ~PARCAT1N,
"HEIGHT", "HEIGHT", "Height (cm)", 1, "Anthropometric measurement", 1,
"WEIGHT", "WEIGHT", "Weight (kg)", 2, "Anthropometric measurement", 1,
"BMI", "BMI", "Body Mass Index(kg/m2)", 3, "Anthropometric measurement", 1,
"HIPCIR", "HIPCIR", "Hip Circumference (cm)", 4, "Anthropometric measurement", 1,
"WSTCIR", "WSTCIR", "Waist Circumference (cm)", 5, "Anthropometric measurement", 1,
"DIABP", "DIABP", "Diastolic Blood Pressure (mmHg)", 6, "Vital Sign", 2,
"PULSE", "PULSE", "Pulse Rate (beats/min)", 7, "Vital Sign", 2,
"SYSBP", "SYSBP", "Systolic Blood Pressure (mmHg)", 8, "Vital Sign", 2,
"TEMP", "TEMP", "Temperature (C)", 9, "Vital Sign", 2
)

# Add parameter (PARAMCD) info to enable later ADVS derivations. Additional
# parameter information will be merged again, after all AVDS derivations are
# completed.
AndersAskeland marked this conversation as resolved.
Show resolved Hide resolved

# See function documentation for `derive_vars_merged_lookup()`:
# (https://pharmaverse.github.io/admiral/reference/derive_vars_merged_lookup.html)
advs <- advs %>%
derive_vars_merged_lookup(
dataset_add = param_lookup,
new_vars = exprs(PARAMCD),
by_vars = exprs(VSTESTCD)
)


# Derive Date/Time and Analysis Day ----
# See the "Derive/Impute Numeric Date/Time and Analysis Day" vignette section
# for more information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#datetime)

# Add vital sign analysis date (ADT) and treatment start date (TRTSDT)
advs <- advs %>%
derive_vars_dt(new_vars_prefix = "A", dtc = VSDTC) %>%
derive_vars_dy(reference_date = TRTSDT, source_vars = exprs(ADT))


# Derive visit info ----
# See the "Visit and Period Variables" vignette for more information:
# (https://pharmaverse.github.io/admiral/articles/visits_periods.html)

# Derive analysis time point (ATPT, ATPTN) and analysis visit (AVISIT, AVISITN)
advs <- advs %>%
mutate(
ATPT = VSTPT,
ATPTN = VSTPTNUM,
AVISIT = case_when(
is.na(VISIT) ~ NA_character_,
VSTESTCD == "HEIGHT" & VISIT == "SCREENING 1" ~ "Baseline",
str_detect(VISIT, "SCREEN|UNSCHED|RETRIEVAL|AMBUL") ~ NA_character_,
TRUE ~ str_to_title(VISIT)
),
AVISITN = case_when(
VISIT == "BASELINE" | (VSTESTCD == "HEIGHT" & VISIT == "SCREENING 1") ~ 0,
str_detect(VISIT, "WEEK") ~ as.integer(str_extract(VISIT, "\\d+")),
TRUE ~ NA_integer_
)
)


# Derive results ----
# See the "Derive Results (AVAL, AVALC)" vignette section for more information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#aval)

# Derive analysis result (AVAL)
advs <- advs %>%
mutate(AVAL = VSSTRESN)


# Derive domain specific variables ----
# See the "Derive Additional Parameters" vignette section for more information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#derive_param)

# Derive BMI
advs <- advs %>%
filter(VSTESTCD != "BMI") %>%
derive_param_bmi(
by_vars = exprs(
!!!get_admiral_option("subject_keys"), !!!adsl_vars,
AVISIT, AVISITN, ADT, ADY, ATPT, ATPTN
),
set_values_to = exprs(
PARAMCD = "BMI"
),
get_unit_expr = VSSTRESU,
constant_by_vars = get_admiral_option("subject_keys")
)


# Derive categorization variables ----
# See the "Derive Categorization Variables" vignette section for more
# information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#cat)

# Create analysis categories look-up (conditional look-up) table
avalcat_lookup <- exprs(
~PARAMCD, ~condition, ~AVALCAT1, ~AVALCA1N,
"BMI", AVAL < 18.5, "Underweight", 1,
"BMI", AVAL >= 18.5 & AVAL < 25, "Normal weight", 2,
"BMI", AVAL >= 25 & AVAL < 30, "Overweight", 3,
"BMI", AVAL >= 30 & AVAL < 35, "Obesity class I", 4,
"BMI", AVAL >= 35 & AVAL < 40, "Obesity class II", 5,
"BMI", AVAL >= 40, "Obesity class III", 6,
"BMI", is.na(AVAL), NA_character_, NA_integer_
)

# Derive BMI class (AVALCAT1, AVALCA1N)
advs <- advs %>%
derive_vars_cat(
definition = avalcat_lookup,
by_vars = exprs(PARAMCD)
)


# Derive Baseline variables ----
# See the "Derive Baseline" and "Derive Change from Baseline " vignette sections
# for more information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#baseline)
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#bchange)

# Add baseline flag (ABLFL)
advs <- advs %>%
restrict_derivation(
derivation = derive_var_extreme_flag,
args = params(
by_vars = exprs(!!!get_admiral_option("subject_keys"), PARAMCD),
order = exprs(ADT, ATPTN, AVISITN),
yurovska marked this conversation as resolved.
Show resolved Hide resolved
new_var = ABLFL,
mode = "last"
),
filter = (!is.na(AVAL) & ADT <= TRTSDT)
)

# Derive baseline analysis value (BASE)
advs <- advs %>%
derive_var_base(
by_vars = exprs(!!!get_admiral_option("subject_keys"), PARAMCD),
source_var = AVAL,
new_var = BASE
)

# Derive absolute (CHG) and relative (PCHG) change from baseline
advs <- advs %>%
restrict_derivation(
derivation = derive_var_chg,
filter = !(is.na(AVISIT) | toupper(AVISIT) %in% "BASELINE")
) %>%
restrict_derivation(
derivation = derive_var_pchg,
filter = !(is.na(AVISIT) | toupper(AVISIT) %in% "BASELINE")
)


# Derive criterion variables ----
# See the "Derive Criterion Variables" vignette section for more information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#crit_vars)

# Set weight loss criterion flags (CRIT1, CRIT1FL)
advs <- advs %>%
restrict_derivation(
derivation = derive_vars_crit_flag,
args = params(
condition = PCHG <= -5 & PARAMCD == "WEIGHT",
description = "Achievement of ≥ 5% weight reduction from baseline",
crit_nr = 1,
values_yn = TRUE,
create_numeric_flag = FALSE
),
filter = AVISITN > 0 & PARAMCD == "WEIGHT"
) %>%
restrict_derivation(
derivation = derive_vars_crit_flag,
args = params(
condition = PCHG <= -10 & PARAMCD == "WEIGHT",
description = "Achievement of ≥ 10% weight reduction from baseline",
crit_nr = 2,
values_yn = TRUE,
create_numeric_flag = FALSE
),
filter = AVISITN > 0 & PARAMCD == "WEIGHT"
)


# Assign parameter variables ----
# See the "Assign PARAMCD, PARAM, PARAMN, PARCAT1" vignette section for more
# information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#paramcd)

# Add all parameter variables (PARAM, PARAMN, PARCAT1, PARCAT1N)
advs <- advs %>%
derive_vars_merged_lookup(
dataset_add = param_lookup,
new_vars = exprs(PARAMCD, PARAM, PARAMN, PARCAT1, PARCAT1N),
AndersAskeland marked this conversation as resolved.
Show resolved Hide resolved
by_vars = exprs(PARAMCD)
)


# Add ADSL variables ----
# See the "Add ADSL variables" vignette section for more information:
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#adsl_vars)

# Add all ADSL variables besides TRTSDT, TRTEDT, TRT01P, TRT01A (stored in
# `adsl_vars`)
advs <- advs %>%
derive_vars_merged(
dataset_add = select(adsl, !!!negate_vars(adsl_vars)),
by_vars = get_admiral_option("subject_keys")
)


# Add Labels and Attributes ----
# This process is usually based on one's metadata. As such, no specific example
# will be given. See the "Add Labels and Attributes" vignette section for
# description of several open source R packages which can be used to handle
# metadata.
# (https://pharmaverse.github.io/admiral/articles/bds_finding.html#attributes)


# Save output ----

# Change to whichever directory you want to save the dataset in
dir <- tools::R_user_dir("admiral_templates_data", which = "cache") # Cache
if (!file.exists(dir)) {
# Create the folder
dir.create(dir, recursive = TRUE, showWarnings = FALSE)
}
save(advs, file = file.path(dir, "advs.rda"), compress = "bzip2")
Loading