Skip to content

Commit

Permalink
26 new chunks@main (#172)
Browse files Browse the repository at this point in the history
* Update file paths (#171)

Co-authored-by: cicdguy <[email protected]>

* [skip actions] Bump version to 0.1.14.9013.1

* tm_g_ae_oview

* implement quosures and data

* fixes

* [skip actions] Restyle files

* Apply suggestions from code review

* fix linting

* with filter

* Apply suggestions from code review

Co-authored-by: Mahmoud Hallal <[email protected]>

* Update NEWS.md

* fix tm_g_ae_oview report card

* @main:

* remove print statements

* fix red error from empty data

* fix butterfly validation

* Apply suggestions from code review

Fix docs grammar

Co-authored-by: Mahmoud Hallal <[email protected]>
Co-authored-by: Nikolas Burkoff <[email protected]>

* [skip actions] Roxygen Man Pages Auto Update

* empty

Co-authored-by: Insights Engineering Bot <[email protected]>
Co-authored-by: cicdguy <[email protected]>
Co-authored-by: cicdguy <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Nikolas Burkoff <[email protected]>
Co-authored-by: Mahmoud Hallal <[email protected]>
Co-authored-by: Maciej Nasinski <[email protected]>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
  • Loading branch information
9 people authored Sep 8, 2022
1 parent 06f3853 commit fff2ede
Show file tree
Hide file tree
Showing 16 changed files with 549 additions and 746 deletions.
1 change: 0 additions & 1 deletion .github/workflows/check.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,6 @@ jobs:
secrets:
REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }}
coverage:
if: github.event_name == 'pull_request'
name: Coverage 📔
uses: insightsengineering/r.pkg.template/.github/workflows/test-coverage.yaml@main
secrets:
Expand Down
4 changes: 3 additions & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,9 @@

### Breaking changes
* Soft deprecate function `label_aevar()`.

* Replaced `chunks` with simpler `Quosure` class.
* Replaced `datasets` argument containing `FilteredData` with the new arguments `data` (list of reactive datasets) and `filter_panel_api` (`FilterPanelAPI`).
* Updated `arm_var` to point to the factor column in `ANL`. It can't be a character column anymore.

### Enhancements
* Added `teal.reporter` to all modules.
Expand Down
2 changes: 1 addition & 1 deletion R/argument_convention.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@
#' @param arm_var (`choices_selected`)\cr
#' object with all available choices and the pre-selected option for variable
#' names that can be used as `arm_var`. See [teal.transform::choices_selected()] for
#' details.
#' details. Column `arm_var` in the `dataname` has to be a factor.
#'
#' @param paramcd (`character(1)` or `choices_selected`)\cr
#' variable value designating the studied parameter.
Expand Down
148 changes: 62 additions & 86 deletions R/tm_g_ae_oview.R
Original file line number Diff line number Diff line change
Expand Up @@ -136,7 +136,7 @@ tm_g_ae_oview <- function(label,
),
ui = ui_g_ae_oview,
ui_args = args,
filters = dataname
filters = c("ADSL", dataname)
)
}

Expand Down Expand Up @@ -208,22 +208,23 @@ ui_g_ae_oview <- function(id, ...) {
footnotes = ""
)
),
forms = get_rcode_ui(ns("rcode"))
forms = teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
)
}

srv_g_ae_oview <- function(id,
datasets,
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")

moduleServer(id, function(input, output, session) {
teal.code::init_chunks()
decorate_output <- srv_g_decorate(id = NULL, plt = plt, plot_height = plot_height, plot_width = plot_width)
decorate_output <- srv_g_decorate(id = NULL, plt = plot_r, plot_height = plot_height, plot_width = plot_width)
font_size <- decorate_output$font_size
pws <- decorate_output$pws

Expand All @@ -241,15 +242,12 @@ srv_g_ae_oview <- function(id,
)
})

observeEvent(input$arm_var, {
ANL <- datasets$get_data(dataname, filtered = FALSE) # nolint

req(!is.null(input$arm_var))
observeEvent(input$arm_var, ignoreNULL = TRUE, {
ANL <- data[[dataname]]() # nolint
arm_var <- input$arm_var
arm_val <- ANL[[arm_var]]
choices <- levels(arm_val)

choices <- unique(ANL[[arm_var]])

validate(need(length(choices) > 0, "Please include multiple treatment"))
if (length(choices) == 1) {
trt_index <- 1
} else {
Expand All @@ -270,8 +268,13 @@ srv_g_ae_oview <- function(id,
)
})

plt <- reactive({
output_q <- reactive({
ANL <- data[[dataname]]() # nolint
validate(need(input$arm_var, "Please select an arm variable."))
validate(need(
is.factor(ANL[[input$arm_var]]),
"Selected arm variable needs to be a factor."
))
validate(need(input$flag_var_anl, "Please select at least one flag."))
validate(need(
input$arm_trt != input$arm_ref,
Expand All @@ -281,83 +284,61 @@ srv_g_ae_oview <- function(id,
sep = "\n"
)
))

ANL_UNFILTERED <- datasets$get_data(dataname, filtered = FALSE) # nolint
ADSL <- datasets$get_data("ADSL", filtered = TRUE) # nolint
ANL <- datasets$get_data(dataname, filtered = TRUE) # nolint

anl_name <- dataname
assign(anl_name, ANL)

teal.code::chunks_reset(envir = environment())

validate(need(nlevels(ANL[[input$arm_var]]) > 1, "Arm needs to have at least 2 levels"))
validate_has_data(ANL, min_nrow = 10)
if (all(c(input$arm_trt, input$arm_ref) %in% ANL_UNFILTERED[[input$arm_var]])) {
validate(
need(
input$arm_ref %in% ANL[[input$arm_var]],
paste0("Selected Control ", input$arm_var, ", ", input$arm_ref, ", is not in the data (filtered out?)")
),
need(
input$arm_trt %in% ANL[[input$arm_var]],
paste0("Selected Treatment ", input$arm_var, ", ", input$arm_trt, ", is not in the data (filtered out?)")
)
validate(
need(
input$arm_ref %in% ANL[[input$arm_var]],
paste0("Selected Control ", input$arm_var, ", ", input$arm_ref, ", is not in the data (filtered out?)")
),
need(
input$arm_trt %in% ANL[[input$arm_var]],
paste0("Selected Treatment ", input$arm_var, ", ", input$arm_trt, ", is not in the data (filtered out?)")
)
}
)
validate(need(all(c(input$arm_trt, input$arm_ref) %in% unique(ANL[[input$arm_var]])), "Plot loading"))

teal.code::chunks_push(
id = "variables call",
expression = bquote({
id <- .(as.name(anl_name))[["USUBJID"]]
arm <- .(as.name(anl_name))[[.(input$arm_var)]]
arm_N <- table(ADSL[[.(input$arm_var)]]) # nolint
trt <- .(input$arm_trt)
ref <- .(input$arm_ref)
anl_labels <- formatters::var_labels(.(as.name(anl_name)), fill = FALSE)
flags <- .(as.name(anl_name)) %>%
q1 <- teal.code::eval_code(
teal.code::new_quosure(data),
name = "variables call",
code = as.expression(c(
bquote(anl_labels <- formatters::var_labels(.(as.name(dataname)), fill = FALSE)),
bquote(flags <- .(as.name(dataname)) %>%
select(all_of(.(input$flag_var_anl))) %>%
rename_at(vars(.(input$flag_var_anl)), function(x) paste0(x, ": ", anl_labels[x]))
})
rename_at(vars(.(input$flag_var_anl)), function(x) paste0(x, ": ", anl_labels[x])))
))
)

teal.code::chunks_push_new_line()

teal.code::chunks_safe_eval()

teal.code::chunks_push(
id = "g_events_term_id call",
expression = bquote({
osprey::g_events_term_id(
term = flags,
id = id,
arm = arm,
arm_N = arm_N,
ref = .(input$arm_ref),
trt = .(input$arm_trt),
diff_ci_method = .(input$diff_ci_method),
conf_level = .(input$conf_level),
axis_side = .(input$axis),
fontsize = .(font_size()),
draw = TRUE
)
})
teal.code::eval_code(
q1,
name = "g_events_term_id call",
code = as.expression(c(
bquote(
plot <- osprey::g_events_term_id(
term = flags,
id = .(as.name(dataname))[["USUBJID"]],
arm = .(as.name(dataname))[[.(input$arm_var)]],
arm_N = table(ADSL[[.(input$arm_var)]]),
ref = .(input$arm_ref),
trt = .(input$arm_trt),
diff_ci_method = .(input$diff_ci_method),
conf_level = .(input$conf_level),
axis_side = .(input$axis),
fontsize = .(font_size()),
draw = TRUE
)
),
quote(plot)
))
)

teal.code::chunks_safe_eval()
})

get_rcode_srv(
plot_r <- reactive(output_q()[["plot"]])

teal.widgets::verbatim_popup_srv(
id = "rcode",
datasets = datasets,
modal_title = paste("R code for", label),
datanames = unique(c(
dataname,
vapply(X = dataname, FUN.VALUE = character(1), function(x) {
if (inherits(datasets, "CDISCFilteredData")) datasets$get_parentname(x)
})
))
verbatim_content = reactive(teal.code::get_code(output_q())),
title = paste("R code for", label)
)

### REPORTER
Expand All @@ -366,19 +347,14 @@ srv_g_ae_oview <- function(id,
card <- teal.reporter::TealReportCard$new()
card$set_name("AE Overview")
card$append_text("AE Overview", "header2")
card$append_fs(datasets$get_filter_state())
if (with_filter) card$append_fs(filter_panel_api$get_filter_state())
card$append_text("Plot", "header3")
card$append_plot(plt(), dim = pws$dim())
card$append_plot(plot_r(), dim = pws$dim())
if (!comment == "") {
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(paste(get_rcode(
chunks = teal.code::get_chunks_object(parent_idx = 2L),
datasets = datasets,
title = "",
description = ""
), collapse = "\n"))
card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n"))
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
Loading

0 comments on commit fff2ede

Please sign in to comment.