Skip to content

Commit

Permalink
tdata to teal_data - Multiple Modules (#248)
Browse files Browse the repository at this point in the history 
Please test examples from these modules:

### 1. tm_g_gh_boxplot

<details>
  <summary>
  Example app
  </summary>

```r
data <- teal_data()
data <- within(data, {
  library(dplyr)
  library(nestcolor)

  # original ARM value = dose value
  arm_mapping <- list(
    "A: Drug X" = "150mg QD",
    "B: Placebo" = "Placebo",
    "C: Combination" = "Combination"
  )
  set.seed(1)
  ADSL <- goshawk::rADSL
  ADLB <- goshawk::rADLB
  var_labels <- lapply(ADLB, function(x) attributes(x)$label)
  ADLB <- ADLB %>%
    dplyr::mutate(
      AVISITCD = dplyr::case_when(
        AVISIT == "SCREENING" ~ "SCR",
        AVISIT == "BASELINE" ~ "BL",
        grepl("WEEK", AVISIT) ~ paste("W", stringr::str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
        TRUE ~ as.character(NA)
      ),
      AVISITCDN = dplyr::case_when(
        AVISITCD == "SCR" ~ -2,
        AVISITCD == "BL" ~ 0,
        grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
        TRUE ~ as.numeric(NA)
      ),
      AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
      TRTORD = dplyr::case_when(
        ARMCD == "ARM C" ~ 1,
        ARMCD == "ARM B" ~ 2,
        ARMCD == "ARM A" ~ 3
      ),
      ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
      ARM = factor(ARM) %>% reorder(TRTORD),
      ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
      ACTARM = factor(ACTARM) %>% reorder(TRTORD),
      ANRLO = 50,
      ANRHI = 75
    ) %>%
    dplyr::rowwise() %>%
    dplyr::group_by(PARAMCD) %>%
    dplyr::mutate(LBSTRESC = ifelse(
      USUBJID %in% sample(USUBJID, 1, replace = TRUE),
      paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
    )) %>%
    dplyr::mutate(LBSTRESC = ifelse(
      USUBJID %in% sample(USUBJID, 1, replace = TRUE),
      paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
    )) %>%
    ungroup()

  attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
  attr(ADLB[["ACTARM"]], "label") <- var_labels[["ACTARM"]]
  attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
  attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"

  # add LLOQ and ULOQ variables
  ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB)
  ADLB <- dplyr::left_join(ADLB, ALB_LOQS, by = "PARAM")
})

datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames

join_keys(data) <- default_cdisc_join_keys[datanames]

app <- teal::init(
  data = data,
  modules = teal::modules(
    teal.goshawk::tm_g_gh_boxplot(
      label = "Box Plot",
      dataname = "ADLB",
      param_var = "PARAMCD",
      param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
      yaxis_var = choices_selected(c("AVAL", "BASE", "CHG"), "AVAL"),
      xaxis_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "STUDYID"), "ARM"),
      facet_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "SEX"), "AVISITCD"),
      trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
      loq_legend = TRUE,
      rotate_xlab = FALSE,
      hline_arb = c(60, 55),
      hline_arb_color = c("grey", "red"),
      hline_arb_label = c("default_hori_A", "default_hori_B"),
      hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
      hline_vars_colors = c("pink", "brown", "purple", "black"),
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```
</details>

### 2. tm_g_gh_density_distribution_plot

<details>
  <summary>
  Example app
  </summary>

```r
data <- teal_data()
data <- within(data, {
  library(dplyr)
  # original ARM value = dose value
  arm_mapping <- list(
    "A: Drug X" = "150mg QD",
    "B: Placebo" = "Placebo",
    "C: Combination" = "Combination"
  )
  ADSL <- goshawk::rADSL
  ADLB <- goshawk::rADLB
  var_labels <- lapply(ADLB, function(x) attributes(x)$label)
  ADLB <- ADLB %>%
    dplyr::mutate(
      AVISITCD = dplyr::case_when(
        AVISIT == "SCREENING" ~ "SCR",
        AVISIT == "BASELINE" ~ "BL",
        grepl("WEEK", AVISIT) ~ paste("W", stringr::str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
        TRUE ~ as.character(NA)
      ),
      AVISITCDN = dplyr::case_when(
        AVISITCD == "SCR" ~ -2,
        AVISITCD == "BL" ~ 0,
        grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
        TRUE ~ as.numeric(NA)
      ),
      AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
      TRTORD = dplyr::case_when(
        ARMCD == "ARM C" ~ 1,
        ARMCD == "ARM B" ~ 2,
        ARMCD == "ARM A" ~ 3
      ),
      ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
      ARM = factor(ARM) %>% reorder(TRTORD),
      ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
      ACTARM = factor(ACTARM) %>% reorder(TRTORD)
    )

  attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
  attr(ADLB[["ACTARM"]], "label") <- var_labels[["ACTARM"]]
})

datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

app <- teal::init(
  data = data,
  modules = teal::modules(
    teal.goshawk::tm_g_gh_density_distribution_plot(
      label = "Density Distribution Plot",
      dataname = "ADLB",
      param_var = "PARAMCD",
      param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
      xaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "AVAL"),
      trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
      color_manual = c(
        "150mg QD" = "#000000",
        "Placebo" = "#3498DB",
        "Combination" = "#E74C3C"
      ),
      color_comb = "#39ff14",
      comb_line = TRUE,
      plot_height = c(500, 200, 2000),
      font_size = c(12, 8, 20),
      line_size = c(1, .25, 3),
      hline_arb = c(.02, .05),
      hline_arb_color = c("red", "black"),
      hline_arb_label = c("Horizontal Line A", "Horizontal Line B")
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```
</details>


### 3. tm_g_gh_lineplot

<details>
  <summary>
  Example app
  </summary>

```r
data <- teal_data()
data <- within(data, {
  library(dplyr)
  library(stringr)
  library(nestcolor)

  # original ARM value = dose value
  arm_mapping <- list(
    "A: Drug X" = "150mg QD",
    "B: Placebo" = "Placebo",
    "C: Combination" = "Combination"
  )

  ADSL <- goshawk::rADSL
  ADLB <- goshawk::rADLB
  var_labels <- lapply(ADLB, function(x) attributes(x)$label)
  ADLB <- ADLB %>%
    dplyr::mutate(
      AVISITCD = dplyr::case_when(
        AVISIT == "SCREENING" ~ "SCR",
        AVISIT == "BASELINE" ~ "BL",
        grepl("WEEK", AVISIT) ~ paste("W", stringr::str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
        TRUE ~ as.character(NA)
      ),
      AVISITCDN = dplyr::case_when(
        AVISITCD == "SCR" ~ -2,
        AVISITCD == "BL" ~ 0,
        grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
        TRUE ~ as.numeric(NA)
      ),
      AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
      TRTORD = dplyr::case_when(
        ARMCD == "ARM C" ~ 1,
        ARMCD == "ARM B" ~ 2,
        ARMCD == "ARM A" ~ 3
      ),
      ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
      ARM = factor(ARM) %>% reorder(TRTORD),
      ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
      ACTARM = factor(ACTARM) %>% reorder(TRTORD)
    )
  attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
  attr(ADLB[["ACTARM"]], "label") <- var_labels[["ACTARM"]]
})

datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

app <- teal::init(
  data = data,
  modules = teal::modules(
    teal.goshawk::tm_g_gh_lineplot(
      label = "Line Plot",
      dataname = "ADLB",
      param_var = "PARAMCD",
      param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
      shape_choices = c("SEX", "RACE"),
      xaxis_var = choices_selected("AVISITCD", "AVISITCD"),
      yaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "AVAL"),
      trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
      hline_arb = c(20.5, 19.5),
      hline_arb_color = c("red", "green"),
      hline_arb_label = c("A", "B")
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```
</details>


### 4. tm_g_gh_scatterplot

<details>
  <summary>
  Example app
  </summary>

```r
data <- teal_data()
data <- within(data, {
  # original ARM value = dose value
  arm_mapping <- list(
    "A: Drug X" = "150mg QD",
    "B: Placebo" = "Placebo",
    "C: Combination" = "Combination"
  )

  ADSL <- goshawk::rADSL
  ADLB <- goshawk::rADLB
  var_labels <- lapply(ADLB, function(x) attributes(x)$label)
  ADLB <- ADLB %>%
    dplyr::mutate(
      AVISITCD = dplyr::case_when(
        AVISIT == "SCREENING" ~ "SCR",
        AVISIT == "BASELINE" ~ "BL",
        grepl("WEEK", AVISIT) ~ paste("W", stringr::str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
        TRUE ~ as.character(NA)
      ),
      AVISITCDN = dplyr::case_when(
        AVISITCD == "SCR" ~ -2,
        AVISITCD == "BL" ~ 0,
        grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
        TRUE ~ as.numeric(NA)
      ),
      AVISITCD = factor(AVISITCD) %>% stats::reorder(AVISITCDN),
      TRTORD = dplyr::case_when(
        ARMCD == "ARM C" ~ 1,
        ARMCD == "ARM B" ~ 2,
        ARMCD == "ARM A" ~ 3
      ),
      ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
      ARM = factor(ARM) %>% stats::reorder(TRTORD),
      ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
      ACTARM = factor(ACTARM) %>% stats::reorder(TRTORD)
    )
  attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
  attr(ADLB[["ACTARM"]], "label") <- var_labels[["ACTARM"]]
})

datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]


app <- teal::init(
  data = data,
  modules = teal::modules(
    teal.goshawk::tm_g_gh_scatterplot(
      label = "Scatter Plot",
      dataname = "ADLB",
      param_var = "PARAMCD",
      param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
      xaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "BASE"),
      yaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "AVAL"),
      trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
      color_manual = c(
        "150mg QD" = "#000000",
        "Placebo" = "#3498DB",
        "Combination" = "#E74C3C"
      ),
      shape_manual = c("N" = 1, "Y" = 2, "NA" = 0),
      plot_height = c(500, 200, 2000),
      facet_ncol = 2,
      trt_facet = FALSE,
      reg_line = FALSE,
      font_size = c(12, 8, 20),
      dot_size = c(1, 1, 12),
      reg_text_size = c(3, 3, 10)
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```
</details>


### 5. tm_g_gh_spaghettiplot

<details>
  <summary>
  Example app
  </summary>

```r
data <- teal_data()
data <- within(data, {
  library(dplyr)

  # original ARM value = dose value
  arm_mapping <- list(
    "A: Drug X" = "150mg QD",
    "B: Placebo" = "Placebo",
    "C: Combination" = "Combination"
  )
  set.seed(1)
  ADSL <- goshawk::rADSL
  ADLB <- goshawk::rADLB
  var_labels <- lapply(ADLB, function(x) attributes(x)$label)
  ADLB <- ADLB %>%
    dplyr::mutate(
      AVISITCD = dplyr::case_when(
        AVISIT == "SCREENING" ~ "SCR",
        AVISIT == "BASELINE" ~ "BL",
        grepl("WEEK", AVISIT) ~ paste("W", stringr::str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
        TRUE ~ as.character(NA)
      ),
      AVISITCDN = dplyr::case_when(
        AVISITCD == "SCR" ~ -2,
        AVISITCD == "BL" ~ 0,
        grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
        TRUE ~ as.numeric(NA)
      ),
      AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
      TRTORD = dplyr::case_when(
        ARMCD == "ARM C" ~ 1,
        ARMCD == "ARM B" ~ 2,
        ARMCD == "ARM A" ~ 3
      ),
      ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
      ARM = factor(ARM) %>% reorder(TRTORD),
      ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
      ACTARM = factor(ACTARM) %>% reorder(TRTORD),
      ANRLO = 30,
      ANRHI = 75
    ) %>%
    dplyr::rowwise() %>%
    dplyr::group_by(PARAMCD) %>%
    dplyr::mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
      paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
    )) %>%
    dplyr::mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
      paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
    )) %>%
    ungroup()
  attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
  attr(ADLB[["ACTARM"]], "label") <- var_labels[["ACTARM"]]
  attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
  attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"

  # add LLOQ and ULOQ variables
  ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB)
  ADLB <- dplyr::left_join(ADLB, ALB_LOQS, by = "PARAM")
})

datanames <- c("ADSL", "ADLB")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]

app <- teal::init(
  data = data,
  modules = teal::modules(
    teal.goshawk::tm_g_gh_spaghettiplot(
      label = "Spaghetti Plot",
      dataname = "ADLB",
      param_var = "PARAMCD",
      param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
      idvar = "USUBJID",
      xaxis_var = choices_selected(c("Analysis Visit Code" = "AVISITCD"), "AVISITCD"),
      yaxis_var = choices_selected(c("AVAL", "CHG", "PCHG"), "AVAL"),
      filter_var = choices_selected(
        c("None" = "NONE", "Screening" = "BASE2", "Baseline" = "BASE"),
        "NONE"
      ),
      trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
      color_comb = "#39ff14",
      man_color = c(
        "Combination" = "#000000",
        "Placebo" = "#fce300",
        "150mg QD" = "#5a2f5f"
      ),
      hline_arb = c(60, 50),
      hline_arb_color = c("grey", "red"),
      hline_arb_label = c("default A", "default B"),
      hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
      hline_vars_colors = c("pink", "brown", "purple", "black"),
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```
</details>
  • Loading branch information
@vedhav
vedhav authored Nov 24, 2023
1 parent 513b54c commit 3105ef9
Show file tree
Hide file tree
Showing 8 changed files with 31 additions and 21 deletions.
5 changes: 2 additions & 3 deletions .lintr
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
linters: linters_with_defaults(
line_length_linter = line_length_linter(120),
cyclocomp_linter = NULL,
object_usage_linter = NULL,
indentation_linter = NULL
)
object_usage_linter = NULL
)
3 changes: 2 additions & 1 deletion R/tm_g_gh_boxplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -327,7 +327,8 @@ srv_g_boxplot <- function(id,
hline_vars_labels) {
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
checkmate::assert_class(data, "tdata")
checkmate::assert_class(data, "reactive")
checkmate::assert_class(shiny::isolate(data()), "teal_data")

moduleServer(id, function(input, output, session) {
# reused in all modules
Expand Down
3 changes: 2 additions & 1 deletion R/tm_g_gh_density_distribution_plot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -266,7 +266,8 @@ srv_g_density_distribution_plot <- function(id, # nolint
plot_width) {
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
checkmate::assert_class(data, "tdata")
checkmate::assert_class(data, "reactive")
checkmate::assert_class(shiny::isolate(data()), "teal_data")

moduleServer(id, function(input, output, session) {
anl_q_output <- constr_anl_q(
Expand Down
3 changes: 2 additions & 1 deletion R/tm_g_gh_lineplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -331,7 +331,8 @@ srv_lineplot <- function(id,
plot_width) {
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
checkmate::assert_class(data, "tdata")
checkmate::assert_class(data, "reactive")
checkmate::assert_class(shiny::isolate(data()), "teal_data")

moduleServer(id, function(input, output, session) {
ns <- session$ns
Expand Down
3 changes: 2 additions & 1 deletion R/tm_g_gh_scatterplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -266,7 +266,8 @@ srv_g_scatterplot <- function(id,
plot_width) {
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
checkmate::assert_class(data, "tdata")
checkmate::assert_class(data, "reactive")
checkmate::assert_class(shiny::isolate(data()), "teal_data")

moduleServer(id, function(input, output, session) {
# reused in all modules
Expand Down
3 changes: 2 additions & 1 deletion R/tm_g_gh_spaghettiplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -342,7 +342,8 @@ srv_g_spaghettiplot <- function(id,
hline_vars_labels) {
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
checkmate::assert_class(data, "tdata")
checkmate::assert_class(data, "reactive")
checkmate::assert_class(shiny::isolate(data()), "teal_data")

moduleServer(id, function(input, output, session) {
# reused in all modules
Expand Down
15 changes: 9 additions & 6 deletions R/utils-arbitrary_lines.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,6 @@ ui_arbitrary_lines <- function(id, line_arb, line_arb_label, line_arb_color, tit
#' @keywords internal
srv_arbitrary_lines <- function(id) {
moduleServer(id, function(input, output, session) {

comma_sep_to_values <- function(values, wrapper_fun = trimws) {
vals <- strsplit(values, "\\s{0,},\\s{0,}")[[1]]
suppressWarnings(wrapper_fun(vals))
Expand All @@ -59,8 +58,9 @@ srv_arbitrary_lines <- function(id) {
iv$add_rule("line_arb", shinyvalidate::sv_optional())
iv$add_rule(
"line_arb",
~ if (any(is.na(comma_sep_to_values(., as.numeric))))
~ if (any(is.na(comma_sep_to_values(., as.numeric)))) {
"Arbitrary lines values should be a comma separated list of numbers"
}
)

iv_color <- shinyvalidate::InputValidator$new()
Expand All @@ -69,14 +69,16 @@ srv_arbitrary_lines <- function(id) {
iv_color$add_rule("line_arb_color", shinyvalidate::sv_optional())
iv_color$add_rule(
"line_arb_color",
~ if (!length(comma_sep_to_values(.)) %in% c(1, length(line_arb())))
~ if (!length(comma_sep_to_values(.)) %in% c(1, length(line_arb()))) {
sprintf(
"Line input error: number of colors should be equal to 1, the number of lines (%d) or left blank for 'red'",
length(line_arb())
)
}
)
iv_color$add_rule("line_arb_color", ~ if (!check_color(comma_sep_to_values(.)))
"The line colors entered cannot be converted to colors in R, please check your spelling")
iv_color$add_rule("line_arb_color", ~ if (!check_color(comma_sep_to_values(.))) {
"The line colors entered cannot be converted to colors in R, please check your spelling"
})
iv$add_validator(iv_color)


Expand All @@ -86,11 +88,12 @@ srv_arbitrary_lines <- function(id) {
iv_label$add_rule("line_arb_label", shinyvalidate::sv_optional())
iv_label$add_rule(
"line_arb_label",
~ if (!length(comma_sep_to_values(.)) %in% c(1, length(line_arb())))
~ if (!length(comma_sep_to_values(.)) %in% c(1, length(line_arb()))) {
sprintf(
"Line input error: number of labels should be equal to 1, the number of lines (%d) or left blank",
length(line_arb())
)
}
)
iv$add_validator(iv_label)
iv
Expand Down
17 changes: 10 additions & 7 deletions R/utils-data_constraints.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,8 @@ keep_data_const_opts_updated <- function(session, input, data, id_param_var) {
# param_id: input id that contains values of PARAMCD to filter for
# param_var: currently only "PARAMCD" is supported
constr_anl_q <- function(session, input, data, dataname, param_id, param_var, trt_group, min_rows) {
checkmate::assert_class(data, "reactive")
checkmate::assert_class(shiny::isolate(data()), "teal_data")
dataset_var <- dataname
if (!identical(param_var, "PARAMCD")) {
# why is there a variable param_id which is provided to this function and always equal to "param"?
Expand All @@ -60,7 +62,7 @@ constr_anl_q <- function(session, input, data, dataname, param_id, param_var, tr
validate(need(param_var_value, "Please select a biomarker"))
checkmate::assert_string(param_var_value)

ANL <- data[[dataname]] # nolint
ANL <- data()[[dataname]] # nolint
validate_has_data(ANL, min_rows)

validate_has_variable(ANL, param_var)
Expand All @@ -70,7 +72,7 @@ constr_anl_q <- function(session, input, data, dataname, param_id, param_var, tr
validate_has_variable(ANL, trt_group)

# analysis
private_qenv <- data %>%
private_qenv <- data() %>%
teal.code::eval_code(
substitute(ANL <- dataname, list(dataname = as.name(dataname))) # nolint
) %>%
Expand All @@ -91,7 +93,7 @@ constr_anl_q <- function(session, input, data, dataname, param_id, param_var, tr
constraint_var <- input[["constraint_var"]]
validate(need(constraint_var, "select a constraint variable"))

ANL <- data[[dataname]] # nolint
ANL <- data()[[dataname]] # nolint
validate_has_data(ANL, min_rows)

validate_has_variable(ANL, param_var)
Expand Down Expand Up @@ -164,21 +166,22 @@ constr_anl_q <- function(session, input, data, dataname, param_id, param_var, tr
# constraint var means that `param_id.constraint_var` is constrained to the filtered range (or NA),
# e.g. `ALT.BASE2` (i.e. `PARAMCD = ALT & range_filter_on(BASE2)`)
create_anl_constraint_reactive <- function(anl_param, input, param_id, min_rows) {

iv_r <- reactive({
iv <- shinyvalidate::InputValidator$new()
iv$condition(~ isTRUE(input$constraint_var != "NONE"))
iv$add_rule("constraint_range_min", shinyvalidate::sv_required("A contraint minimum value is required"))
iv$add_rule("constraint_range_max", shinyvalidate::sv_required("A contraint maximum value is required"))
iv$add_rule(
"constraint_range_min",
~ if (!is.na(input$constraint_range_max) && (.) > input$constraint_range_max)
~ if (!is.na(input$constraint_range_max) && (.) > input$constraint_range_max) {
"constraint min needs to be less than max"
}
)
iv$add_rule(
"constraint_range_max",
~ if (!is.na(input$constraint_range_min) && (.) < input$constraint_range_min)
~ if (!is.na(input$constraint_range_min) && (.) < input$constraint_range_min) {
"constraint min needs to be less than max"
}
)
iv
})
Expand Down Expand Up @@ -222,7 +225,7 @@ create_anl_constraint_reactive <- function(anl_param, input, param_id, min_rows)
ANL <- ANL %>% dplyr::filter(USUBJID %in% filtered_usubjids) # nolint
})
)
validate_has_data(private_qenv[["ANL"]], min_rows)
validate_has_data(private_qenv[["ANL"]], min_rows)
}
list(ANL = private_qenv[["ANL"]], qenv = private_qenv)
})
Expand Down

0 comments on commit 3105ef9

Please sign in to comment.