-
Notifications
You must be signed in to change notification settings - Fork 2
Expand file tree
/
Copy pathad_adtpet.R
More file actions
225 lines (198 loc) · 8.16 KB
/
ad_adtpet.R
File metadata and controls
225 lines (198 loc) · 8.16 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
# Name: ADTPET
#
# Label: Tau PET Scan Analysis Dataset
#
# Input: adsl, nv, ag, suppnv
library(admiral)
library(admiralneuro)
library(pharmaversesdtm) # Contains example datasets from the CDISC pilot project
library(dplyr)
library(lubridate)
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))
# Load source datasets ----
# Use e.g. `haven::read_sas()` to read in .sas7bdat, or other suitable functions
# as needed and assign to the variables below.
# For illustration purposes read in pharmaversesdtm and admiralneuro test data
nv <- pharmaversesdtm::nv_neuro
ag <- pharmaversesdtm::ag_neuro
suppnv <- pharmaversesdtm::suppnv_neuro
adsl <- admiralneuro::adsl_neuro
# When SAS datasets are imported into R using haven::read_sas(), missing
# character values from SAS appear as "" characters in R, instead of appearing
# as NA values. Further details can be obtained via the following link:
# https://pharmaverse.github.io/admiral/articles/admiral.html#handling-of-missing-values # nolint
nv <- convert_blanks_to_na(nv)
ag <- convert_blanks_to_na(ag)
suppnv <- convert_blanks_to_na(suppnv)
adsl <- convert_blanks_to_na(adsl)
# Combine the parental datasets with their respective supp datasets (only if exist)
# User can use `combine_supp()` from {metatools} to combine the parental with supp dataset.
nv <- metatools::combine_supp(nv, suppnv)
# Lookup tables ----
# Assign PARAMCD, PARAM, and PARAMN
param_lookup <- tibble::tribble(
~NVTESTCD, ~NVCAT, ~NVLOC, ~REFREG, ~NVMETHOD, ~PARAMCD, ~PARAM, ~PARAMN,
"SUVR", "FBP", "NEOCORTICAL COMPOSITE", "Whole Cerebellum", "AVID FBP SUVR PIPELINE", "SUVRAFBP", "AVID FBP Standard Uptake Ratio Neocortical Composite Whole Cerebellum", 1,
"SUVR", "FBB", "NEOCORTICAL COMPOSITE", "Whole Cerebellum", "AVID FBB SUVR PIPELINE", "SUVRAFBB", "AVID FBB Standard Uptake Ratio Neocortical Composite Whole Cerebellum", 2,
"SUVR", "FBP", "NEOCORTICAL COMPOSITE", "Whole Cerebellum", "BERKELEY FBP SUVR PIPELINE", "SUVRBFBP", "BERKELEY FBP Standard Uptake Ratio Neocortical Composite Whole Cerebellum", 3,
"SUVR", "FBB", "NEOCORTICAL COMPOSITE", "Whole Cerebellum", "BERKELEY FBB SUVR PIPELINE", "SUVRBFBB", "BERKELEY FBB Standard Uptake Ratio Neocortical Composite Whole Cerebellum", 4,
"SUVR", "FTP", "NEOCORTICAL COMPOSITE", "Inferior Cerebellar Gray Matter", "AVID FTP SUVR PIPELINE", "SUVRAFTP", "AVID FTP Standard Uptake Ratio Neocortical Composite Inferior Cerebellar Gray Matter", 5,
"SUVR", "FTP", "NEOCORTICAL COMPOSITE", "Inferior Cerebellar Gray Matter", "BERKELEY FTP SUVR PIPELINE", "SUVRBFTP", "BERKELEY FTP Standard Uptake Ratio Neocortical Composite Inferior Cerebellar Gray Matter", 6,
"VR", "FBP", NA, NA, "FBP VISUAL CLASSIFICATION", "VRFBP", "FBP Qualitative Visual Classification", 7,
"VR", "FBB", NA, NA, "FBB VISUAL CLASSIFICATION", "VRFBB", "FBB Qualitative Visual Classification", 8,
"VR", "FTP", NA, NA, "FTP VISUAL CLASSIFICATION", "VRFTP", "FTP Qualitative Visual Classification", 9
)
attr(param_lookup$NVTESTCD, "label") <- "NV Test Short Name"
# Derivations ----
# Get list of ADSL vars required for derivations
adsl_vars <- exprs(TRTSDT, TRTEDT, TRT01A, TRT01P)
adtpet <- nv %>%
## Join ADSL with NV (need TRTSDT for ADY derivation) ----
derive_vars_merged(
dataset_add = adsl,
new_vars = adsl_vars,
by_vars = get_admiral_option("subject_keys")
) %>%
## Join ADTPET with AG for tracer information ----
# Users can add more variables in the `new_vars` argument as needed.
derive_vars_merged(
dataset_add = ag,
new_vars = exprs(AGTRT, AGCAT),
by_vars = c(get_admiral_option("subject_keys"), exprs(VISIT, NVLNKID = AGLNKID))
) %>%
filter(AGCAT == "TAU TRACER") %>% # Filter nv dataset for tau records only
## Calculate ADT, ADY ----
derive_vars_dt(
new_vars_prefix = "A",
dtc = NVDTC
) %>%
derive_vars_dy(reference_date = TRTSDT, source_vars = exprs(ADT))
adtpet <- adtpet %>%
## Add PARAMCD and PARAM ----
derive_vars_merged_lookup(
dataset_add = param_lookup,
new_vars = exprs(PARAMCD, PARAM),
by_vars = exprs(NVTESTCD, NVCAT, NVLOC, REFREG, NVMETHOD)
) %>%
## Calculate AVAL and AVALC ----
# AVALC should only be mapped if it contains non-redundant information.
mutate(
AVAL = NVSTRESN,
AVALC = if_else(
is.na(NVSTRESN) | as.character(NVSTRESN) != NVSTRESC,
NVSTRESC,
NA
)
)
## Get visit info ----
# See also the "Visit and Period Variables" vignette
# (https://pharmaverse.github.io/admiral/articles/visits_periods.html#visits)
adtpet <- adtpet %>%
mutate(
AVISIT = case_when(
str_detect(VISIT, "SCREEN|UNSCHED|RETRIEVAL|AMBUL") ~ NA_character_,
!is.na(VISIT) ~ str_to_title(VISIT),
TRUE ~ NA_character_
),
AVISITN = as.numeric(case_when(
VISIT == "BASELINE" ~ "0",
str_detect(VISIT, "WEEK") ~ str_trim(str_replace(VISIT, "WEEK", "")),
TRUE ~ NA_character_
)),
BASETYPE = "LAST"
)
## Calculate ONTRTFL ----
adtpet <- adtpet %>%
derive_var_ontrtfl(
start_date = ADT,
ref_start_date = TRTSDT,
ref_end_date = TRTEDT,
filter_pre_timepoint = toupper(AVISIT) == "BASELINE" # Observations as not on-treatment
)
### Derive Baseline flags ----
### Calculate ABLFL ----
adtpet <- adtpet %>%
restrict_derivation(
derivation = derive_var_extreme_flag,
args = params(
new_var = ABLFL,
by_vars = c(get_admiral_option("subject_keys"), exprs(BASETYPE, PARAMCD)),
order = exprs(ADT, VISITNUM, NVSEQ),
mode = "last"
),
filter = ((!is.na(AVAL) | !is.na(AVALC)) & ADT <= TRTSDT & !is.na(BASETYPE))
)
## Derive visit flags ----
### ANL01FL: Flag last result within a visit and timepoint for baseline and on-treatment post-baseline records ----
adtpet <- adtpet %>%
restrict_derivation(
derivation = derive_var_extreme_flag,
args = params(
new_var = ANL01FL,
by_vars = c(get_admiral_option("subject_keys"), exprs(PARAMCD, AVISIT)),
order = exprs(ADT, AVAL),
mode = "last"
),
filter = !is.na(AVISITN) & (ONTRTFL == "Y" | ABLFL == "Y")
) %>%
### ANL02FL: Flag last result within a PARAMCD for baseline & on-treatment post-baseline records ----
restrict_derivation(
derivation = derive_var_extreme_flag,
args = params(
new_var = ANL02FL,
by_vars = c(get_admiral_option("subject_keys"), exprs(PARAMCD, ABLFL)),
order = exprs(ADT),
mode = "last"
),
filter = !is.na(AVISITN) & (ONTRTFL == "Y" | ABLFL == "Y")
)
## Derive baseline information ----
### Calculate BASE ----
adtpet <- adtpet %>%
derive_var_base(
by_vars = c(get_admiral_option("subject_keys"), exprs(PARAMCD, BASETYPE)),
source_var = AVAL,
new_var = BASE
) %>%
### Calculate BASEC ----
derive_var_base(
by_vars = c(get_admiral_option("subject_keys"), exprs(PARAMCD, BASETYPE)),
source_var = AVALC,
new_var = BASEC
) %>%
### Calculate CHG for post-baseline records ----
# The decision on how to populate pre-baseline and baseline values of CHG is left as a user choice
restrict_derivation(
derivation = derive_var_chg,
filter = AVISITN > 0
) %>%
### Calculate PCHG for post-baseline records ----
# The decision on how to populate pre-baseline and baseline values of PCHG is left to producer choice
restrict_derivation(
derivation = derive_var_pchg,
filter = AVISITN > 0
)
## Assign ASEQ ----
adtpet <- adtpet %>%
derive_var_obs_number(
new_var = ASEQ,
by_vars = get_admiral_option("subject_keys"),
order = exprs(PARAMCD, ADT, AVISITN, VISITNUM),
check_type = "error"
)
# Final Steps, Select final variables and Add labels ----
# This process will be based on your metadata, no example given for this reason
# ...
admiralneuro_adtpet <- adtpet
# Save output ----
# Change to whichever directory you want to save the dataset in
dir <- tools::R_user_dir("admiralneuro_templates_data", which = "cache")
if (!file.exists(dir)) {
# Create the folder
dir.create(dir, recursive = TRUE, showWarnings = FALSE)
}
save(admiralneuro_adtpet, file = file.path(dir, "adtpet.rda"), compress = "bzip2")