search

insightsengineering / teal

Exploratory Web Apps for Analyzing Clinical Trial Data
https://insightsengineering.github.io/teal/
Other
181 stars 39 forks source link

"is_character_single(dataname) is not TRUE" output to console in the efficacy app and DDL app #218

Closed kpagacz closed 3 years ago

kpagacz commented 3 years ago

When selecting most of the tmc tabs, I get this: image

Efficacy sample app:

library(scda)
library(teal.modules.general)
library(teal.modules.clinical)

## Log app usage
log_app_usage(ta = "Oncology", molecule = "Tecentriq", ind = "NSCLC", anl_type = "Exploratory")

# code>
## Generate Data
ADSL <- synthetic_cdisc_data("latest")$adsl
adsl_labels <- rtables::var_labels(ADSL)

char_vars_asl <- names(Filter(isTRUE, sapply(ADSL, is.character)))

adsl_labels <- c(adsl_labels,
                 AGEGR1 = "Age Group")
ADSL <- ADSL %>% mutate(
  AGEGR1 = factor(case_when(
    AGE < 45 ~ "<45",
    AGE >= 45 ~ ">=45"
  ))
) %>%
  mutate_at(char_vars_asl, factor)

var_labels(ADSL) <- adsl_labels

ADTTE <- synthetic_cdisc_data("latest")$adtte

ADRS <- synthetic_cdisc_data("latest")$adrs
adrs_labels <- rtables::var_labels(ADRS)
ADRS <- filter(ADRS, PARAMCD == "BESRSPI" | AVISIT == "FOLLOW UP")
var_labels(ADRS) <- adrs_labels

ADQS <- synthetic_cdisc_data("latest")$adqs
adqs_labels <- rtables::var_labels(ADQS)
ADQS <- ADQS %>%
  filter(ABLFL != "Y" & ABLFL2 != "Y") %>%
  filter(AVISIT %in% c("WEEK 1 DAY 8", "WEEK 2 DAY 15", "WEEK 3 DAY 22")) %>%
  mutate(
    AVISIT = as.factor(AVISIT),
    AVISITN = rank(AVISITN) %>%
      as.factor() %>%
      as.numeric() %>%
      as.factor() 
  )
var_labels(ADQS) <- adqs_labels

# <code

## Reusable Configuration For Modules
arm_vars <- c("ARMCD", "ARM")
strata_vars <- c("STRATA1", "STRATA2")
facet_vars <- c("AGEGR1", "BMRKR2", "SEX", "COUNTRY")
cov_vars <- c("AGE", "SEX", "BMRKR1", "BMRKR2", "REGION1")
visit_vars <- c("AVISIT", "AVISITN")

cs_arm_var <- choices_selected(
  choices = variable_choices(ADSL, subset = arm_vars),
  selected = "ARM"
)

cs_strata_var <- choices_selected(
  choices = variable_choices(ADSL, subset = strata_vars),
  selected = "STRATA1"
)

cs_facet_var <- choices_selected(
  choices = variable_choices(ADSL, subset = facet_vars),
  selected = "AGEGR1"
)

cs_cov_var <- choices_selected(
  choices = variable_choices(ADSL, subset = cov_vars),
  selected = "AGE"
)

cs_paramcd_tte <- choices_selected(
  choices = value_choices(ADTTE, "PARAMCD", "PARAM"),
  selected = "OS"
)

cs_paramcd_rsp <- choices_selected(
  choices = value_choices(ADRS, "PARAMCD", "PARAM"),
  selected = "BESRSPI"
)

cs_paramcd_qs <- choices_selected(
  choices = value_choices(ADQS, "PARAMCD", "PARAM"),
  selected = "FKSI-FWB"
)

cs_visit_var_qs <- choices_selected(
  choices = variable_choices(ADQS, subset = visit_vars),
  selected = "AVISIT"
)

cs_formula_mmrm <- choices_selected(
  choices = c('BASE + AVISITN + ARMCD + ARMCD*AVISITN + SEX',
              'BASE + AVISIT + ARMCD + ARMCD*AVISIT + SEX',
              'BASE + AVISIT + ARM + ARM*AVISIT + SEX'),
  selected = 'BASE + AVISIT + ARM + ARM*AVISIT + SEX')

fact_vars_asl <- names(Filter(isTRUE, sapply(ADSL, is.factor)))
fact_vars_asl_orig <- fact_vars_asl[!fact_vars_asl %in% char_vars_asl]

date_vars_asl <- names(ADSL)[vapply(ADSL, function(x) inherits(x, c("Date", "POSIXct", "POSIXlt")), logical(1))]
demog_vars_asl <- names(ADSL)[!(names(ADSL) %in% c("USUBJID", "STUDYID", date_vars_asl))]

# reference & comparison arm selection when switching the arm variable
# ARMCD is given in a delayed fashion using value choices and
# ARM is given with the ref and comp levels supplied explicitly
arm_ref_comp <- list(
  ARMCD = list(ref = value_choices("ADSL", var_choices = "ARMCD", var_label = "ARM", subset = "ARM A"), 
               comp = value_choices("ADSL", var_choices = "ARMCD", var_label = "ARM", subset = c("ARM B", "ARM C"))),
  ARM = list(ref = "A: Drug X", comp = c("B: Placebo", "C: Combination"))
)

## Setup App
app <- init(
  data = cdisc_data(
    cdisc_dataset("ADSL", ADSL, code = 'ADSL <- synthetic_cdisc_data("latest")$adsl
                                        adsl_labels <- rtables::var_labels(ADSL)
                                        adsl_labels <- c(adsl_labels,
                                          AGEGR1 = "Age Group"
                                        )
                                        ADSL <- ADSL %>% mutate(
                                          AGEGR1 = factor(case_when(
                                            AGE < 45 ~ "<45",
                                            AGE >= 45 ~ ">=45"
                                          ))
                                        ) %>%
                                        mutate_at(char_vars_asl, factor)
                                        var_labels(ADSL) <- adsl_labels',
                                        vars = list(char_vars_asl = char_vars_asl)),
    cdisc_dataset("ADRS", ADRS, code = 'ADRS <- synthetic_cdisc_data("latest")$adrs
                                        adrs_labels <- rtables::var_labels(ADRS)
                                        ADRS <- filter(ADRS, PARAMCD == "BESRSPI" | AVISIT == "FOLLOW UP")
                                        var_labels(ADRS) <- adrs_labels'),
    cdisc_dataset("ADTTE", ADTTE, code = "ADTTE <- synthetic_cdisc_data(\"latest\")$adtte"),
    cdisc_dataset("ADQS", ADQS, code = 'ADQS <- synthetic_cdisc_data("latest")$adqs
                                        adqs_labels <- rtables::var_labels(ADQS)
                                        ADQS <- ADQS %>%
                                          filter(ABLFL != "Y" & ABLFL2 != "Y") %>%
                                          filter(AVISIT %in% c("WEEK 1 DAY 8", "WEEK 2 DAY 15", "WEEK 3 DAY 22")) %>%
                                          mutate(
                                            AVISIT = as.factor(AVISIT),
                                            AVISITN = rank(AVISITN) %>%
                                              as.factor() %>%
                                              as.numeric() %>%
                                              as.factor()
                                          )
                                        var_labels(ADQS) <- adqs_labels')
  ),
  modules = root_modules(
    module(
      label = "Study Information",
      server = function(input, output, session, datasets) {},
      ui = function(id, ...) {
        tagList(
          tags$p("Info about data source:"),
          tags$p(
            "Random data are used that has been created with the ",
            tags$code("random.cdisc.data"), "R package."
          )
        )
      },
      filters = "all"
    ),
    tm_data_table("Data Table"),
    tm_variable_browser("Variable Browser"),
    tm_t_summary(
      label = "Demographic Table",
      dataname = "ADSL",
      arm_var = cs_arm_var,
      summarize_vars = choices_selected(
        choices = variable_choices(ADSL, demog_vars_asl),
        selected = c("SEX", "AGE", "RACE")
      )
    ),
    modules(
      "Forest Plots",
      tm_g_forest_tte(
        label = "Survival Forest Plot",
        dataname = "ADTTE",
        arm_var = cs_arm_var,
        strata_var = cs_strata_var,
        subgroup_var = cs_facet_var,
        paramcd = cs_paramcd_tte,
        plot_height = c(800L, 200L, 4000L)
      ),
      tm_g_forest_rsp(
        label = "Response Forest Plot",
        dataname = "ADRS",
        arm_var = cs_arm_var,
        strata_var = cs_strata_var,
        subgroup_var = cs_facet_var,
        paramcd = cs_paramcd_rsp,
        plot_height = c(800L, 200L, 4000L)
      )
    ),
    tm_g_km(
      label = "Kaplan Meier Plot",
      dataname = "ADTTE",
      arm_var = cs_arm_var,
      arm_ref_comp = arm_ref_comp,
      paramcd = cs_paramcd_tte,
      facet_var = cs_facet_var,
      strata_var = cs_strata_var,
      plot_height = c(1800L, 200L, 4000L)
    ),
    tm_t_rsp(
      label = "Response Table",
      dataname = "ADRS",
      arm_var = cs_arm_var,
      arm_ref_comp = arm_ref_comp,
      paramcd = cs_paramcd_rsp,
      strata_var = cs_strata_var
    ),
    tm_t_tte(
      label = "Time To Event Table",
      dataname = "ADTTE",
      arm_var = cs_arm_var,
      paramcd = cs_paramcd_tte,
      strata_var = cs_strata_var,
      time_points = choices_selected(c(182, 365, 547), 182),
      event_desc_var = choices_selected(
        choices = variable_choices("ADTTE", "EVNTDESC"), 
        selected = "EVNTDESC", 
        fixed = TRUE
      )
    ),
    tm_t_crosstable(
      "Cross Table",
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(ADSL, fact_vars_asl_orig),
          selected = fact_vars_asl_orig[1]
        )
      ),
      y = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(ADSL, fact_vars_asl_orig),
          selected = fact_vars_asl_orig[4]
        )
      )
    ),
    tm_t_coxreg(
      label = "Cox Reg",
      dataname = "ADTTE",
      arm_var = cs_arm_var,
      arm_ref_comp = arm_ref_comp,
      paramcd = cs_paramcd_tte,
      strata_var = cs_strata_var,
      cov_var = cs_cov_var
    ),
    tm_t_logistic(
      label = "Logistic Reg",
      dataname = "ADRS",
      arm_var = cs_arm_var,
      arm_ref_comp = NULL,
      paramcd = cs_paramcd_rsp,
      cov_var = cs_cov_var
    ),
    tm_a_mmrm(
      label = "MMRM",
      dataname = "ADQS",
      aval_var = choices_selected(c("AVAL", "CHG"), "AVAL"),
      id_var = choices_selected(c("USUBJID", "SUBJID"), "USUBJID"),
      arm_var = cs_arm_var,
      visit_var = cs_visit_var_qs,
      arm_ref_comp = arm_ref_comp,
      paramcd = cs_paramcd_qs,
      cov_var = choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL),
      conf_level = choices_selected(c(0.95, 0.9, 0.8), 0.95)
    ),
    tm_t_binary_outcome(
      label = "Binary Response",
      dataname = "ADRS",
      arm_var = cs_arm_var,
      paramcd = cs_paramcd_rsp,
      strata_var = cs_strata_var
    ),
    tm_t_ancova(
      label = "ANCOVA",
      dataname = "ADQS",
      avisit = choices_selected(value_choices(ADQS, "AVISIT"), "WEEK 1 DAY 8"),
      arm_var = cs_arm_var,
      arm_ref_comp = arm_ref_comp,
      aval_var = choices_selected(variable_choices(ADQS, c("AVAL", "CHG", "PCHG")), "CHG"),
      cov_var = choices_selected(variable_choices(ADQS, c("BASE", "STRATA1", "SEX")),"STRATA1"),
      paramcd = cs_paramcd_qs
    )
  ),
  header = div(
    class = "",
    style = "margin-bottom: 2px;",
    tags$h1("Example App with teal.modules.clinical modules", tags$span("SPA", class = "pull-right"))
  ),
  footer = tags$p(class = "text-muted", "Source: agile-R website")
)

shinyApp(app$ui, app$server)

DDL app:

# Next two lines are for using NEST packages on BEE (r.roche.com)
#source("https://raw.github.roche.com/NEST/nest_on_bee/master/bee_nest_utils.R")
#bee_use_nest(release = "2021_07_07")
devtools::load_all("../utils.nest")
devtools::load_all(".")
devtools::load_all("../teal.devel")
devtools::load_all("../teal.modules.general")
devtools::load_all("../teal.modules.clinical")
devtools::load_all("../random.cdisc.data")

pth = "root/clinical_studies/ro_testing/nest_project/nest_test/data_analysis/rcd_2021_03/work/work_all/outdata_vad/"

#### Utility Functions #### 
get_fact_vars <- function(data){
  fact_vars <- names(Filter(isTRUE, sapply(data, is.factor)))
  return(fact_vars)
}

get_tte_params <- function(data){
  tte_params <- levels(data)
  return(tte_params)
}

#### Reusable Configuration For Modules ####
arm_vars <- c("ARMCD", "ARM", "ACTARM", "ACTARMCD")
strata_vars <- c("STRATA1", "STRATA2")
aeterm_vars <- c("AEBODSYS", "AESOC", "AEHLGT", "AEHLT", "AEDECOD", "AETERM", "AELLT")

cs_arm_var <- choices_selected(
  choices = variable_choices("ADSL", subset = arm_vars),
  selected = "ARM"
)

cs_strata_var <- choices_selected(
  choices = variable_choices("ADSL", subset = strata_vars),
  selected = NULL
)

cs_paramcd_tte <- choices_selected(
  choices = value_choices("ADTTE", "PARAMCD", "PARAM", subset = get_tte_params),
  selected = "OS"
)

ADSL <- rcd_cdisc_dataset_connector("ADSL", radsl, cached = T) %>%
  # data pre-processing code can be saved into a script and called by mutate_dataset("script = "xxx.R") or mutate_data(script = "xxx.R")
  mutate_dataset('adsl_labels <- rtables::var_labels(ADSL)
                        date_vars_adsl <- names(ADSL)[vapply(ADSL, function(x) inherits(x, c("Date", "POSIXct", "POSIXlt")), logical(1))]
                        num_vars_adsl <- names(Filter(isTRUE, sapply(ADSL, is.numeric)))
                        fact_vars_adsl <- names(ADSL)[!(names(ADSL) %in% c("USUBJID", "STUDYID", date_vars_adsl, num_vars_adsl))]
                        ADSL <- ADSL %>% 
                          mutate_at(fact_vars_adsl, factor) %>%
                          mutate(
                          AGEGR1 = factor(case_when(
                            AGE < 45 ~ "<45",
                            AGE >= 45 ~ ">=45"
                          )),
                        )
                        var_labels(ADSL) <- c(adsl_labels, AGEGR1 = "Age Group")
                        attr(ADSL$STUDYID, "label") <- "Study Identifier"
                        attr(ADSL$USUBJID, "label") <- "Unique Subject Identifier"')

#### sample app with DDL ####
app <- init(
  data = teal_data(

      ADSL ,
      rcd_cdisc_dataset_connector("ADAE", radae, cached = T)  %>%
        mutate_dataset('# derive common flags for AEs
                        adae_labels <- rtables::var_labels(ADAE)
                        ADAE <- ADAE %>%
                          mutate(
                            AETOXGR = factor(AETOXGR, levels = c("1", "2", "3", "4", "5")),
                            RELSERFL = ifelse(AEREL == "Y" & AESER == "Y", "Y", "N"),
                            ATOXGR_GRP = factor(case_when(
                              AETOXGR %in% c("1", "2") ~ "1-2",
                              AETOXGR %in% c("3", "4") ~ "3-4",
                              AETOXGR == "5" ~ "5"
                            ), levels = c("1-2", "3-4", "5"))
                          ) %>%
                          rtables::var_relabel(
                            AETOXGR = "Standard Toxicity Grade",
                            RELSERFL = "Related Serious AE",
                            ATOXGR_GRP = "Grouped Analysis Toxicity Grade"
                          )'),
      rcd_cdisc_dataset_connector("ADTTE", radtte, cached = T)
  ),
  modules = root_modules(
    tm_data_table(),
    tm_variable_browser("Variable Browser"),
    tm_t_summary(
      label = "Demographic Table",
      dataname = "ADSL",
      arm_var = cs_arm_var,
      summarize_vars = choices_selected(
        choices = variable_choices("ADSL", subset = get_fact_vars),
        selected = c("SEX", "AGEGR1", strata_vars),
        keep_order = TRUE
      )
    ),
    tm_t_events_by_grade(
      label = "AE Table by Grade",
      dataname = 'ADAE',
      arm_var = cs_arm_var,
      llt = choices_selected(
        choices = variable_choices("ADAE", aeterm_vars),
        selected = c("AEDECOD")
      ),
      hlt = choices_selected(
        choices = variable_choices("ADAE", aeterm_vars),
        selected = "AEBODSYS"
      ),
      grade = choices_selected(
        choices = variable_choices("ADAE", c("AETOXGR", "ATOXGR_GRP")),
        selected = "AETOXGR"
      ),
      add_total = TRUE
    ),
    tm_t_tte(
      label = "Time To Event Table",
      dataname = "ADTTE",
      arm_var = cs_arm_var,
      paramcd = cs_paramcd_tte,
      strata_var = cs_strata_var,
      time_points = choices_selected(c(182, 365, 547), 182),
      event_desc_var = choices_selected(
        choices = variable_choices("ADTTE", "EVNTDESC"), 
        selected = "EVNTDESC", 
        fixed = TRUE
      )
    )
  ),
  header = tags$h1("Example App with entimICE Data with Delayed Data Loading"),
  footer = tags$h3("Dummy data generated from random.cdisc.data")
)

shinyApp(app$ui, app$server)
sorinvoicu commented 3 years ago

@kpagacz narrowed it down to the function below in FilteredData.R. In the case of scatterplotmatrix sample app, it receives 2 dataset names instead of 1 and throws the error.

I'm puzzled why the call has plural datanames, while the function definition has a check on is_character_single() Also what is the sense of the check here if no varnames are actually checked? image

image

inviting @gogonzo into the discussion

Polkas commented 3 years ago

look sto come from https://github.com/insightsengineering/teal/pull/159