From 9dd533349a1bf2ff07cf1877e64c8ef4c4d33d92 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Thu, 10 Oct 2024 14:58:49 +0200 Subject: [PATCH 1/2] 291 add `print(p)` and `print(tbl)` to the output of boxplot and density plot (#293) Closes #291 Adds `print(p)` and `print(tbl)` in two modules in `Show R Code` and in the `Reporter Previewer`. I decided to add `print(tbl)` as a part of the text, instead of a code in `tbl` creation so that `print(tbl)` is not evaluated and the table is not printed into the console.
Tested with ```R # Example using ADaM structure analysis dataset. data <- teal_data() data <- within(data, { library(dplyr) library(nestcolor) library(stringr) # use non-exported function from goshawk h_identify_loq_values <- getFromNamespace("h_identify_loq_values", "goshawk") # original ARM value = dose value arm_mapping <- list( "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination" ) set.seed(1) ADSL <- rADSL ADLB <- rADLB var_labels <- lapply(ADLB, function(x) attributes(x)$label) ADLB <- ADLB %>% mutate( AVISITCD = case_when( AVISIT == "SCREENING" ~ "SCR", AVISIT == "BASELINE" ~ "BL", grepl("WEEK", AVISIT) ~ paste("W", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")), TRUE ~ as.character(NA) ), AVISITCDN = 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 = 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 ) %>% rowwise() %>% group_by(PARAMCD) %>% mutate(LBSTRESC = ifelse( USUBJID %in% sample(USUBJID, 1, replace = TRUE), paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC )) %>% 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 <- h_identify_loq_values(ADLB, "LOQFL") ADLB <- left_join(ADLB, ALB_LOQS, by = "PARAM") }) datanames <- c("ADSL", "ADLB") datanames(data) <- datanames join_keys(data) <- default_cdisc_join_keys[datanames] app <- init( data = data, modules = modules( 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) } ```
boxplot_print boxplot_print_report --------- Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> --- R/tm_g_gh_boxplot.R | 22 +++++++++++----------- R/tm_g_gh_correlationplot.R | 5 +++-- R/tm_g_gh_density_distribution_plot.R | 18 ++++++++---------- R/tm_g_gh_lineplot.R | 6 ++++-- R/tm_g_gh_scatterplot.R | 6 ++++-- R/tm_g_gh_spaghettiplot.R | 6 ++++-- 6 files changed, 34 insertions(+), 29 deletions(-) diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R index c44180ef..9ba8989a 100644 --- a/R/tm_g_gh_boxplot.R +++ b/R/tm_g_gh_boxplot.R @@ -456,6 +456,7 @@ srv_g_boxplot <- function(id, font_size = .(font_size), unit = .("AVALU") ) + print(p) }) ) }), 800) @@ -479,6 +480,7 @@ srv_g_boxplot <- function(id, xaxis_var = .(xaxis_var), facet_var = .(facet_var) ) + tbl }) ) }), 800) @@ -507,6 +509,13 @@ srv_g_boxplot <- function(id, DT::formatRound(numeric_cols, 4) }) + joined_qenvs <- reactive({ + req(create_plot(), create_table()) + teal.code::join(create_plot(), create_table()) + }) + + code <- reactive(teal.code::get_code(joined_qenvs())) + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -535,11 +544,7 @@ srv_g_boxplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src( - teal.code::get_code( - teal.code::join(create_plot(), create_table()) - ) - ) + card$append_src(code()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) @@ -578,14 +583,9 @@ srv_g_boxplot <- function(id, DT::formatRound(numeric_cols, 4) }) - joined_qenvs <- reactive({ - req(create_plot(), create_table()) - teal.code::join(create_plot(), create_table()) - }) - teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(joined_qenvs())), + verbatim_content = reactive(code()), title = "Show R Code for Boxplot" ) }) diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R index 773102d1..a352ec01 100644 --- a/R/tm_g_gh_correlationplot.R +++ b/R/tm_g_gh_correlationplot.R @@ -821,6 +821,7 @@ srv_g_correlationplot <- function(id, brushing = TRUE ) + code <- reactive(teal.code::get_code(plot_q())) ### REPORTER if (with_reporter) { @@ -850,7 +851,7 @@ srv_g_correlationplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(plot_q())) + card$append_src(code()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) @@ -884,7 +885,7 @@ srv_g_correlationplot <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(plot_q())), + verbatim_content = reactive(code()), title = "Show R Code for Correlation Plot" ) }) diff --git a/R/tm_g_gh_density_distribution_plot.R b/R/tm_g_gh_density_distribution_plot.R index 3ff36499..b37b6277 100644 --- a/R/tm_g_gh_density_distribution_plot.R +++ b/R/tm_g_gh_density_distribution_plot.R @@ -363,6 +363,7 @@ srv_g_density_distribution_plot <- function(id, # nolint hline_arb_color = .(hline_arb_color), rug_plot = .(rug_plot) ) + print(p) }) ) }), 800) @@ -377,7 +378,7 @@ srv_g_density_distribution_plot <- function(id, # nolint teal.code::eval_code( object = anl_q()$qenv, - code = bquote( + code = bquote({ tbl <- goshawk::t_summarytable( data = ANL, trt_group = .(trt_group), @@ -386,7 +387,8 @@ srv_g_density_distribution_plot <- function(id, # nolint xaxis_var = .(xaxis_var), font_size = .(font_size) ) - ) + tbl + }) ) }), 800) @@ -417,11 +419,11 @@ srv_g_density_distribution_plot <- function(id, # nolint teal.code::join(create_plot(), create_table()) }) + code <- reactive(teal.code::get_code(joined_qenvs())) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive( - teal.code::get_code(joined_qenvs()) - ), + verbatim_content = reactive(code()), title = "Show R Code for Density Distribution Plot" ) @@ -449,11 +451,7 @@ srv_g_density_distribution_plot <- function(id, # nolint card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src( - teal.code::get_code( - teal.code::join(create_plot(), create_table()) - ) - ) + card$append_src(code()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R index 6639250e..7d6924ce 100644 --- a/R/tm_g_gh_lineplot.R +++ b/R/tm_g_gh_lineplot.R @@ -772,6 +772,8 @@ srv_lineplot <- function(id, width = plot_width, ) + code <- reactive(teal.code::get_code(plot_q())) + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -800,7 +802,7 @@ srv_lineplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(plot_q())) + card$append_src(code()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) @@ -809,7 +811,7 @@ srv_lineplot <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(plot_q())), + verbatim_content = reactive(code()), title = "Show R Code for Line Plot" ) }) diff --git a/R/tm_g_gh_scatterplot.R b/R/tm_g_gh_scatterplot.R index 69ee14ac..636a77cd 100644 --- a/R/tm_g_gh_scatterplot.R +++ b/R/tm_g_gh_scatterplot.R @@ -366,6 +366,8 @@ srv_g_scatterplot <- function(id, brushing = TRUE ) + code <- reactive(teal.code::get_code(plot_q())) + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -394,7 +396,7 @@ srv_g_scatterplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(plot_q())) + card$append_src(code()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) @@ -434,7 +436,7 @@ srv_g_scatterplot <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(plot_q())), + verbatim_content = reactive(code()), title = "Show R Code for Scatterplot" ) }) diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R index 46d5344d..3a3ce894 100644 --- a/R/tm_g_gh_spaghettiplot.R +++ b/R/tm_g_gh_spaghettiplot.R @@ -524,6 +524,8 @@ srv_g_spaghettiplot <- function(id, brushing = TRUE ) + code <- reactive(teal.code::get_code(plot_q())) + ### REPORTER if (with_reporter) { card_fun <- function(comment, label) { @@ -544,7 +546,7 @@ srv_g_spaghettiplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(plot_q())) + card$append_src(code()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) @@ -584,7 +586,7 @@ srv_g_spaghettiplot <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(plot_q())), + verbatim_content = reactive(code()), title = "Show R Code for Spaghetti Plot" ) }) From 55abf5539607ceb0193ebf71015ee8df31b0c388 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 10 Oct 2024 12:59:38 +0000 Subject: [PATCH 2/2] [skip actions] Bump version to 0.2.0.9014 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4c497c78..5f3181f9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal.goshawk Title: Longitudinal Visualization `teal` Modules -Version: 0.2.0.9013 -Date: 2024-10-09 +Version: 0.2.0.9014 +Date: 2024-10-10 Authors@R: c( person("Nick", "Paszty", , "nick.paszty@gene.com", role = c("aut", "cre")), person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = "aut"), diff --git a/NEWS.md b/NEWS.md index bcbd05af..7266c410 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal.goshawk 0.2.0.9013 +# teal.goshawk 0.2.0.9014 # teal.goshawk 0.2.0