Skip to content

Commit

Permalink
#51 reformatted qs_ophtha code so that it doesn't depend on exisitng …
Browse files Browse the repository at this point in the history
…qs dataset. also improved test data
  • Loading branch information
manciniedoardo committed Aug 14, 2023
1 parent 2f6bc1b commit 8c619c1
Show file tree
Hide file tree
Showing 2 changed files with 24 additions and 46 deletions.
70 changes: 24 additions & 46 deletions data-raw/qs_ophtha.R
Original file line number Diff line number Diff line change
@@ -1,31 +1,31 @@
# Dataset: qs
# Description: Create QS test SDTM dataset with VFQ records for ophthalmology studies
# Dataset: qs_ophtha
# Description: NEI Visual Functioning Questionnaire 25 (VFQ) test SDTM data
# for ophthalmology studies, based on QS dataset from CDISC pilot study

# Load libraries -----
library(dplyr)
library(stringr)
library(metatools)
library(haven)
library(admiral)
library(dplyr)
library(stringr)

# Make qs_ophtha dataset ----

# Create qs_ophtha ----
## Get qs from CDISC pilot study ----
sdtm_path <- "https://github.com/cdisc-org/sdtm-adam-pilot-project/blob/master/updated-pilot-submission-package/900172/m5/datasets/cdiscpilot01/tabulations/sdtm/" # nolint
raw_qs <- read_xpt(paste0(sdtm_path, "qs", ".xpt?raw=true")) %>%
convert_blanks_to_na()
# Get CDISC qs dataset so that we have the right structure ----
raw_qs <- read_xpt("https://github.com/cdisc-org/sdtm-adam-pilot-project/blob/master/updated-pilot-submission-package/900172/m5/datasets/cdiscpilot01/tabulations/sdtm/qs.xpt?raw=true") # nolint
qs <- convert_blanks_to_na(raw_qs)

## set seed to get same results each run ----
## set seed to get same results each run
set.seed(999)

## add VFQ data ----
qs1 <- raw_qs %>%
## create new QS data - keep standard variables from QS ----
qs1 <- qs %>%
# select standard variables
select(STUDYID, DOMAIN, USUBJID, QSBLFL, VISITNUM, VISIT, VISITDY, QSDTC, QSDY) %>%
# keep unique subjects and visits per subject
group_by(USUBJID, VISITDY) %>%
unique()

#### create dummy parameters and results ----
## create dummy parameters and results ----
dummy_param <- data.frame(QSTEST = c(
"Your Overall Health Is",
"Eyesight Using Both Eyes Is",
Expand Down Expand Up @@ -63,7 +63,7 @@ dummy_param <- data.frame(QSTEST = c(
QSSCAT = "Original Response"
)

### dummy answers ----
## dummy answers ----

# difficulty in performing tasks
difficulty_res <- c(
Expand Down Expand Up @@ -92,15 +92,15 @@ yesno <- setNames(yn_res, yn_resn)
answers <- c(difficulty_res, freq_res, qual_res, yn_res)
answersn <- c(difficulty_resn, freq_resn, qual_resn, yn_resn)

### assign answers to questions randomly for each subjects ----
## assign answers to questions randomly for each subjects ----

# take unique subjects
subjects <- qs1 %>%
# take unique subject/visit combinations
subjects_visits <- qs1 %>%
ungroup() %>%
select(USUBJID) %>%
select(USUBJID, VISIT) %>%
distinct()

dummy_param_res_by_subj <- merge(subjects, dummy_param) %>%
dummy_param_res_by_subj_visit <- merge(subjects_visits, dummy_param) %>%
mutate(QSORRES = case_when(
str_detect(QSTEST, "Difficult") ~ sample(difficulty, size = nrow(.), replace = T),
str_detect(QSTEST, "How") ~ sample(frequency, size = nrow(.), replace = T),
Expand All @@ -116,14 +116,14 @@ dummy_param_res_by_subj <- merge(subjects, dummy_param) %>%
QSDRVFL = ""
)

### Merge standard QS with parameters and result variables from ophtha QS data ----

qs2 <- merge(qs1, dummy_param_res_by_subj, by = "USUBJID") %>%
## merge standard QS with parameters and result variables from temp QS data ----
qs2 <- merge(qs1, dummy_param_res_by_subj_visit, by = c("USUBJID", "VISIT")) %>%
group_by(USUBJID) %>%
# create QSSEQ based on VFQ QS parameters
mutate(QSSEQ = row_number()) %>%
arrange(USUBJID, QSSEQ)

## create QSSTRESN ----
qs3 <- qs2 %>%
group_by(QSTEST) %>%
# create numeric var for std result
Expand All @@ -134,29 +134,7 @@ qs3 <- qs2 %>%
) %>%
ungroup()

## Keep only VFQ records ----
qs_novfq <- raw_qs %>% filter(QSCAT != "NEI VFQ-25")

qs_ophtha1 <- rbind(qs_novfq, qs3)

## xxSEQ and keep relevant variables ----
qs_ophtha2 <- qs_ophtha1 %>%
select(-QSSEQ) %>%
arrange(STUDYID, USUBJID, QSCAT, QSTESTCD, QSDTC, VISITNUM)

qs_ophtha3 <- qs_ophtha2 %>%
group_by(STUDYID, USUBJID) %>%
mutate(QSSEQ = row_number()) %>%
select(
STUDYID, DOMAIN, USUBJID, QSSEQ, QSTESTCD, QSTEST, QSCAT, QSSCAT, QSORRES, QSORRESU, QSSTRESC, QSSTRESN, QSSTRESU,
QSBLFL, QSDRVFL, VISITNUM, VISIT, VISITDY, QSDTC, QSDY
) %>%
ungroup()

qs_ophtha <- qs_ophtha3

# Assign dataset label ----
attr(qs_ophtha, "label") <- "Questionnaires"
qs_ophtha <- qs3

# Save dataset ----
usethis::use_data(qs_ophtha, overwrite = TRUE)
Binary file modified data/qs_ophtha.rda
Binary file not shown.

0 comments on commit 8c619c1

Please sign in to comment.