Skip to content

Commit 65c942d

Browse files
Lovemore-GakavaLovemore-Gakava
authored
Merge pull request #24 from phuse-org/7-datadependencies
initial proposal
2 parents 27eda97 + f1463fb commit 65c942d

3 files changed

Lines changed: 372 additions & 0 deletions

File tree

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
.Rproj.user
22
docs
3+
.Rhistory
34
adrgOS.Rcheck/
45
adrgOS*.tar.gz
56
adrgOS*.tgz

‎r/adsl.r‎

Lines changed: 329 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,329 @@
1+
# Note to Reviewer
2+
# To rerun the code below, please refer ADRG appendix.
3+
# After required package are installed.
4+
# The path variable needs to be defined by using example code below
5+
#
6+
# nolint start
7+
# path <- list(
8+
# sdtm = "path/to/esub/tabulations/sdtm", # Modify path to the sdtm location
9+
# adam = "path/to/esub/analysis/adam" # Modify path to the adam location
10+
# )
11+
# nolint end
12+
13+
###########################################################################
14+
#' developers : Steven Haesendonckx/Declan Hodges/Thomas Neitmann
15+
#' date: 09DEC2022
16+
#' modification History:
17+
#'
18+
###########################################################################
19+
20+
# Set up ------------------------------------------------------------------
21+
22+
library(haven)
23+
library(admiral)
24+
library(dplyr)
25+
library(tidyr)
26+
library(metacore)
27+
library(metatools)
28+
library(pilot3utils)
29+
library(xportr)
30+
library(janitor)
31+
32+
# read source -------------------------------------------------------------
33+
# When SAS datasets are imported into R using read_sas(), missing
34+
# character values from SAS appear as "" characters in R, instead of appearing
35+
# as NA values. Further details can be obtained via the following link:
36+
# https://pharmaverse.github.io/admiral/articles/admiral.html#handling-of-missing-values
37+
38+
dm <- convert_blanks_to_na(read_xpt(file.path(path$sdtm, "dm.xpt")))
39+
ds <- convert_blanks_to_na(read_xpt(file.path(path$sdtm, "ds.xpt")))
40+
ex <- convert_blanks_to_na(read_xpt(file.path(path$sdtm, "ex.xpt")))
41+
qs <- convert_blanks_to_na(read_xpt(file.path(path$sdtm, "qs.xpt")))
42+
sv <- convert_blanks_to_na(read_xpt(file.path(path$sdtm, "sv.xpt")))
43+
vs <- convert_blanks_to_na(read_xpt(file.path(path$sdtm, "vs.xpt")))
44+
sc <- convert_blanks_to_na(read_xpt(file.path(path$sdtm, "sc.xpt")))
45+
mh <- convert_blanks_to_na(read_xpt(file.path(path$sdtm, "mh.xpt")))
46+
47+
## placeholder for origin=predecessor, use metatool::build_from_derived()
48+
metacore <- spec_to_metacore(file.path(path$adam, "adam-pilot-3.xlsx"), where_sep_sheet = FALSE)
49+
# Get the specifications for the dataset we are currently building
50+
adsl_spec <- metacore %>%
51+
select_dataset("ADSL")
52+
53+
ds00 <- ds %>%
54+
filter(DSCAT == "DISPOSITION EVENT", DSDECOD != "SCREEN FAILURE") %>%
55+
derive_vars_dt(
56+
dtc = DSSTDTC,
57+
new_vars_prefix = "EOS",
58+
highest_imputation = "n",
59+
) %>%
60+
mutate(
61+
DISCONFL = ifelse(!is.na(EOSDT) & DSDECOD != "COMPLETED", "Y", NA),
62+
DSRAEFL = ifelse(DSTERM == "ADVERSE EVENT", "Y", NA),
63+
DCDECOD = DSDECOD
64+
) %>%
65+
select(STUDYID, USUBJID, EOSDT, DISCONFL, DSRAEFL, DSDECOD, DSTERM, DCDECOD)
66+
67+
# Treatment information ---------------------------------------------------
68+
69+
ex_dt <- ex %>%
70+
derive_vars_dt(
71+
dtc = EXSTDTC,
72+
new_vars_prefix = "EXST",
73+
highest_imputation = "n",
74+
) %>%
75+
# treatment end is imputed by discontinuation if subject discontinued after visit 3 = randomization as per protocol
76+
derive_vars_merged(
77+
dataset_add = ds00,
78+
by_vars = exprs(STUDYID, USUBJID),
79+
new_vars = exprs(EOSDT = EOSDT),
80+
filter_add = DCDECOD != "COMPLETED"
81+
) %>%
82+
derive_vars_dt(
83+
dtc = EXENDTC,
84+
new_vars_prefix = "EXEN",
85+
highest_imputation = "Y",
86+
max_dates = exprs(EOSDT),
87+
date_imputation = "last",
88+
flag_imputation = "none"
89+
) %>%
90+
mutate(DOSE = EXDOSE * (EXENDT - EXSTDT + 1))
91+
92+
ex_dose <- ex_dt %>%
93+
group_by(STUDYID, USUBJID, EXTRT) %>%
94+
summarise(cnt = n_distinct(EXTRT), CUMDOSE = sum(DOSE))
95+
96+
ex_dose[which(ex_dose[["cnt"]] > 1), "USUBJID"] # are there subjects with mixed treatments?
97+
98+
adsl00 <- dm %>%
99+
select(-DOMAIN) %>%
100+
filter(ACTARMCD != "Scrnfail") %>%
101+
# planned treatment
102+
mutate(
103+
TRT01P = ARM,
104+
TRT01PN = case_when(
105+
ARM == "Placebo" ~ 0,
106+
ARM == "Xanomeline High Dose" ~ 81,
107+
ARM == "Xanomeline Low Dose" ~ 54
108+
)
109+
) %>%
110+
# actual treatment - It is assumed TRT01A=TRT01P which is not really true.
111+
mutate(
112+
TRT01A = TRT01P,
113+
TRT01AN = TRT01PN
114+
) %>%
115+
# treatment start
116+
derive_vars_merged(
117+
dataset_add = ex_dt,
118+
filter_add = (EXDOSE > 0 |
119+
(EXDOSE == 0 &
120+
grepl("PLACEBO", EXTRT, fixed = TRUE))) &
121+
!is.na(EXSTDT),
122+
new_vars = exprs(TRTSDT = EXSTDT),
123+
order = exprs(EXSTDT, EXSEQ),
124+
mode = "first",
125+
by_vars = exprs(STUDYID, USUBJID)
126+
) %>%
127+
# treatment end
128+
derive_vars_merged(
129+
dataset_add = ex_dt,
130+
filter_add = (EXDOSE > 0 |
131+
(EXDOSE == 0 &
132+
grepl("PLACEBO", EXTRT, fixed = TRUE))) &
133+
!is.na(EXENDT),
134+
new_vars = exprs(TRTEDT = EXENDT),
135+
order = exprs(EXENDT, EXSEQ),
136+
mode = "last",
137+
by_vars = exprs(STUDYID, USUBJID)
138+
) %>%
139+
# treatment duration
140+
derive_var_trtdurd() %>%
141+
# dosing
142+
left_join(ex_dose, by = c("STUDYID", "USUBJID")) %>%
143+
select(-cnt) %>%
144+
mutate(AVGDD = round_half_up(as.numeric(CUMDOSE) / TRTDURD, digits = 1))
145+
146+
# Demographic grouping ----------------------------------------------------
147+
adsl01 <- adsl00 %>%
148+
create_cat_var(adsl_spec, AGE, AGEGR1, AGEGR1N) %>%
149+
create_var_from_codelist(adsl_spec, RACE, RACEN) %>%
150+
mutate(
151+
SITEGR1 = format_sitegr1(SITEID)
152+
)
153+
154+
# Population flag ---------------------------------------------------------
155+
# SAFFL - Y if ITTFL='Y' and TRTSDT ne missing. N otherwise
156+
# ITTFL - Y if ARMCD ne ' '. N otherwise
157+
# EFFFL - Y if SAFFL='Y AND at least one record in QS for ADAS-Cog and for CIBIC+ with VISITNUM>3, N otherwise
158+
# these variables are also in suppdm, but define said derived
159+
160+
qstest <- distinct(qs[, c("QSTESTCD", "QSTEST")])
161+
162+
eff <- qs %>%
163+
filter(VISITNUM > 3, QSTESTCD %in% c("CIBIC", "ACTOT")) %>%
164+
group_by(STUDYID, USUBJID) %>%
165+
summarise(effcnt = n_distinct(QSTESTCD))
166+
167+
adsl02 <- adsl01 %>%
168+
left_join(eff, by = c("STUDYID", "USUBJID")) %>%
169+
mutate(
170+
SAFFL = case_when(
171+
ARMCD != "Scrnfail" & ARMCD != "" & !is.na(TRTSDT) ~ "Y",
172+
ARMCD == "Scrnfail" ~ NA_character_,
173+
TRUE ~ "N"
174+
),
175+
ITTFL = case_when(
176+
ARMCD != "Scrnfail" & ARMCD != "" ~ "Y",
177+
ARMCD == "Scrnfail" ~ NA_character_,
178+
TRUE ~ "N"
179+
),
180+
EFFFL = case_when(
181+
ARMCD != "Scrnfail" & ARMCD != "" & !is.na(TRTSDT) & effcnt == 2 ~ "Y",
182+
ARMCD == "Scrnfail" ~ NA_character_,
183+
TRUE ~ "N"
184+
)
185+
)
186+
187+
# Study Visit compliance --------------------------------------------------
188+
# these variables are also in suppdm, but define said derived
189+
190+
sv00 <- sv %>%
191+
select(STUDYID, USUBJID, VISIT, VISITDY, SVSTDTC) %>%
192+
mutate(
193+
FLG = "Y",
194+
VISITCMP = case_when(
195+
VISIT == "WEEK 8" ~ "COMP8FL",
196+
VISIT == "WEEK 16" ~ "COMP16FL",
197+
VISIT == "WEEK 24" ~ "COMP24FL",
198+
TRUE ~ "ZZZ" # ensures every subject with one visit will get a row with minimally 'N'
199+
)
200+
) %>%
201+
arrange(STUDYID, USUBJID, VISITDY) %>%
202+
distinct(STUDYID, USUBJID, VISITCMP, FLG) %>%
203+
pivot_wider(names_from = VISITCMP, values_from = FLG, values_fill = "N") %>%
204+
select(-ZZZ)
205+
206+
adsl03 <- adsl02 %>%
207+
left_join(sv00, by = c("STUDYID", "USUBJID"))
208+
209+
# Disposition -------------------------------------------------------------
210+
211+
adsl04 <- adsl03 %>%
212+
left_join(ds00, by = c("STUDYID", "USUBJID")) %>%
213+
select(-DSDECOD) %>%
214+
derive_var_merged_cat(
215+
dataset_add = ds00,
216+
by_vars = exprs(STUDYID, USUBJID),
217+
new_var = EOSSTT,
218+
source_var = DSDECOD,
219+
cat_fun = format_eosstt,
220+
filter_add = !is.na(USUBJID),
221+
) %>%
222+
derive_var_merged_cat(
223+
dataset_add = ds00,
224+
by_vars = exprs(STUDYID, USUBJID),
225+
new_var = DCSREAS,
226+
source_var = DSDECOD,
227+
cat_fun = format_dcsreas, # could not include dsterm in formatting logic
228+
filter_add = !is.na(USUBJID),
229+
) %>%
230+
mutate(DCSREAS = ifelse(DSTERM == "PROTOCOL ENTRY CRITERIA NOT MET", "I/E Not Met", DCSREAS))
231+
232+
# Baseline variables ------------------------------------------------------
233+
# selection definition from define
234+
235+
vs00 <- vs %>%
236+
filter((VSTESTCD == "HEIGHT" & VISITNUM == 1) | (VSTESTCD == "WEIGHT" & VISITNUM == 3)) %>%
237+
mutate(AVAL = round_half_up(VSSTRESN, digits = 1)) %>%
238+
select(STUDYID, USUBJID, VSTESTCD, AVAL) %>%
239+
pivot_wider(names_from = VSTESTCD, values_from = AVAL, names_glue = "{VSTESTCD}BL") %>%
240+
mutate(
241+
BMIBL = round_half_up(WEIGHTBL / (HEIGHTBL / 100)^2, digits = 1)
242+
) %>%
243+
create_cat_var(adsl_spec, BMIBL, BMIBLGR1)
244+
245+
sc00 <- sc %>%
246+
filter(SCTESTCD == "EDLEVEL") %>%
247+
select(STUDYID, USUBJID, SCTESTCD, SCSTRESN) %>%
248+
pivot_wider(names_from = SCTESTCD, values_from = SCSTRESN, names_glue = "EDUCLVL")
249+
250+
adsl05 <- adsl04 %>%
251+
left_join(vs00, by = c("STUDYID", "USUBJID")) %>%
252+
left_join(sc00, by = c("STUDYID", "USUBJID"))
253+
254+
# Disease information -----------------------------------------------------
255+
256+
visit1dt <- sv %>%
257+
filter(VISITNUM == 1) %>%
258+
derive_vars_dt(
259+
dtc = SVSTDTC,
260+
new_vars_prefix = "VISIT1",
261+
) %>%
262+
select(STUDYID, USUBJID, VISIT1DT)
263+
264+
visnumen <- sv %>%
265+
filter(VISITNUM < 100) %>%
266+
arrange(STUDYID, USUBJID, SVSTDTC) %>%
267+
group_by(STUDYID, USUBJID) %>%
268+
slice(n()) %>%
269+
ungroup() %>%
270+
mutate(VISNUMEN = ifelse(round_half_up(VISITNUM, digits = 0) == 13, 12, round_half_up(VISITNUM, digits = 0))) %>%
271+
select(STUDYID, USUBJID, VISNUMEN)
272+
273+
disonsdt <- mh %>%
274+
filter(MHCAT == "PRIMARY DIAGNOSIS") %>%
275+
derive_vars_dt(
276+
dtc = MHSTDTC,
277+
new_vars_prefix = "DISONS",
278+
) %>%
279+
select(STUDYID, USUBJID, DISONSDT)
280+
281+
adsl06 <- adsl05 %>%
282+
left_join(visit1dt, by = c("STUDYID", "USUBJID")) %>%
283+
left_join(visnumen, by = c("STUDYID", "USUBJID")) %>%
284+
left_join(disonsdt, by = c("STUDYID", "USUBJID")) %>%
285+
derive_vars_duration(
286+
new_var = DURDIS,
287+
start_date = DISONSDT,
288+
end_date = VISIT1DT,
289+
out_unit = "days",
290+
add_one = TRUE
291+
) %>%
292+
# derive_vars_duration(..., out_unit = "months") is not used here because
293+
# it calculates months based on date internals, while the original CDISC
294+
# adsl.DURDIS was derived assuming each month has the same number of days,
295+
# i.e., 365.25/12=30.4375.
296+
# Feature requested: https://github.com/pharmaverse/admiral/issues/1875
297+
# Workaround: derive days first and then convert it to months
298+
mutate(
299+
DURDIS = round_half_up(DURDIS / (365.25 / 12), digits = 1)
300+
) %>%
301+
create_cat_var(adsl_spec, DURDIS, DURDSGR1) %>%
302+
derive_vars_dt(
303+
dtc = RFENDTC,
304+
new_vars_prefix = "RFEN",
305+
)
306+
307+
mmsetot <- qs %>%
308+
filter(QSCAT == "MINI-MENTAL STATE") %>%
309+
group_by(STUDYID, USUBJID) %>%
310+
summarise(MMSETOT = sum(as.numeric(QSORRES), na.rm = TRUE)) %>%
311+
select(STUDYID, USUBJID, MMSETOT)
312+
313+
adsl07 <- adsl06 %>%
314+
left_join(mmsetot, by = c("STUDYID", "USUBJID"))
315+
316+
# Export to xpt -----------------------------------------------------
317+
adsl07 %>%
318+
drop_unspec_vars(adsl_spec) %>% # Check all variables specified are present and no more
319+
check_ct_data(adsl_spec, na_acceptable = TRUE) %>% # Checks all variables with CT only contain values within the CT
320+
order_cols(adsl_spec) %>% # Orders the columns according to the spec
321+
sort_by_key(adsl_spec) %>% # Sorts the rows by the sort keys
322+
xportr_length(adsl_spec) %>% # Assigns SAS length from a variable level metadata
323+
xportr_label(adsl_spec) %>% # Assigns variable label from metacore specifications
324+
xportr_df_label(adsl_spec) %>% # Assigns dataset label from metacore specifications
325+
xportr_format(adsl_spec$var_spec %>%
326+
mutate_at(c("format"), ~ replace_na(., "")), "ADSL") %>%
327+
xportr_write(file.path(path$adam, "adsl.xpt"),
328+
label = "Subject-Level Analysis Dataset"
329+
)

‎r/getdependency.r‎

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
2+
3+
dir_to_programs <- file.path(getwd(), "r")
4+
5+
# Scrape scripts ----------------------------------------------------------
6+
7+
scrapemea <- list.files(dir_to_programs, pattern = "\\.r$", full.names = TRUE)
8+
scrapemeb <- list.files(dir_to_programs, pattern = "^ad", full.names = TRUE)
9+
10+
scrapeme <- intersect(scrapemea, scrapemeb)
11+
12+
scrape_inputfiles <- function(script=scrapeme){
13+
14+
# do some checks on input
15+
16+
17+
# read file to extract lines where input is read into the script, ignoring comments
18+
tmp <- data.frame(lines = trimws(suppressWarnings(readLines(script)), which=("both")), stringsAsFactors = F)
19+
tmp <- data.frame(lines = tmp$lines[which(!grepl("#", tmp$lines) & !grepl("write", tmp$lines))], stringsAsFactors = F)
20+
lines <- tolower(tmp$lines)
21+
22+
# extract file types to detect
23+
filetypes <- c("rds", "xpt", "sas7bdat", "json")
24+
25+
26+
# Extract input files for each type and simplify the regex operation
27+
inputfiles <- list()
28+
29+
for (type in filetypes) {
30+
pattern <- paste0("\\b\\S+\\.", type, "\\b")
31+
inputfiles[[type]] <- unlist(regmatches(lines, gregexpr(pattern, lines)))
32+
}
33+
34+
# Include excel files specifically for .xls and .xlsx
35+
inputfiles$excel <- unlist(regmatches(lines, gregexpr("\\b\\S+\\.xls[x]?\\b", lines)))
36+
37+
return(inputfiles)
38+
}
39+
40+
infiles <- sapply(scrapeme, FUN = scrape_inputfiles, simplify = F, USE.NAMES = F)
41+
names(infiles) <- sapply(scrapeme, basename)
42+
print(infiles)

0 commit comments

Comments
 (0)