Skip to content

Commit

Permalink
tdata to teal_data - tm_g_butterfly (#237)
Browse files Browse the repository at this point in the history
**Example App**

```r
data <- cdisc_data() |>
  within({
    library(dplyr)
    library(nestcolor)
    set.seed(23)
    ADSL <- rADSL
    ADAE <- rADAE
    ADSL <- mutate(ADSL, DOSE = paste(sample(1:3, n(), replace = TRUE), "UG"))
    ADAE <- mutate(
      ADAE,
      flag1 = ifelse(AETOXGR == 1, 1, 0),
      flag2 = ifelse(AETOXGR == 2, 1, 0),
      flag3 = ifelse(AETOXGR == 3, 1, 0),
      flag1_filt = rep("Y", n())
    )
  })

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

app <- init(
  data = data,
  modules = modules(
    tm_g_butterfly(
      label = "Butterfly Plot",
      dataname = "ADAE",
      right_var = choices_selected(
        selected = "SEX",
        choices = c("SEX", "ARM", "RACE")
      ),
      left_var = choices_selected(
        selected = "RACE",
        choices = c("SEX", "ARM", "RACE")
      ),
      category_var = choices_selected(
        selected = "AEBODSYS",
        choices = c("AEDECOD", "AEBODSYS")
      ),
      color_by_var = choices_selected(
        selected = "AETOXGR",
        choices = c("AETOXGR", "None")
      ),
      count_by_var = choices_selected(
        selected = "# of patients",
        choices = c("# of patients", "# of AEs")
      ),
      facet_var = choices_selected(
        selected = NULL,
        choices = c("RACE", "SEX", "ARM")
      ),
      sort_by_var = choices_selected(
        selected = "count",
        choices = c("count", "alphabetical")
      ),
      legend_on = TRUE,
      plot_height = c(600, 200, 2000)
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```
  • Loading branch information
vedhav authored Nov 24, 2023
1 parent ed77918 commit 47642f4
Showing 1 changed file with 14 additions and 13 deletions.
27 changes: 14 additions & 13 deletions R/tm_g_butterfly.R
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@
#' @template author_liaoc10
#'
#' @examples
# Example using stream (ADaM) dataset
#' Example using stream (ADaM) dataset
#' data <- cdisc_data() |>
#' within({
#' library(dplyr)
Expand Down Expand Up @@ -266,12 +266,13 @@ ui_g_butterfly <- function(id, ...) {
srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, label, plot_height, 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) {
iv <- reactive({
ADSL <- data[["ADSL"]]() # nolint
ANL <- data[[dataname]]() # nolint
ADSL <- data()[["ADSL"]] # nolint
ANL <- data()[[dataname]] # nolint

iv <- shinyvalidate::InputValidator$new()
iv$add_rule("category_var", shinyvalidate::sv_required(
Expand Down Expand Up @@ -316,10 +317,10 @@ srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, labe
selected = character(0)
)
} else {
options$r <- if (right_var %in% names(data[["ADSL"]]())) {
levels(data[["ADSL"]]()[[right_var]])
options$r <- if (right_var %in% names(data()[["ADSL"]])) {
levels(data()[["ADSL"]][[right_var]])
} else {
levels(data[[dataname]]()[[right_var]])
levels(data()[[dataname]][[right_var]])
}

selected <- if (length(right_val) > 0) {
Expand Down Expand Up @@ -353,10 +354,10 @@ srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, labe
choices = character(0), selected = character(0)
)
} else {
options$l <- if (left_var %in% names(data[["ADSL"]]())) {
levels(data[["ADSL"]]()[[left_var]])
options$l <- if (left_var %in% names(data()[["ADSL"]])) {
levels(data()[["ADSL"]][[left_var]])
} else {
levels(data[[dataname]]()[[left_var]])
levels(data()[[dataname]][[left_var]])
}

selected <- if (length(left_val) > 0) {
Expand All @@ -383,8 +384,8 @@ srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, labe
output_q <- shiny::debounce(
millis = 200,
r = reactive({
ADSL <- data[["ADSL"]]() # nolint
ANL <- data[[dataname]]() # nolint
ADSL <- data()[["ADSL"]] # nolint
ANL <- data()[[dataname]] # nolint

teal::validate_has_data(ADSL, min_nrow = 0, msg = sprintf("%s Data is empty", "ADSL"))
teal::validate_has_data(ANL, min_nrow = 0, msg = sprintf("%s Data is empty", dataname))
Expand Down Expand Up @@ -420,7 +421,7 @@ srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, labe
anl_vars <- unique(c("USUBJID", "STUDYID", varlist_from_anl)) # nolint

q1 <- teal.code::eval_code(
teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)),
data(),
code = bquote({
ADSL <- ADSL[, .(adsl_vars)] %>% as.data.frame() # nolint
ANL <- .(as.name(dataname))[, .(anl_vars)] %>% as.data.frame() # nolint
Expand Down

0 comments on commit 47642f4

Please sign in to comment.