From 99a39ee403ab9868c3f9689cdcabd42cbda68cd2 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 3 Oct 2024 17:18:31 +0530 Subject: [PATCH 01/35] feat: use bslib tooltip instead of custom css class --- DESCRIPTION | 1 + R/tm_a_regression.R | 24 +++++++++++------------- R/tm_g_distribution.R | 10 +++++----- R/tm_missing_data.R | 24 ++++++++++++------------ R/tm_variable_browser.R | 14 +++++++------- 5 files changed, 36 insertions(+), 37 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a19237bbc..08235ab9f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,6 +30,7 @@ Depends: teal (>= 0.15.2.9052), teal.transform (>= 0.5.0) Imports: + bslib (>= 0.8.0), checkmate (>= 2.1.0), dplyr (>= 1.0.5), DT (>= 0.13), diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 89406f5e5..cef665db4 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -259,7 +259,7 @@ ui_a_regression <- function(id, ...) { ### Reporter teal.reporter::simple_reporter_ui(ns("simple_reporter")), ### - tags$label("Encodings", class = "text-primary"), + tags$label("Encodings", class = "text-primary"), tags$br(), teal.transform::datanames_input(args[c("response", "regressor")]), teal.transform::data_extract_ui( id = ns("response"), @@ -286,12 +286,10 @@ ui_a_regression <- function(id, ...) { teal.widgets::optionalSliderInput( ns("outlier"), tags$div( - class = "teal-tooltip", tagList( "Outlier definition:", - icon("circle-info"), - tags$span( - class = "tooltiptext", + bslib::tooltip( + icon("fas fa-circle-info"), paste( "Use the slider to choose the cut-off value to define outliers.", "Points with a Cook's distance greater than", @@ -316,16 +314,16 @@ ui_a_regression <- function(id, ...) { teal.widgets::optionalSliderInputValMinMax( inputId = ns("label_min_segment"), label = tags$div( - class = "teal-tooltip", tagList( "Label min. segment:", - icon("circle-info"), - tags$span( - class = "tooltiptext", - paste( - "Use the slider to choose the cut-off value to define minimum distance between label and point", - "that generates a line segment.", - "It's only valid when 'Display outlier labels' is checked." + bslib::tooltip( + icon("circle-info"), + tags$span( + paste( + "Use the slider to choose the cut-off value to define minimum distance between label and point", + "that generates a line segment.", + "It's only valid when 'Display outlier labels' is checked." + ) ) ) ) diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R index 6b6192678..9731ff7c6 100644 --- a/R/tm_g_distribution.R +++ b/R/tm_g_distribution.R @@ -282,13 +282,13 @@ ui_distribution <- function(id, ...) { teal.widgets::optionalSelectInput( ns("t_dist"), tags$div( - class = "teal-tooltip", tagList( "Distribution:", - icon("circle-info"), - tags$span( - class = "tooltiptext", - "Default parameters are optimized with MASS::fitdistr function." + bslib::tooltip( + icon("circle-info"), + tags$span( + "Default parameters are optimized with MASS::fitdistr function." + ) ) ) ), diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R index 7f026cb49..aad5eeae3 100644 --- a/R/tm_missing_data.R +++ b/R/tm_missing_data.R @@ -351,13 +351,13 @@ encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, data checkboxInput( ns("any_na"), tags$div( - class = "teal-tooltip", tagList( "Add **anyna** variable", - icon("circle-info"), - tags$span( - class = "tooltiptext", - "Describes the number of observations with at least one missing value in any variable." + bslib::tooltip( + icon("circle-info"), + tags$span( + "Describes the number of observations with at least one missing value in any variable." + ) ) ) ), @@ -367,15 +367,15 @@ encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, data checkboxInput( ns("if_patients_plot"), tags$div( - class = "teal-tooltip", tagList( "Add summary per patients", - icon("circle-info"), - tags$span( - class = "tooltiptext", - paste( - "Displays the number of missing values per observation,", - "where the x-axis is sorted by observation appearance in the table." + bslib::tooltip( + icon("circle-info"), + tags$span( + paste( + "Displays the number of missing values per observation,", + "where the x-axis is sorted by observation appearance in the table." + ) ) ) ) diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index 28e0c11d1..48f7d4e71 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -440,15 +440,15 @@ srv_variable_browser <- function(id, sliderInput( inputId = session$ns("outlier_definition_slider"), tags$div( - class = "teal-tooltip", tagList( "Outlier definition:", - icon("circle-info"), - tags$span( - class = "tooltiptext", - paste( - "Use the slider to choose the cut-off value to define outliers; the larger the value the", - "further below Q1/above Q3 points have to be in order to be classed as outliers" + bslib::tooltip( + icon("circle-info"), + tags$span( + paste( + "Use the slider to choose the cut-off value to define outliers; the larger the value the", + "further below Q1/above Q3 points have to be in order to be classed as outliers" + ) ) ) ) From f1403d6d3a16fed8af42ea9b06f5340edb088687 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 24 Feb 2025 12:32:23 +0100 Subject: [PATCH 02/35] specify dependencies branches --- DESCRIPTION | 3 +++ 1 file changed, 3 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 09afdaa01..0adeb6c51 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -79,6 +79,9 @@ Suggests: shinytest2, testthat (>= 3.1.9), withr (>= 2.0.0) +Remotes: + insightsengineering/teal@test@bslib@main, + insightsengineering/teal.reporter@redesign_poc@main VignetteBuilder: knitr, rmarkdown From d44a257626f801bbc1756a094410921840281bd2 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 24 Feb 2025 14:20:57 +0100 Subject: [PATCH 03/35] initial test for tm_a_regression --- R/tm_a_regression.R | 36 +++++++++++++----------------------- 1 file changed, 13 insertions(+), 23 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 54c533ad3..7160856c7 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -282,9 +282,6 @@ ui_a_regression <- function(id, ...) { tags$div(verbatimTextOutput(ns("text"))) )), encoding = tags$div( - ### Reporter - teal.reporter::simple_reporter_ui(ns("simple_reporter")), - ### tags$label("Encodings", class = "text-primary"), teal.transform::datanames_input(args[c("response", "regressor")]), teal.transform::data_extract_ui( @@ -384,7 +381,6 @@ ui_a_regression <- function(id, ...) { # Server function for the regression module srv_a_regression <- function(id, data, - reporter, filter_panel_api, response, regressor, @@ -393,7 +389,6 @@ srv_a_regression <- function(id, ggplot2_args, default_outlier_label, decorators) { - with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") @@ -1034,25 +1029,20 @@ srv_a_regression <- function(id, ) ### REPORTER - if (with_reporter) { - card_fun <- function(comment, label) { - card <- teal::report_card_template( - title = "Linear Regression Plot", - label = label, - with_filter = with_filter, - filter_panel_api = filter_panel_api - ) - card$append_text("Plot", "header3") - card$append_plot(plot_r(), dim = pws$dim()) - if (!comment == "") { - card$append_text("Comment", "header3") - card$append_text(comment) - } - card$append_src(source_code_r()) - card + card_fun <- reactive({ + req(plot_r(), source_code_r()) + function() { + card <- teal.reporter::report_document() + card <- c(card, c(list("## Plot"))) + # card <- c(card, c(list("## Plot"), list(plot_r()))) + # card <- c(card, list(source_code_r())) + card } - teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) - } + }) ### + + list( + report_card = card_fun + ) }) } From 3538a2ceac318b25d12c6c520fe6668e3799ca73 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 24 Feb 2025 14:46:42 +0100 Subject: [PATCH 04/35] update branch name --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0adeb6c51..61c4d7262 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -81,7 +81,7 @@ Suggests: withr (>= 2.0.0) Remotes: insightsengineering/teal@test@bslib@main, - insightsengineering/teal.reporter@redesign_poc@main + insightsengineering/teal.reporter@redesign@main VignetteBuilder: knitr, rmarkdown From 88e6ee4ce4ecdcdc282b32f373949bb46f567ef8 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Mon, 24 Feb 2025 13:51:44 +0000 Subject: [PATCH 05/35] [skip style] [skip vbump] Restyle files --- R/tm_a_regression.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 7160856c7..60345adf7 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1031,12 +1031,12 @@ srv_a_regression <- function(id, ### REPORTER card_fun <- reactive({ req(plot_r(), source_code_r()) - function() { - card <- teal.reporter::report_document() - card <- c(card, c(list("## Plot"))) - # card <- c(card, c(list("## Plot"), list(plot_r()))) - # card <- c(card, list(source_code_r())) - card + function() { + card <- teal.reporter::report_document() + card <- c(card, c(list("## Plot"))) + # card <- c(card, c(list("## Plot"), list(plot_r()))) + # card <- c(card, list(source_code_r())) + card } }) ### From f5d3f321904550eb5994d281913760d72e5eb4ac Mon Sep 17 00:00:00 2001 From: m7pr Date: Tue, 25 Feb 2025 12:37:06 +0100 Subject: [PATCH 06/35] bring back reporter parameter for now --- R/tm_a_regression.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 7160856c7..7af05b6f8 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -384,6 +384,7 @@ srv_a_regression <- function(id, filter_panel_api, response, regressor, + reporter, plot_height, plot_width, ggplot2_args, From e2216eea93b4637ece640460c45c1780137b4c0a Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 26 Feb 2025 13:04:19 +0100 Subject: [PATCH 07/35] remove function from card_fun in regression --- R/tm_a_regression.R | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 9b4273ed4..a770830a4 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1032,13 +1032,12 @@ srv_a_regression <- function(id, ### REPORTER card_fun <- reactive({ req(plot_r(), source_code_r()) - function() { - card <- teal.reporter::report_document() - card <- c(card, c(list("## Plot"))) - # card <- c(card, c(list("## Plot"), list(plot_r()))) - # card <- c(card, list(source_code_r())) - card - } + teal.reporter::report_document( + "## Plot", + #,plot_r()) + "## Source Code" + #,source_code_r() + ) }) ### From 809654f8abc4621a61ae212234461ec96b7b7472 Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 26 Feb 2025 13:18:41 +0100 Subject: [PATCH 08/35] update Remotes --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 61c4d7262..6b96f2dc6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -80,7 +80,7 @@ Suggests: testthat (>= 3.1.9), withr (>= 2.0.0) Remotes: - insightsengineering/teal@test@bslib@main, + insightsengineering/teal@redesign@main, insightsengineering/teal.reporter@redesign@main VignetteBuilder: knitr, From a8fec54523b8930ab446ad36607e38605f26b1bf Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 26 Feb 2025 13:41:38 +0100 Subject: [PATCH 09/35] return plot and the source code through card_fun --- R/tm_a_regression.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 966a018a3..52a746aed 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1035,12 +1035,12 @@ srv_a_regression <- function(id, ### REPORTER card_fun <- reactive({ req(plot_r(), source_code_r()) - teal.reporter::report_document( - "## Plot", - #,plot_r()) - "## Source Code" - #,source_code_r() - ) + teal.reporter::report_document( + "## Plot", + plot_r(), + "## Source Code", + source_code_r() + ) }) ### From 3646524c5a320646ade4194ef15d6d4579193504 Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 26 Feb 2025 15:58:34 +0100 Subject: [PATCH 10/35] specify dev versions + add Remotes for teal.widgets --- DESCRIPTION | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 357213475..78b27e782 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,7 +27,7 @@ Depends: ggplot2 (>= 3.4.0), R (>= 4.1), shiny (>= 1.6.0), - teal (>= 0.16.0), + teal (>= 0.16.0.9000), teal.transform (>= 0.6.0) Imports: checkmate (>= 2.1.0), @@ -60,8 +60,8 @@ Imports: teal.code (>= 0.6.0), teal.data (>= 0.7.0), teal.logger (>= 0.3.1), - teal.reporter (>= 0.4.0), - teal.widgets (>= 0.4.3), + teal.reporter (>= 0.4.0.9000), + teal.widgets (>= 0.4.3.9000), tern (>= 0.9.5), tibble (>= 2.0.0), tidyr (>= 0.8.3), @@ -81,6 +81,7 @@ Suggests: withr (>= 2.0.0) Remotes: insightsengineering/teal@redesign@main, + insightsengineering/teal.widgets@test@bslib@main, insightsengineering/teal.reporter@redesign@main VignetteBuilder: knitr, From 51d71b5dae21c4588a5b1599a5529c04a44b31c3 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 3 Mar 2025 12:47:27 +0100 Subject: [PATCH 11/35] return elements as rmarkdown --- R/tm_a_regression.R | 37 +++++++++++++++++++++++++++++++++++-- 1 file changed, 35 insertions(+), 2 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 52a746aed..dfbc651c4 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1036,10 +1036,13 @@ srv_a_regression <- function(id, card_fun <- reactive({ req(plot_r(), source_code_r()) teal.reporter::report_document( + "## Plot", - plot_r(), + plot_to_base64(plot_r()), "## Source Code", - source_code_r() + format_as_markdown_chunk(source_code_r()), + "## Table for testing", + knitr::kable(head(iris)) ) }) ### @@ -1049,3 +1052,33 @@ srv_a_regression <- function(id, ) }) } + + +plot_to_base64 <- function(plot, width = 5, height = 4, dpi = 100) { + # Temporary file to save the plot + tmpfile <- tempfile(fileext = ".png") + + # Save the plot as a PNG file + ggsave(tmpfile, plot = plot, width = width, height = height, dpi = dpi) + + # Read the binary data and encode as base64 + # base64enc::base64encode(tmpfile) + base64_string<- knitr::image_uri(tmpfile) + sprintf("![Plot](%s)", base64_string) +} +# +# plot_to_base64(qqplot(x = 1:2, y = 1:2)) + +format_as_markdown_chunk <- function(r_code) { + # Wrap the code inside a Markdown R chunk + sprintf("```{r}\n%s\n```", r_code) +} +# +# # Example usage: +# r_code <- "ggplot(mtcars, aes(x = wt, y = mpg)) +\n geom_point() +\n ggtitle('Scatter plot')" +# +# markdown_chunk <- format_as_markdown_chunk(r_code) +# +# # Print the Markdown-formatted output +# cat(markdown_chunk) + From 1f6899365e8ae61d942e0ff6ec44d4a4209d7161 Mon Sep 17 00:00:00 2001 From: m7pr Date: Tue, 4 Mar 2025 17:01:00 +0100 Subject: [PATCH 12/35] leave just R objects, let markdown formating be done in teal --- R/tm_a_regression.R | 30 ++---------------------------- 1 file changed, 2 insertions(+), 28 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index dfbc651c4..896025149 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1038,11 +1038,11 @@ srv_a_regression <- function(id, teal.reporter::report_document( "## Plot", - plot_to_base64(plot_r()), + plot_r(), "## Source Code", format_as_markdown_chunk(source_code_r()), "## Table for testing", - knitr::kable(head(iris)) + head(iris) ) }) ### @@ -1053,32 +1053,6 @@ srv_a_regression <- function(id, }) } - -plot_to_base64 <- function(plot, width = 5, height = 4, dpi = 100) { - # Temporary file to save the plot - tmpfile <- tempfile(fileext = ".png") - - # Save the plot as a PNG file - ggsave(tmpfile, plot = plot, width = width, height = height, dpi = dpi) - - # Read the binary data and encode as base64 - # base64enc::base64encode(tmpfile) - base64_string<- knitr::image_uri(tmpfile) - sprintf("![Plot](%s)", base64_string) -} -# -# plot_to_base64(qqplot(x = 1:2, y = 1:2)) - format_as_markdown_chunk <- function(r_code) { - # Wrap the code inside a Markdown R chunk sprintf("```{r}\n%s\n```", r_code) } -# -# # Example usage: -# r_code <- "ggplot(mtcars, aes(x = wt, y = mpg)) +\n geom_point() +\n ggtitle('Scatter plot')" -# -# markdown_chunk <- format_as_markdown_chunk(r_code) -# -# # Print the Markdown-formatted output -# cat(markdown_chunk) - From 0b0f6503768203c8c908f0d57d31b2dbfb5e87c9 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 6 Mar 2025 06:06:21 -0500 Subject: [PATCH 13/35] fix: update variable browser based on the new UI changes --- R/tm_variable_browser.R | 82 +++++++++++++++-------------------------- 1 file changed, 30 insertions(+), 52 deletions(-) diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index c2bfe5a34..09c1a06ae 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -141,24 +141,20 @@ ui_variable_browser <- function(id, post_output = NULL) { ns <- NS(id) - tagList( + tags$div( include_css_files("custom"), shinyjs::useShinyjs(), teal.widgets::standard_layout( - output = fluidRow( + output = tags$div( htmlwidgets::getDependency("sparkline"), # needed for sparklines to work - column( - 6, - # variable browser + bslib::layout_column_wrap( + width = 0.5, teal.widgets::white_small_well( uiOutput(ns("ui_variable_browser")), shinyjs::hidden({ checkboxInput(ns("show_parent_vars"), "Show parent dataset variables", value = FALSE) }) - ) - ), - column( - 6, + ), teal.widgets::white_small_well( ### Reporter teal.reporter::simple_reporter_ui(ns("simple_reporter")), @@ -331,41 +327,35 @@ srv_variable_browser <- function(id, varname <- plot_var$variable[[dataname]] df <- data()[[dataname]] - numeric_ui <- tagList( - fluidRow( - tags$div( - class = "col-md-4", - tags$br(), - shinyWidgets::switchInput( - inputId = session$ns("display_density"), - label = "Show density", + numeric_ui <- bslib::page_fluid( + bslib::layout_columns( + col_widths = c(8, 4), + bslib::layout_columns( + col_widths = c(6, 6, 12), + style = bslib::css(grid_row_gap = 0), + bslib::input_switch( + id = session$ns("display_density"), + label = tags$div( + "Show density:", + bslib::tooltip( + trigger = icon("circle-info"), + tags$span( + "Show kernel density estimation with gaussian kernel and bandwidth function bw.nrd0 (R default)" + ) + ) + ), value = `if`(is.null(isolate(input$display_density)), TRUE, isolate(input$display_density)), - width = "50%", - labelWidth = "100px", - handleWidth = "50px" - ) - ), - tags$div( - class = "col-md-4", - tags$br(), - shinyWidgets::switchInput( - inputId = session$ns("remove_outliers"), + width = "100%" + ), + bslib::input_switch( + id = session$ns("remove_outliers"), label = "Remove outliers", value = `if`(is.null(isolate(input$remove_outliers)), FALSE, isolate(input$remove_outliers)), - width = "50%", - labelWidth = "100px", - handleWidth = "50px" - ) + width = "100%" + ), + uiOutput(session$ns("ui_outlier_help")) ), - tags$div( - class = "col-md-4", - uiOutput(session$ns("outlier_definition_slider_ui")) - ) - ), - tags$div( - class = "ml-4", - uiOutput(session$ns("ui_density_help")), - uiOutput(session$ns("ui_outlier_help")) + uiOutput(session$ns("outlier_definition_slider_ui")) ) ) @@ -455,18 +445,6 @@ srv_variable_browser <- function(id, ) }) - output$ui_density_help <- renderUI({ - req(is.logical(input$display_density)) - if (input$display_density) { - tags$small(helpText(paste( - "Kernel density estimation with gaussian kernel", - "and bandwidth function bw.nrd0 (R default)" - ))) - } else { - NULL - } - }) - output$ui_outlier_help <- renderUI({ req(is.logical(input$remove_outliers), input$outlier_definition_slider) if (input$remove_outliers) { From a4ee0047d2f5edfc05065aba9ee9c0d72d7b204a Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 6 Mar 2025 09:38:51 -0500 Subject: [PATCH 14/35] feat: ui changes --- R/tm_data_table.R | 40 +++++++++++------------------ R/tm_g_bivariate.R | 14 ++++++++--- R/tm_missing_data.R | 56 +++++++++++++++-------------------------- R/tm_variable_browser.R | 45 ++++++++++++--------------------- 4 files changed, 62 insertions(+), 93 deletions(-) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index ea26d182a..603f41c3f 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -161,22 +161,15 @@ ui_page_data_table <- function(id, pre_output = NULL, post_output = NULL) { include_css_files("custom"), teal.widgets::standard_layout( output = teal.widgets::white_small_well( - fluidRow( - column( - width = 12, - checkboxInput( - ns("if_distinct"), - "Show only distinct rows:", - value = FALSE - ) + bslib::page_fluid( + checkboxInput( + ns("if_distinct"), + "Show only distinct rows:", + value = FALSE ) ), - fluidRow( - class = "mb-8", - column( - width = 12, - uiOutput(ns("dataset_table")) - ) + bslib::page_fluid( + uiOutput(ns("dataset_table")) ) ), pre_output = pre_output, @@ -233,15 +226,12 @@ srv_page_data_table <- function(id, } tabPanel( title = x, - column( - width = 12, - div( - class = "mt-4", - ui_data_table( - id = session$ns(x), - choices = choices, - selected = variables_selected - ) + bslib::layout_columns( + col_widths = 12, + ui_data_table( + id = session$ns(x), + choices = choices, + selected = variables_selected ) ) ) @@ -281,7 +271,7 @@ ui_data_table <- function(id, choices, selected) { tagList( teal.widgets::get_dt_rows(ns("data_table"), ns("dt_rows")), - fluidRow( + bslib::page_fluid( teal.widgets::optionalSelectInput( ns("variables"), "Select variables:", @@ -291,7 +281,7 @@ ui_data_table <- function(id, choices, selected) { width = "100%" ) ), - fluidRow( + bslib::page_fluid( DT::dataTableOutput(ns("data_table"), width = "100%") ) ) diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 46b769f9e..9cb9e5e2b 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -372,8 +372,12 @@ ui_g_bivariate <- function(id, ...) { if (!is.null(args$row_facet) || !is.null(args$col_facet)) { tags$div( class = "data-extract-box", - tags$label("Facetting"), - shinyWidgets::switchInput(inputId = ns("facetting"), value = args$facet, size = "mini"), + tags$br(), + bslib::input_switch( + id = ns("facetting"), + label = "Facetting", + value = args$facet + ), conditionalPanel( condition = paste0("input['", ns("facetting"), "']"), tags$div( @@ -404,7 +408,11 @@ ui_g_bivariate <- function(id, ...) { tags$div( class = "data-extract-box", tags$label("Color settings"), - shinyWidgets::switchInput(inputId = ns("coloring"), value = TRUE, size = "mini"), + bslib::input_switch( + id = ns("coloring"), + label = "Color settings", + value = TRUE + ), conditionalPanel( condition = paste0("input['", ns("coloring"), "']"), tags$div( diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R index a35811404..a295d9b75 100644 --- a/R/tm_missing_data.R +++ b/R/tm_missing_data.R @@ -186,13 +186,7 @@ ui_page_missing_data <- function(id, pre_output = NULL, post_output = NULL) { include_css_files("custom"), teal.widgets::standard_layout( output = teal.widgets::white_small_well( - tags$div( - class = "flex", - column( - width = 12, - uiOutput(ns("dataset_tabs")) - ) - ) + uiOutput(ns("dataset_tabs")) ), encoding = tags$div( uiOutput(ns("dataset_encodings")) @@ -230,13 +224,7 @@ srv_page_missing_data <- function(id, data, reporter, filter_panel_api, dataname function(x) { tabPanel( title = x, - column( - width = 12, - tags$div( - class = "mt-4", - ui_missing_data(id = ns(x), by_subject_plot = if_subject_plot) - ) - ) + ui_missing_data(id = ns(x), by_subject_plot = if_subject_plot) ) } ) @@ -389,34 +377,30 @@ encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, data ), conditionalPanel( is_tab_active_js(ns("summary_type"), "Summary"), - checkboxInput( - ns("any_na"), - tags$div( - tagList( - "Add **anyna** variable", - bslib::tooltip( - icon("circle-info"), - tags$span( - "Describes the number of observations with at least one missing value in any variable." - ) + bslib::input_switch( + id = ns("any_na"), + label = tags$div( + HTML("Add anyna variable"), + bslib::tooltip( + icon("circle-info"), + tags$span( + "Describes the number of observations with at least one missing value in any variable." ) ) ), value = FALSE ), if (summary_per_patient) { - checkboxInput( - ns("if_patients_plot"), - tags$div( - tagList( - "Add summary per patients", - bslib::tooltip( - icon("circle-info"), - tags$span( - paste( - "Displays the number of missing values per observation,", - "where the x-axis is sorted by observation appearance in the table." - ) + bslib::input_switch( + id = ns("if_patients_plot"), + label = tags$div( + "Add summary per patients", + bslib::tooltip( + icon("circle-info"), + tags$span( + paste( + "Displays the number of missing values per observation,", + "where the x-axis is sorted by observation appearance in the table." ) ) ) diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index 09c1a06ae..8b04746c7 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -156,20 +156,11 @@ ui_variable_browser <- function(id, }) ), teal.widgets::white_small_well( - ### Reporter teal.reporter::simple_reporter_ui(ns("simple_reporter")), - ### - tags$div( - class = "block", - uiOutput(ns("ui_histogram_display")) - ), - tags$div( - class = "block", - uiOutput(ns("ui_numeric_display")) - ), + uiOutput(ns("ui_histogram_display")), + uiOutput(ns("ui_numeric_display")), teal.widgets::plot_with_settings_ui(ns("variable_plot")), tags$br(), - # input user-defined text size teal.widgets::panel_item( title = "Plot settings", collapsed = TRUE, @@ -178,15 +169,16 @@ ui_variable_browser <- function(id, choices = ggplot_themes, selected = "grey" ), - fluidRow( - column(6, sliderInput( + bslib::layout_columns( + col_widths = c(6, 6), + sliderInput( inputId = ns("font_size"), label = "font size", min = 5L, max = 30L, value = 15L, step = 1L, ticks = FALSE - )), - column(6, sliderInput( + ), + sliderInput( inputId = ns("label_rotation"), label = "rotate x labels", min = 0L, max = 90L, value = 45L, step = 1, ticks = FALSE - )) + ) ) ), tags$br(), @@ -392,19 +384,14 @@ srv_variable_browser <- function(id, varname <- plot_var$variable[[dataname]] df <- data()[[dataname]] - numeric_ui <- tagList(fluidRow( - tags$div( - class = "col-md-4", - shinyWidgets::switchInput( - inputId = session$ns("remove_NA_hist"), - label = "Remove NA values", - value = FALSE, - width = "50%", - labelWidth = "100px", - handleWidth = "50px" - ) - ) - )) + numeric_ui <- shinyWidgets::switchInput( + inputId = session$ns("remove_NA_hist"), + label = "Remove NA values", + value = FALSE, + width = "50%", + labelWidth = "100px", + handleWidth = "50px" + ) var <- df[[varname]] if (anyNA(var) && (is.factor(var) || is.character(var) || is.logical(var))) { From 439bbc88dbec37cf8364fe1cfa62faeab6189857 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 6 Mar 2025 16:45:23 -0500 Subject: [PATCH 15/35] fix ci --- R/tm_variable_browser.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index 8b04746c7..5decf4a0e 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -1110,7 +1110,7 @@ create_sparklines.numeric <- function(arr, width = 150, ...) { #' @keywords internal #' @export create_sparklines.character <- function(arr, ...) { - return(create_sparklines(as.factor(arr))) + create_sparklines(as.factor(arr)) } From 242323931ce115c6605e30decc71a56c2a348a77 Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 7 Mar 2025 06:25:45 -0500 Subject: [PATCH 16/35] fix: replace deprecated function calls with bslib calls --- R/tm_a_pca.R | 13 ++-- R/tm_a_regression.R | 5 +- R/tm_g_association.R | 5 +- R/tm_g_bivariate.R | 5 +- R/tm_g_distribution.R | 77 +++++++++---------- R/tm_g_response.R | 5 +- R/tm_g_scatterplot.R | 5 +- R/tm_g_scatterplotmatrix.R | 5 +- R/tm_missing_data.R | 18 +++-- R/tm_outliers.R | 7 +- R/tm_t_crosstable.R | 5 +- R/tm_variable_browser.R | 35 +++++---- .../test-shinytest2-tm_g_association.R | 2 +- 13 files changed, 99 insertions(+), 88 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 7227856f1..0afea8f76 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -246,10 +246,10 @@ ui_a_pca <- function(id, ...) { data_extract_spec = args$dat, is_single_dataset = is_single_dataset_value ), - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Display", - collapsed = FALSE, checkboxGroupInput( ns("tables_display"), "Tables display", @@ -291,7 +291,7 @@ ui_a_pca <- function(id, ...) { ) ) ), - teal.widgets::panel_item( + bslib::accordion_panel( title = "Pre-processing", radioButtons( ns("standardization"), "Standardization", @@ -304,9 +304,8 @@ ui_a_pca <- function(id, ...) { selected = "none" ) ), - teal.widgets::panel_item( + bslib::accordion_panel( title = "Selected plot specific settings", - collapsed = FALSE, uiOutput(ns("plot_settings")), conditionalPanel( condition = sprintf("input['%s'] == 'Biplot'", ns("plot_type")), @@ -322,7 +321,7 @@ ui_a_pca <- function(id, ...) { ) ) ), - teal.widgets::panel_item( + bslib::accordion_panel( title = "Plot settings", collapsed = TRUE, conditionalPanel( diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 146239d87..b340386c1 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -336,8 +336,9 @@ ui_a_regression <- function(id, ...) { ) ), ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Plot settings", teal.widgets::optionalSliderInputValMinMax(ns("alpha"), "Opacity:", args$alpha, ticks = FALSE), teal.widgets::optionalSliderInputValMinMax(ns("size"), "Points size:", args$size, ticks = FALSE), diff --git a/R/tm_g_association.R b/R/tm_g_association.R index 637364fce..0c75593f4 100644 --- a/R/tm_g_association.R +++ b/R/tm_g_association.R @@ -265,8 +265,9 @@ ui_tm_g_association <- function(id, ...) { value = FALSE ), ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Plot settings", teal.widgets::optionalSliderInputValMinMax(ns("alpha"), "Scatterplot opacity:", c(0.5, 0, 1), ticks = FALSE), teal.widgets::optionalSliderInputValMinMax(ns("size"), "Scatterplot points size:", c(2, 1, 8), ticks = FALSE), diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 9cb9e5e2b..c7e752c73 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -441,8 +441,9 @@ ui_g_bivariate <- function(id, ...) { ) ) }, - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Plot settings", checkboxInput(ns("rotate_xaxis_labels"), "Rotate X axis labels", value = args$rotate_xaxis_labels), checkboxInput(ns("swap_axes"), "Swap axes", value = args$swap_axes), diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R index 3ffc7bbdc..15c1f1337 100644 --- a/R/tm_g_distribution.R +++ b/R/tm_g_distribution.R @@ -288,10 +288,10 @@ ui_distribution <- function(id, ...) { is_single_dataset = is_single_dataset_value ) }, - teal.widgets::panel_group( + bslib::accordion( conditionalPanel( condition = paste0("input['", ns("tabs"), "'] == 'Histogram'"), - teal.widgets::panel_item( + bslib::accordion_panel( "Histogram", teal.widgets::optionalSliderInputValMinMax(ns("bins"), "Bins", args$bins, ticks = FALSE, step = 1), shinyWidgets::prettyRadioButtons( @@ -306,13 +306,12 @@ ui_distribution <- function(id, ...) { ui_decorate_teal_data( ns("d_density"), decorators = select_decorators(args$decorators, "histogram_plot") - ), - collapsed = FALSE + ) ) ), conditionalPanel( condition = paste0("input['", ns("tabs"), "'] == 'QQplot'"), - teal.widgets::panel_item( + bslib::accordion_panel( "QQ Plot", checkboxInput(ns("qq_line"), label = "Add diagonal line(s)", TRUE), ui_decorate_teal_data( @@ -332,7 +331,7 @@ ui_distribution <- function(id, ...) { ), conditionalPanel( condition = paste0("input['", ns("main_type"), "'] == 'Density'"), - teal.widgets::panel_item( + bslib::accordion_panel( "Theoretical Distribution", teal.widgets::optionalSelectInput( ns("t_dist"), @@ -356,39 +355,39 @@ ui_distribution <- function(id, ...) { tags$span(actionButton(ns("params_reset"), "Default params")), collapsed = FALSE ) - ) - ), - teal.widgets::panel_item( - "Tests", - teal.widgets::optionalSelectInput( - ns("dist_tests"), - "Tests:", - choices = c( - "Shapiro-Wilk", - if (!is.null(args$strata_var)) "t-test (two-samples, not paired)", - if (!is.null(args$strata_var)) "one-way ANOVA", - if (!is.null(args$strata_var)) "Fligner-Killeen", - if (!is.null(args$strata_var)) "F-test", - "Kolmogorov-Smirnov (one-sample)", - "Anderson-Darling (one-sample)", - "Cramer-von Mises (one-sample)", - if (!is.null(args$strata_var)) "Kolmogorov-Smirnov (two-samples)" - ), - selected = NULL - ) - ), - teal.widgets::panel_item( - "Statistics Table", - sliderInput(ns("roundn"), "Round to n digits", min = 0, max = 10, value = 2) - ), - teal.widgets::panel_item( - title = "Plot settings", - selectInput( - inputId = ns("ggtheme"), - label = "Theme (by ggplot):", - choices = ggplot_themes, - selected = args$ggtheme, - multiple = FALSE + ), + bslib::accordion_panel( + title = "Tests", + teal.widgets::optionalSelectInput( + ns("dist_tests"), + "Tests:", + choices = c( + "Shapiro-Wilk", + if (!is.null(args$strata_var)) "t-test (two-samples, not paired)", + if (!is.null(args$strata_var)) "one-way ANOVA", + if (!is.null(args$strata_var)) "Fligner-Killeen", + if (!is.null(args$strata_var)) "F-test", + "Kolmogorov-Smirnov (one-sample)", + "Anderson-Darling (one-sample)", + "Cramer-von Mises (one-sample)", + if (!is.null(args$strata_var)) "Kolmogorov-Smirnov (two-samples)" + ), + selected = NULL + ) + ), + bslib::accordion_panel( + title = "Statistics Table", + sliderInput(ns("roundn"), "Round to n digits", min = 0, max = 10, value = 2) + ), + bslib::accordion_panel( + title = "Plot settings", + selectInput( + inputId = ns("ggtheme"), + label = "Theme (by ggplot):", + choices = ggplot_themes, + selected = args$ggtheme, + multiple = FALSE + ) ) ) ), diff --git a/R/tm_g_response.R b/R/tm_g_response.R index c833d1bd3..bb678a984 100644 --- a/R/tm_g_response.R +++ b/R/tm_g_response.R @@ -304,8 +304,9 @@ ui_g_response <- function(id, ...) { justified = TRUE ), ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Plot settings", checkboxInput(ns("count_labels"), "Add count labels", value = args$count_labels), checkboxInput(ns("coord_flip"), "Swap axes", value = args$coord_flip), diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index e9c8ce3c6..9d1f78974 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -441,8 +441,9 @@ ui_g_scatterplot <- function(id, ...) { ) }, ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Plot settings", teal.widgets::optionalSliderInputValMinMax(ns("alpha"), "Opacity:", args$alpha, ticks = FALSE), teal.widgets::optionalSelectInput( diff --git a/R/tm_g_scatterplotmatrix.R b/R/tm_g_scatterplotmatrix.R index e4eddb7cd..9ea6b6301 100644 --- a/R/tm_g_scatterplotmatrix.R +++ b/R/tm_g_scatterplotmatrix.R @@ -264,8 +264,9 @@ ui_g_scatterplotmatrix <- function(id, ...) { ), tags$hr(), ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Plot settings", sliderInput( ns("alpha"), "Opacity:", diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R index a295d9b75..0e1cd859e 100644 --- a/R/tm_missing_data.R +++ b/R/tm_missing_data.R @@ -432,14 +432,16 @@ encoding_missing_data <- function(id, summary_per_patient = FALSE, ggtheme, data ), ui_decorate_teal_data(ns("dec_summary_table"), decorators = select_decorators(decorators, "table")) ), - teal.widgets::panel_item( - title = "Plot settings", - selectInput( - inputId = ns("ggtheme"), - label = "Theme (by ggplot):", - choices = ggplot_themes, - selected = ggtheme, - multiple = FALSE + bslib::accordion( + bslib::accordion_panel( + title = "Plot settings", + selectInput( + inputId = ns("ggtheme"), + label = "Theme (by ggplot):", + choices = ggplot_themes, + selected = ggtheme, + multiple = FALSE + ) ) ) ) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index e9ee4036d..55db0bdd6 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -292,8 +292,9 @@ ui_outliers <- function(id, ...) { ), shinyjs::hidden(checkboxInput(ns("split_outliers"), "Define outliers based on group splitting", value = FALSE)), shinyjs::hidden(checkboxInput(ns("order_by_outlier"), "Re-order categories by outliers [by %]", value = FALSE)), - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Method parameters", collapsed = FALSE, teal.widgets::optionalSelectInput( @@ -364,7 +365,7 @@ ui_outliers <- function(id, ...) { ) ), ui_decorate_teal_data(ns("d_table"), decorators = select_decorators(args$decorators, "table")), - teal.widgets::panel_item( + bslib::accordion_panel( title = "Plot settings", selectInput( inputId = ns("ggtheme"), diff --git a/R/tm_t_crosstable.R b/R/tm_t_crosstable.R index c2ae8ae8a..361db29e4 100644 --- a/R/tm_t_crosstable.R +++ b/R/tm_t_crosstable.R @@ -240,8 +240,9 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p multiple = FALSE ), tags$hr(), - teal.widgets::panel_group( - teal.widgets::panel_item( + bslib::accordion( + open = TRUE, + bslib::accordion_panel( title = "Table settings", checkboxInput(ns("show_percentage"), "Show column percentage", value = show_percentage), checkboxInput(ns("show_total"), "Show total column", value = show_total) diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index 5decf4a0e..c6819fadb 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -161,23 +161,26 @@ ui_variable_browser <- function(id, uiOutput(ns("ui_numeric_display")), teal.widgets::plot_with_settings_ui(ns("variable_plot")), tags$br(), - teal.widgets::panel_item( - title = "Plot settings", - collapsed = TRUE, - selectInput( - inputId = ns("ggplot_theme"), label = "ggplot2 theme", - choices = ggplot_themes, - selected = "grey" - ), - bslib::layout_columns( - col_widths = c(6, 6), - sliderInput( - inputId = ns("font_size"), label = "font size", - min = 5L, max = 30L, value = 15L, step = 1L, ticks = FALSE + bslib::accordion( + open = TRUE, + bslib::accordion_panel( + title = "Plot settings", + collapsed = TRUE, + selectInput( + inputId = ns("ggplot_theme"), label = "ggplot2 theme", + choices = ggplot_themes, + selected = "grey" ), - sliderInput( - inputId = ns("label_rotation"), label = "rotate x labels", - min = 0L, max = 90L, value = 45L, step = 1, ticks = FALSE + bslib::layout_columns( + col_widths = c(6, 6), + sliderInput( + inputId = ns("font_size"), label = "font size", + min = 5L, max = 30L, value = 15L, step = 1L, ticks = FALSE + ), + sliderInput( + inputId = ns("label_rotation"), label = "rotate x labels", + min = 0L, max = 90L, value = 45L, step = 1, ticks = FALSE + ) ) ) ), diff --git a/tests/testthat/test-shinytest2-tm_g_association.R b/tests/testthat/test-shinytest2-tm_g_association.R index b1ac33d87..903a07c6c 100644 --- a/tests/testthat/test-shinytest2-tm_g_association.R +++ b/tests/testthat/test-shinytest2-tm_g_association.R @@ -51,7 +51,7 @@ testthat::test_that("e2e - tm_g_association: Data parameter and module label is app_driver$expect_no_shiny_error() testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab li a.active"), "Association" ) From a61d664eb2db61ea6a2d30ba3a6b4a7806f4f0b0 Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 7 Mar 2025 11:41:08 -0500 Subject: [PATCH 17/35] test: fix e2e tests --- .../testthat/test-shinytest2-tm_a_regression.R | 2 +- tests/testthat/test-shinytest2-tm_data_table.R | 2 +- tests/testthat/test-shinytest2-tm_file_viewer.R | 8 ++++---- tests/testthat/test-shinytest2-tm_front_page.R | 8 ++++---- .../test-shinytest2-tm_g_scatterplotmatrix.R | 6 ++++-- .../testthat/test-shinytest2-tm_misssing_data.R | 17 +++++++++++++---- tests/testthat/test-shinytest2-tm_outliers.R | 2 +- .../testthat/test-shinytest2-tm_t_crosstable.R | 2 +- .../test-shinytest2-tm_variable_browser.R | 15 +++++++++------ 9 files changed, 38 insertions(+), 24 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_a_regression.R b/tests/testthat/test-shinytest2-tm_a_regression.R index 143956043..eca2099f1 100644 --- a/tests/testthat/test-shinytest2-tm_a_regression.R +++ b/tests/testthat/test-shinytest2-tm_a_regression.R @@ -52,7 +52,7 @@ testthat::test_that("e2e - tm_a_regression: Data parameter and module label is p app_driver$expect_no_shiny_error() testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab .active"), "Regression" ) diff --git a/tests/testthat/test-shinytest2-tm_data_table.R b/tests/testthat/test-shinytest2-tm_data_table.R index 1b4bf3217..260300460 100644 --- a/tests/testthat/test-shinytest2-tm_data_table.R +++ b/tests/testthat/test-shinytest2-tm_data_table.R @@ -27,7 +27,7 @@ test_that("e2e - tm_data_table: Initializes without errors", { app_driver$expect_no_shiny_error() testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab .active"), "Data Table" ) diff --git a/tests/testthat/test-shinytest2-tm_file_viewer.R b/tests/testthat/test-shinytest2-tm_file_viewer.R index 7a6eb12c6..32c906507 100644 --- a/tests/testthat/test-shinytest2-tm_file_viewer.R +++ b/tests/testthat/test-shinytest2-tm_file_viewer.R @@ -34,7 +34,7 @@ test_that("e2e - tm_file_viewer: Initializes without errors and shows files tree ) testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab .active"), "File Viewer Module" ) @@ -46,7 +46,7 @@ test_that("e2e - tm_file_viewer: Shows selected image file", { app_driver <- app_driver_tm_file_viewer() app_driver$click(selector = "[id= '4_anchor']") - testthat::expect_true(app_driver$is_visible(selector = app_driver$active_module_element("output"))) + testthat::expect_true(app_driver$is_visible(sprintf("%s img", app_driver$active_module_element("output")))) img_src <- app_driver$get_html_rvest(app_driver$active_module_element("output")) %>% rvest::html_element("img") %>% @@ -62,7 +62,7 @@ test_that("e2e - tm_file_viewer: Shows selected text file", { app_driver <- app_driver_tm_file_viewer() app_driver$click(selector = "[id= '5_anchor']") - testthat::expect_true(app_driver$is_visible(selector = app_driver$active_module_element("output"))) + testthat::expect_true(app_driver$is_visible(sprintf("%s pre", app_driver$active_module_element("output")))) pre_text <- app_driver$get_html_rvest(app_driver$active_module_element("output")) %>% rvest::html_element("pre") %>% @@ -84,7 +84,7 @@ test_that("e2e - tm_file_viewer: Shows selected url", { app_driver <- app_driver_tm_file_viewer() app_driver$click(selector = "[id= '6_anchor']") - testthat::expect_true(app_driver$is_visible(selector = app_driver$active_module_element("output"))) + testthat::expect_true(app_driver$is_visible(sprintf("%s img", app_driver$active_module_element("output")))) testthat::expect_equal( attr(app_driver$get_active_module_input("tree")$url, "ancestry"), diff --git a/tests/testthat/test-shinytest2-tm_front_page.R b/tests/testthat/test-shinytest2-tm_front_page.R index fb1803e49..af7978d74 100644 --- a/tests/testthat/test-shinytest2-tm_front_page.R +++ b/tests/testthat/test-shinytest2-tm_front_page.R @@ -28,7 +28,7 @@ test_that("e2e - tm_front_page: Initializes without errors and check html elemen app_driver$expect_no_shiny_error() testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab .active"), "Front page" ) @@ -50,10 +50,10 @@ test_that("e2e - tm_front_page: Verify the module displays tables", { app_driver <- app_driver_tm_front_page() # tables testthat::expect_match(app_driver$get_active_module_output("table_1"), "MTCARS") - testthat::expect_true(app_driver$is_visible(selector = app_driver$active_module_element("table_1"))) + testthat::expect_true(app_driver$is_visible(sprintf("%s table", app_driver$active_module_element("table_1")))) testthat::expect_match(app_driver$get_active_module_output("table_2"), "IRIS") - testthat::expect_true(app_driver$is_visible(selector = app_driver$active_module_element("table_2"))) + testthat::expect_true(app_driver$is_visible(sprintf("%s table", app_driver$active_module_element("table_2")))) app_driver$stop() }) @@ -63,7 +63,7 @@ test_that("e2e - tm_front_page: Verify the module displays metadata", { # show metadata app_driver$click(NS(app_driver$active_module_ns(), "metadata_button")) - testthat::expect_true(app_driver$is_visible(selector = app_driver$active_module_element("metadata_table"))) + testthat::expect_true(app_driver$is_visible(sprintf("%s table", app_driver$active_module_element("metadata_table")))) app_driver$stop() }) diff --git a/tests/testthat/test-shinytest2-tm_g_scatterplotmatrix.R b/tests/testthat/test-shinytest2-tm_g_scatterplotmatrix.R index 429e67b41..7fe7c3b12 100644 --- a/tests/testthat/test-shinytest2-tm_g_scatterplotmatrix.R +++ b/tests/testthat/test-shinytest2-tm_g_scatterplotmatrix.R @@ -51,7 +51,7 @@ test_that("e2e - tm_g_scatterplotmatrix: Initializes without errors", { app_driver$expect_no_shiny_error() testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab .active"), "Scatterplot matrix" ) @@ -66,7 +66,9 @@ test_that("e2e - tm_g_scatterplotmatrix: Verify module displays data table", { app_driver <- app_driver_tm_g_scatterplotmatrix() # table - testthat::expect_true(app_driver$is_visible(selector = app_driver$active_module_element("myplot-plot_out_main"))) + testthat::expect_true( + app_driver$is_visible(sprintf("%s .shiny-plot-output", app_driver$active_module_element("myplot-plot_out_main"))) + ) app_driver$stop() }) diff --git a/tests/testthat/test-shinytest2-tm_misssing_data.R b/tests/testthat/test-shinytest2-tm_misssing_data.R index d1eba587a..65c4fdf64 100644 --- a/tests/testthat/test-shinytest2-tm_misssing_data.R +++ b/tests/testthat/test-shinytest2-tm_misssing_data.R @@ -42,7 +42,7 @@ test_that("e2e - tm_missing_data: Initializes without errors", { app_driver$expect_no_shiny_error() testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab .active"), "Missing data" ) @@ -78,7 +78,10 @@ test_that("e2e - tm_missing_data: Default settings and visibility of the summary testthat::expect_true( app_driver$is_visible( - app_driver$active_module_element("iris-summary_plot-plot_out_main") + sprintf( + "%s .shiny-plot-output", + app_driver$active_module_element("iris-summary_plot-plot_out_main") + ) ) ) @@ -97,7 +100,10 @@ test_that("e2e - tm_missing_data: Check default settings and visibility of the c app_driver$expect_no_validation_error() testthat::expect_true( app_driver$is_visible( - app_driver$active_module_element("iris-combination_plot-plot_out_main") + sprintf( + "%s .shiny-plot-output", + app_driver$active_module_element("iris-combination_plot-plot_out_main") + ) ) ) @@ -105,7 +111,10 @@ test_that("e2e - tm_missing_data: Check default settings and visibility of the c testthat::expect_true( app_driver$is_visible( - app_driver$active_module_element("iris-cutoff") + sprintf( + "%s .shiny-input-container", + app_driver$active_module_element("iris-cutoff") + ) ) ) diff --git a/tests/testthat/test-shinytest2-tm_outliers.R b/tests/testthat/test-shinytest2-tm_outliers.R index a0b3a206e..7330af226 100644 --- a/tests/testthat/test-shinytest2-tm_outliers.R +++ b/tests/testthat/test-shinytest2-tm_outliers.R @@ -55,7 +55,7 @@ testthat::test_that("e2e - tm_outliers: Data parameter and module label is passe app_driver$expect_no_shiny_error() testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab .active"), "Outliers Module" ) diff --git a/tests/testthat/test-shinytest2-tm_t_crosstable.R b/tests/testthat/test-shinytest2-tm_t_crosstable.R index 8c55b365d..81dc831fc 100644 --- a/tests/testthat/test-shinytest2-tm_t_crosstable.R +++ b/tests/testthat/test-shinytest2-tm_t_crosstable.R @@ -50,7 +50,7 @@ test_that("e2e - tm_t_crosstable: Initializes without errors", { app_driver$expect_no_shiny_error() testthat::expect_equal( - app_driver$get_text("#teal-teal_modules-active_tab > li.active > a"), + app_driver$get_text("#teal-teal_modules-active_tab .active"), "Cross Table" ) diff --git a/tests/testthat/test-shinytest2-tm_variable_browser.R b/tests/testthat/test-shinytest2-tm_variable_browser.R index 76b26b04e..a2c58cf5d 100644 --- a/tests/testthat/test-shinytest2-tm_variable_browser.R +++ b/tests/testthat/test-shinytest2-tm_variable_browser.R @@ -35,13 +35,18 @@ testthat::test_that("e2e - tm_variable_browser: content is displayed correctly." # Test tab name testthat::expect_equal( - trimws(app_driver$get_text("#teal-teal_modules-active_tab > li.active")), + trimws(app_driver$get_text("#teal-teal_modules-active_tab .active")), "Variable browser (e2e)" ) # Plot is visible testthat::expect_true( - app_driver$is_visible(app_driver$active_module_element("variable_plot-plot_out_main")) + app_driver$is_visible( + sprintf( + "%s .shiny-plot-output", + app_driver$active_module_element("variable_plot-plot_out_main") + ) + ) ) # All datanames are available on the left sidebar @@ -68,7 +73,7 @@ testthat::test_that("e2e - tm_variable_browser: Selecting 'treat variable as fac # Categorical type have levels table in main output current_var <- trimws(app_driver$get_text( - sprintf("%s .nav li.active", app_driver$active_module_element("ui_variable_browser")) + sprintf("%s li .active", app_driver$active_module_element("ui_variable_browser")) )) app_driver$set_active_module_input( @@ -100,7 +105,7 @@ testthat::test_that("e2e - tm_variable_browser: selection of categorical variabl # Categorical type have levels table in main output current_var <- trimws(app_driver$get_text( - sprintf("%s .nav li.active", app_driver$active_module_element("ui_variable_browser")) + sprintf("%s li .active", app_driver$active_module_element("ui_variable_browser")) )) categorical_selector <- app_driver$active_module_element( @@ -195,8 +200,6 @@ testthat::test_that("e2e - tm_variable_browser: changing plot setting encodings app_driver <- app_driver_tm_variable_browser() # Test changing plot settings - testthat::expect_false(app_driver$is_visible(app_driver$active_module_element("ggplot_theme-selectized"))) - app_driver$set_active_module_input("ggplot_theme", "bw") app_driver$expect_no_validation_error() app_driver$set_active_module_input("ggplot_theme", "light") From 21e6477310b798c8758f99249561ac47d4134ee5 Mon Sep 17 00:00:00 2001 From: vedhav Date: Fri, 7 Mar 2025 11:44:22 -0500 Subject: [PATCH 18/35] chore: remove explicit return --- tests/testthat/test-shinytest2-tm_t_crosstable.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-shinytest2-tm_t_crosstable.R b/tests/testthat/test-shinytest2-tm_t_crosstable.R index 81dc831fc..e423f9ab0 100644 --- a/tests/testthat/test-shinytest2-tm_t_crosstable.R +++ b/tests/testthat/test-shinytest2-tm_t_crosstable.R @@ -10,7 +10,7 @@ app_driver_tm_t_crosstable <- function() { label = "Select variable:", choices = teal.transform::variable_choices(data[["ADSL"]], subset = function(data) { idx <- !vapply(data, inherits, logical(1), c("Date", "POSIXct", "POSIXlt")) - return(names(data)[idx]) + names(data)[idx] }), selected = "COUNTRY", multiple = TRUE, @@ -24,7 +24,7 @@ app_driver_tm_t_crosstable <- function() { label = "Select variable:", choices = teal.transform::variable_choices(data[["ADSL"]], subset = function(data) { idx <- vapply(data, is.factor, logical(1)) - return(names(data)[idx]) + names(data)[idx] }), selected = "SEX", multiple = FALSE, From e804ca5ae53fae038fd19316e61d217dadbe953a Mon Sep 17 00:00:00 2001 From: m7pr Date: Sun, 9 Mar 2025 17:26:02 +0100 Subject: [PATCH 19/35] use teal.reporter::code_chunk --- R/tm_a_regression.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index ba75cb7ec..44f1f7e5e 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1038,7 +1038,7 @@ srv_a_regression <- function(id, "## Plot", plot_r(), "## Source Code", - format_as_markdown_chunk(source_code_r()), + teal.reporter::code_chunk(source_code_r()), "## Table for testing", head(iris) ) @@ -1050,7 +1050,3 @@ srv_a_regression <- function(id, ) }) } - -format_as_markdown_chunk <- function(r_code) { - sprintf("```{r}\n%s\n```", r_code) -} From 9c16a21ed34509a3d483f8a2f0cd005f13bbb81d Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 14 Mar 2025 13:17:49 +0100 Subject: [PATCH 20/35] divide the code into sections, related to the process flow --- R/tm_a_regression.R | 45 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 43 insertions(+), 2 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 3cad2fcb8..fa0219252 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -469,6 +469,7 @@ srv_a_regression <- function(id, teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) + # sets qenv object and populates it with data merge call and fit expression fit_r <- reactive({ ANL <- anl_merged_q()[["ANL"]] @@ -1023,6 +1024,32 @@ srv_a_regression <- function(id, }) # Render R code. + subset_code <- function(code, data) { + gsub(code, "", teal.data::get_code(data), fixed = TRUE) + } + setup_code_r <- reactive(teal.data::get_code(qenv)) + data_prep_code_r <- + reactive( + subset_code( + setup_code_r(), + req(anl_merged_q()) + ) + ) + fit_code_r <- + reactive( + subset_code( + paste0(setup_code_r(), data_prep_code_r()), + req(fit_r()) + ) + ) + plot_code_r <- + reactive( + subset_code( + paste0(setup_code_r(), data_prep_code_r(), fit_code_r()), + req(decorated_output_q()) + ) + ) + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) teal.widgets::verbatim_popup_srv( @@ -1036,10 +1063,24 @@ srv_a_regression <- function(id, req(plot_r(), source_code_r()) teal.reporter::report_document( + "## Setup", + teal.reporter::code_chunk(setup_code_r()), + + "## Data Preparations", + teal.reporter::code_chunk(data_prep_code_r()), + + "## Model", + teal.reporter::code_chunk(fit_code_r()), + teal.reporter::code_output( + paste(utils::capture.output(summary(teal.code::dev_suppress(fitted())))[-1], + collapse = "\n" + ) + ), + "## Plot", + teal.reporter::code_chunk(plot_code_r() |> styler::style_text() |> paste(collapse = "\n")), #|> teal.reporter::link_output(plot_r()), plot_r(), - "## Source Code", - teal.reporter::code_chunk(source_code_r()), + "## Table for testing", head(iris) ) From ea330268ca4108a8d5caa58eeb8690eab7314e54 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 17 Mar 2025 18:33:57 +0100 Subject: [PATCH 21/35] link objects in tmg --- R/tm_a_regression.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index fa0219252..029df340a 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1060,7 +1060,7 @@ srv_a_regression <- function(id, ### REPORTER card_fun <- reactive({ - req(plot_r(), source_code_r()) + req(plot_r(), plot_code_r(), setup_code_r(), data_prep_code_r(), fit_code_r(), fitted()) teal.reporter::report_document( "## Setup", @@ -1078,8 +1078,10 @@ srv_a_regression <- function(id, ), "## Plot", - teal.reporter::code_chunk(plot_code_r() |> styler::style_text() |> paste(collapse = "\n")), #|> teal.reporter::link_output(plot_r()), - plot_r(), + teal.reporter::code_chunk( + plot_code_r() |> styler::style_text() |> paste(collapse = "\n") + ) |> + teal.reporter::link_output(plot_r()), "## Table for testing", head(iris) From a508a36beaa34224cd10732ef66ffa1a142b0a72 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 17 Mar 2025 18:35:18 +0100 Subject: [PATCH 22/35] reshape pca to report_document --- R/tm_a_pca.R | 121 ++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 87 insertions(+), 34 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 0afea8f76..9bf5ec356 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -235,9 +235,6 @@ ui_a_pca <- function(id, ...) { uiOutput(ns("all_plots")) ), encoding = tags$div( - ### Reporter - teal.reporter::simple_reporter_ui(ns("simple_reporter")), - ### tags$label("Encodings", class = "text-primary"), teal.transform::datanames_input(args["dat"]), teal.transform::data_extract_ui( @@ -478,7 +475,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl }) # computation ---- - computation <- reactive({ + computation_model <- reactive({ validation() # inputs @@ -504,24 +501,26 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) } - qenv <- teal.code::eval_code( + teal.code::eval_code( qenv, substitute( expr = pca <- summary(stats::prcomp(ANL[keep_columns], center = center, scale. = scale, retx = TRUE)), env = list(center = center, scale = scale) ) ) - - qenv <- teal.code::eval_code( - qenv, + }) + computation_tbl_imp <- reactive({ + teal.code::eval_code( + computation_model(), quote({ tbl_importance <- dplyr::as_tibble(pca$importance, rownames = "Metric") tbl_importance }) ) - + }) + computation <- reactive({ teal.code::eval_code( - qenv, + computation_tbl_imp(), quote({ tbl_eigenvector <- dplyr::as_tibble(pca$rotation, rownames = "Variable") tbl_eigenvector @@ -1124,6 +1123,50 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl }) # Render R code. + subset_code <- function(code, data) { + gsub(code, "", teal.data::get_code(data), fixed = TRUE) + } + setup_code_r <- reactive(teal.data::get_code(qenv)) + data_prep_code_r <- + reactive( + subset_code( + setup_code_r(), + req(anl_merged_q()) + ) + ) + + computation_model_code_r <- + reactive( + subset_code( + paste0(setup_code_r(), data_prep_code_r()), + req(computation_model()) + ) + ) + + computation_tbl_imp_code_r <- + reactive( + subset_code( + paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r()), + req(computation_tbl_imp()) + ) + ) + + computation_tbl_eig_code_r <- + reactive( + subset_code( + paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation_tbl_imp_code_r()), + req(computation()) + ) + ) + + plot_code_r <- + reactive( + subset_code( + paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation_tbl_imp_code_r(), computation_tbl_eig_code_r()), + req(decorated_output_q()) + ) + ) + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) teal.widgets::verbatim_popup_srv( @@ -1132,30 +1175,40 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl title = "R Code for PCA" ) - ### REPORTER - if (with_reporter) { - card_fun <- function(comment, label) { - card <- teal::report_card_template( - title = "Principal Component Analysis Plot", - label = label, - with_filter = with_filter, - filter_panel_api = filter_panel_api - ) - card$append_text("Principal Components Table", "header3") - card$append_table(computation()[["tbl_importance"]]) - card$append_text("Eigenvectors Table", "header3") - card$append_table(computation()[["tbl_eigenvector"]]) - card$append_text("Plot", "header3") - card$append_plot(plot_r(), dim = pws$dim()) - if (!comment == "") { - card$append_text("Comment", "header3") - card$append_text(comment) - } - card$append_src(source_code_r()) - card - } - teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) - } + card_fun <- reactive({ + req(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation(), + computation_tbl_imp_code_r(), computation_tbl_eig_code_r(), plot_code_r(), plot_r()) + + teal.reporter::report_document( + + "## Setup", + teal.reporter::code_chunk(setup_code_r()), + + "## Data Preparations", + teal.reporter::code_chunk(data_prep_code_r()), + + "## PCA Model", + teal.reporter::code_chunk(computation_model_code_r()), + + "### Principal Components Table", + teal.reporter::code_chunk(computation_tbl_imp_code_r()) |> + teal.reporter::link_output(computation()[["tbl_importance"]]), + + "### Eigenvectors Table", + teal.reporter::code_chunk(computation_tbl_eig_code_r()) |> + teal.reporter::link_output(computation()[["tbl_eigenvector"]]), + + "### Plot", + teal.reporter::code_chunk( + plot_code_r() |> styler::style_text() |> paste(collapse = "\n") + ) |> + teal.reporter::link_output(plot_r()) + ) + }) + ### + list( + report_card = card_fun + ) }) } From 11804a29186d02e1b51abf9ef1da5f5415e055c2 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 17 Mar 2025 18:49:55 +0100 Subject: [PATCH 23/35] add rtables for testing to tmg --- R/tm_a_regression.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 029df340a..5257268df 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1083,6 +1083,13 @@ srv_a_regression <- function(id, ) |> teal.reporter::link_output(plot_r()), + "## rtables for testing", + rtables::rtable( + header = LETTERS[1:3], + rtables::rrow("one to three", 1, 2, 3), + rtables::rrow("more stuff", rtables::rcell(pi, format = "xx.xx"), "test", "and more") + ), + "## Table for testing", head(iris) ) From 3d94b0b529bf4ce93816cc1cd6b21a4713c6a3e0 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 24 Mar 2025 14:12:19 +0100 Subject: [PATCH 24/35] add libraries code and the code to create objects --- R/tm_a_pca.R | 27 +++++++++++++++++++-------- R/tm_a_regression.R | 32 ++++++++++++++++++++++++++------ 2 files changed, 45 insertions(+), 14 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 9bf5ec356..1451e703e 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -1126,11 +1126,19 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl subset_code <- function(code, data) { gsub(code, "", teal.data::get_code(data), fixed = TRUE) } - setup_code_r <- reactive(teal.data::get_code(qenv)) - data_prep_code_r <- + setup_code_r <- reactive(teal.data::get_code(req(data()))) + libraries_code_r <- reactive( subset_code( setup_code_r(), + qenv + ) + ) + + data_prep_code_r <- + reactive( + subset_code( + paste0(setup_code_r(), libraries_code_r()), req(anl_merged_q()) ) ) @@ -1184,6 +1192,9 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl "## Setup", teal.reporter::code_chunk(setup_code_r()), + "## Libraries", + teal.reporter::code_chunk(libraries_code_r(), eval = TRUE), + "## Data Preparations", teal.reporter::code_chunk(data_prep_code_r()), @@ -1191,18 +1202,18 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl teal.reporter::code_chunk(computation_model_code_r()), "### Principal Components Table", - teal.reporter::code_chunk(computation_tbl_imp_code_r()) |> - teal.reporter::link_output(computation()[["tbl_importance"]]), + teal.reporter::code_chunk(computation_tbl_imp_code_r()), + computation()[["tbl_importance"]], "### Eigenvectors Table", - teal.reporter::code_chunk(computation_tbl_eig_code_r()) |> - teal.reporter::link_output(computation()[["tbl_eigenvector"]]), + teal.reporter::code_chunk(computation_tbl_eig_code_r()), + computation()[["tbl_eigenvector"]], "### Plot", teal.reporter::code_chunk( plot_code_r() |> styler::style_text() |> paste(collapse = "\n") - ) |> - teal.reporter::link_output(plot_r()) + ), + plot_r() ) }) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 5257268df..7e964ec81 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1027,25 +1027,32 @@ srv_a_regression <- function(id, subset_code <- function(code, data) { gsub(code, "", teal.data::get_code(data), fixed = TRUE) } - setup_code_r <- reactive(teal.data::get_code(qenv)) - data_prep_code_r <- + setup_code_r <- reactive(teal.data::get_code(req(data()))) + libraries_code_r <- reactive( subset_code( setup_code_r(), + qenv + ) + ) + data_prep_code_r <- + reactive( + subset_code( + paste0(setup_code_r(), libraries_code_r()), req(anl_merged_q()) ) ) fit_code_r <- reactive( subset_code( - paste0(setup_code_r(), data_prep_code_r()), + paste0(setup_code_r(), libraries_code_r(), data_prep_code_r()), req(fit_r()) ) ) plot_code_r <- reactive( subset_code( - paste0(setup_code_r(), data_prep_code_r(), fit_code_r()), + paste0(setup_code_r(), libraries_code_r(), data_prep_code_r(), fit_code_r()), req(decorated_output_q()) ) ) @@ -1066,6 +1073,9 @@ srv_a_regression <- function(id, "## Setup", teal.reporter::code_chunk(setup_code_r()), + "## Libraries", + teal.reporter::code_chunk(libraries_code_r(), eval = TRUE), + "## Data Preparations", teal.reporter::code_chunk(data_prep_code_r()), @@ -1080,10 +1090,17 @@ srv_a_regression <- function(id, "## Plot", teal.reporter::code_chunk( plot_code_r() |> styler::style_text() |> paste(collapse = "\n") - ) |> - teal.reporter::link_output(plot_r()), + ), + plot_r(), "## rtables for testing", + teal.reporter::code_chunk( + "rtables::rtable( + header = LETTERS[1:3], + rtables::rrow('one to three', 1, 2, 3), + rtables::rrow('more stuff', rtables::rcell(pi, format = 'xx.xx'), 'test', 'and more') + )" + ), rtables::rtable( header = LETTERS[1:3], rtables::rrow("one to three", 1, 2, 3), @@ -1091,6 +1108,9 @@ srv_a_regression <- function(id, ), "## Table for testing", + teal.reporter::code_chunk( + "head(iris)" + ), head(iris) ) }) From c1abab492f4d414d150baf4caececaf3f08ab0cc Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 27 Mar 2025 22:55:13 +0100 Subject: [PATCH 25/35] divide the code using labels --- DESCRIPTION | 1 + R/tm_a_regression.R | 105 ++++++++++++++++++++++++-------------------- R/utils.R | 6 +-- 3 files changed, 62 insertions(+), 50 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 408fb69a9..25e780bcc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -84,6 +84,7 @@ VignetteBuilder: knitr, rmarkdown Remotes: + insightsengineering/teal.code@redesign@main, insightsengineering/teal.reporter@redesign@main, insightsengineering/teal.widgets@main, insightsengineering/teal@redesign@main diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 7e964ec81..018088429 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -460,13 +460,14 @@ srv_a_regression <- function(id, qenv <- teal.code::eval_code( data(), - 'library("ggplot2");library("dplyr")' # nolint quotes + 'library("ggplot2");library("dplyr")', # nolint quotes + label = "libraries" ) anl_merged_q <- reactive({ req(anl_merged_input()) qenv %>% - teal.code::eval_code(as.expression(anl_merged_input()$expr)) + teal.code::eval_code(as.expression(anl_merged_input()$expr), label = "data preparations") }) @@ -525,7 +526,7 @@ srv_a_regression <- function(id, } anl_merged_q() %>% - teal.code::eval_code(substitute(fit <- stats::lm(form, data = ANL), env = list(form = form))) %>% + teal.code::eval_code(substitute(fit <- stats::lm(form, data = ANL), env = list(form = form)), label = "fit") %>% teal.code::eval_code(quote({ for (regressor in names(fit$contrasts)) { alts <- paste0(levels(ANL[[regressor]]), collapse = "|") @@ -533,8 +534,8 @@ srv_a_regression <- function(id, paste0("^(", regressor, ")(", alts, ")$"), paste0("\\1", ": ", "\\2"), names(fit$coefficients) ) } - })) %>% - teal.code::eval_code(quote(summary(fit))) + }), label = "fit") %>% + teal.code::eval_code(quote(summary(fit)), label = "fit") }) label_col <- reactive({ @@ -587,7 +588,8 @@ srv_a_regression <- function(id, smoothy_aes <- ggplot2::aes_string(x = "x", y = "y") reg_form <- deparse(fit$call[[2]]) - }) + }), + label = "plot" ) }) @@ -657,7 +659,8 @@ srv_a_regression <- function(id, env = list( graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) - ) + ), + label = "plot" ) }) @@ -701,7 +704,8 @@ srv_a_regression <- function(id, env = list( graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) - ) + ), + label = "plot" ) }) @@ -760,7 +764,8 @@ srv_a_regression <- function(id, env = list( graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) - ) + ), + label = "plot" ) }) @@ -803,7 +808,8 @@ srv_a_regression <- function(id, env = list( graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) - ) + ), + label = "plot" ) }) @@ -869,7 +875,8 @@ srv_a_regression <- function(id, env = list( graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) - ) + ), + label = "plot" ) }) @@ -924,7 +931,8 @@ srv_a_regression <- function(id, env = list( graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) - ) + ), + label = "plot" ) }) @@ -974,7 +982,8 @@ srv_a_regression <- function(id, env = list( graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args)) ) - ) + ), + label = "plot" ) }) @@ -994,8 +1003,9 @@ srv_a_regression <- function(id, decorated_output_q <- srv_decorate_teal_data( "decorator", data = output_q, - decorators = select_decorators(decorators, "plot"), - expr = print(plot) + decorators = select_decorators(decorators, "plot"), # decorator needs to put label="plot" in it's eval_code + expr = print(plot), + label = "plot" ) fitted <- reactive({ @@ -1023,39 +1033,40 @@ srv_a_regression <- function(id, ) }) - # Render R code. - subset_code <- function(code, data) { - gsub(code, "", teal.data::get_code(data), fixed = TRUE) - } + # # Render R code. + # subset_code <- function(code, data) { + # gsub(code, "", teal.data::get_code(data), fixed = TRUE) + # } + setup_code_r <- reactive(teal.data::get_code(req(data()))) - libraries_code_r <- - reactive( - subset_code( - setup_code_r(), - qenv - ) - ) - data_prep_code_r <- - reactive( - subset_code( - paste0(setup_code_r(), libraries_code_r()), - req(anl_merged_q()) - ) - ) - fit_code_r <- - reactive( - subset_code( - paste0(setup_code_r(), libraries_code_r(), data_prep_code_r()), - req(fit_r()) - ) - ) - plot_code_r <- - reactive( - subset_code( - paste0(setup_code_r(), libraries_code_r(), data_prep_code_r(), fit_code_r()), - req(decorated_output_q()) - ) - ) + libraries_code_r <- reactive(teal.code::get_code(req(decorated_output_q()), labels = "libraries")) + # reactive( + # subset_code( + # setup_code_r(), + # qenv + # ) + # ) + data_prep_code_r <- reactive(teal.code::get_code(req(decorated_output_q()), labels = "data preparations")) + # reactive( + # subset_code( + # paste0(setup_code_r(), libraries_code_r()), + # req(anl_merged_q()) + # ) + # ) + fit_code_r <- reactive(teal.code::get_code(req(decorated_output_q()), labels = "fit")) + # reactive( + # subset_code( + # paste0(setup_code_r(), libraries_code_r(), data_prep_code_r()), + # req(fit_r()) + # ) + # ) + plot_code_r <- reactive(teal.code::get_code(req(decorated_output_q()), labels = "plot")) + # reactive( + # subset_code( + # paste0(setup_code_r(), libraries_code_r(), data_prep_code_r(), fit_code_r()), + # req(decorated_output_q()) + # ) + # ) source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) diff --git a/R/utils.R b/R/utils.R index 5eb3609fd..5296cd6fa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -298,7 +298,7 @@ assert_single_selection <- function(x, #' first. #' #' @keywords internal -srv_decorate_teal_data <- function(id, data, decorators, expr, expr_is_reactive = FALSE) { +srv_decorate_teal_data <- function(id, data, decorators, expr, expr_is_reactive = FALSE, label = "") { checkmate::assert_class(data, classes = "reactive") checkmate::assert_list(decorators, "teal_transform_module") checkmate::assert_flag(expr_is_reactive) @@ -321,9 +321,9 @@ srv_decorate_teal_data <- function(id, data, decorators, expr, expr_is_reactive if (missing_expr) { decorated_output() } else if (expr_is_reactive) { - teal.code::eval_code(decorated_output(), expr()) + teal.code::eval_code(decorated_output(), expr(), label = label) } else { - teal.code::eval_code(decorated_output(), expr) + teal.code::eval_code(decorated_output(), expr, label = label) } } }) From 77cc108da7914b2bcf8e0d60da733e91b4d27fd2 Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 28 Mar 2025 13:14:53 +0100 Subject: [PATCH 26/35] example with keep_in_report() --- R/tm_a_regression.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 018088429..2bc512171 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1122,7 +1122,15 @@ srv_a_regression <- function(id, teal.reporter::code_chunk( "head(iris)" ), - head(iris) + head(iris), + + "## keep_in_report", + + "If you don't want to include code for head(mtcars) in report - just don't include it.", + + "If you want the object to be kept in the report as loaded from .rds use keep_in_report()", + head(mtcars) |> keep_in_report() + ) }) ### From 16a5715d96461933fbf413d5823d90ca0f3992c2 Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 28 Mar 2025 13:30:02 +0100 Subject: [PATCH 27/35] example on how to remove things from report but keep in output --- R/tm_a_regression.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 2bc512171..ff8b8589c 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1129,7 +1129,13 @@ srv_a_regression <- function(id, "If you don't want to include code for head(mtcars) in report - just don't include it.", "If you want the object to be kept in the report as loaded from .rds use keep_in_report()", - head(mtcars) |> keep_in_report() + head(mtcars) |> keep_in_report(), + + "If you want the code/text to be included in the output, but not in the text use keep_in_report(FALSE)" |> + keep_in_report(FALSE), + teal.reporter::code_chunk( + "head(swiss)" + ) |> keep_in_report(FALSE) ) }) From 307baa1e67f4699a67853b8dee91b654309894bd Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 31 Mar 2025 09:49:17 +0200 Subject: [PATCH 28/35] pull_code function --- R/tm_a_regression.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index ff8b8589c..393aee8a6 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1038,29 +1038,32 @@ srv_a_regression <- function(id, # gsub(code, "", teal.data::get_code(data), fixed = TRUE) # } - setup_code_r <- reactive(teal.data::get_code(req(data()))) - libraries_code_r <- reactive(teal.code::get_code(req(decorated_output_q()), labels = "libraries")) + pull_code <- function(data, labels){ + reactive(teal.data::get_code(req(data()), labels = labels)) + } + setup_code_r <- pull_code(data) + libraries_code_r <- pull_code(decorated_output_q, labels = "libraries") # reactive( # subset_code( # setup_code_r(), # qenv # ) # ) - data_prep_code_r <- reactive(teal.code::get_code(req(decorated_output_q()), labels = "data preparations")) + data_prep_code_r <- pull_code(decorated_output_q, labels = "data preparations") # reactive( # subset_code( # paste0(setup_code_r(), libraries_code_r()), # req(anl_merged_q()) # ) # ) - fit_code_r <- reactive(teal.code::get_code(req(decorated_output_q()), labels = "fit")) + fit_code_r <- pull_code(decorated_output_q, labels = "fit") # reactive( # subset_code( # paste0(setup_code_r(), libraries_code_r(), data_prep_code_r()), # req(fit_r()) # ) # ) - plot_code_r <- reactive(teal.code::get_code(req(decorated_output_q()), labels = "plot")) + plot_code_r <- pull_code(decorated_output_q, labels = "plot") # reactive( # subset_code( # paste0(setup_code_r(), libraries_code_r(), data_prep_code_r(), fit_code_r()), @@ -1068,7 +1071,7 @@ srv_a_regression <- function(id, # ) # ) - source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) + source_code_r <- pull_code(decorated_output_q) teal.widgets::verbatim_popup_srv( id = "rcode", From d9cfc2daecd00a30d3a5040333693487f1f6b0e4 Mon Sep 17 00:00:00 2001 From: m7pr Date: Mon, 31 Mar 2025 16:32:53 +0200 Subject: [PATCH 29/35] typo --- R/tm_a_regression.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 393aee8a6..654f560eb 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1038,8 +1038,8 @@ srv_a_regression <- function(id, # gsub(code, "", teal.data::get_code(data), fixed = TRUE) # } - pull_code <- function(data, labels){ - reactive(teal.data::get_code(req(data()), labels = labels)) + pull_code <- function(data, labels = NULL){ + reactive(teal.code::get_code(req(data()), labels = labels)) } setup_code_r <- pull_code(data) libraries_code_r <- pull_code(decorated_output_q, labels = "libraries") From 37b096d35c7f5dc58bcf041d3037d77f65c1f4e3 Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 2 Apr 2025 13:32:19 +0200 Subject: [PATCH 30/35] cleanup tm_a_regression code extraction --- R/tm_a_regression.R | 34 +--------------------------------- R/utils.R | 6 ++++++ 2 files changed, 7 insertions(+), 33 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 654f560eb..228e7e01a 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1033,43 +1033,11 @@ srv_a_regression <- function(id, ) }) - # # Render R code. - # subset_code <- function(code, data) { - # gsub(code, "", teal.data::get_code(data), fixed = TRUE) - # } - - pull_code <- function(data, labels = NULL){ - reactive(teal.code::get_code(req(data()), labels = labels)) - } setup_code_r <- pull_code(data) libraries_code_r <- pull_code(decorated_output_q, labels = "libraries") - # reactive( - # subset_code( - # setup_code_r(), - # qenv - # ) - # ) data_prep_code_r <- pull_code(decorated_output_q, labels = "data preparations") - # reactive( - # subset_code( - # paste0(setup_code_r(), libraries_code_r()), - # req(anl_merged_q()) - # ) - # ) fit_code_r <- pull_code(decorated_output_q, labels = "fit") - # reactive( - # subset_code( - # paste0(setup_code_r(), libraries_code_r(), data_prep_code_r()), - # req(fit_r()) - # ) - # ) plot_code_r <- pull_code(decorated_output_q, labels = "plot") - # reactive( - # subset_code( - # paste0(setup_code_r(), libraries_code_r(), data_prep_code_r(), fit_code_r()), - # req(decorated_output_q()) - # ) - # ) source_code_r <- pull_code(decorated_output_q) @@ -1081,7 +1049,7 @@ srv_a_regression <- function(id, ### REPORTER card_fun <- reactive({ - req(plot_r(), plot_code_r(), setup_code_r(), data_prep_code_r(), fit_code_r(), fitted()) + req(plot_r(), plot_code_r(), setup_code_r(), libraries_code_r(), data_prep_code_r(), fit_code_r(), fitted()) teal.reporter::report_document( "## Setup", diff --git a/R/utils.R b/R/utils.R index 5296cd6fa..42d8f653f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -397,3 +397,9 @@ select_decorators <- function(decorators, scope) { list() } } + +#' @keywords internal +#' @noRd +pull_code <- function(data, labels = NULL){ + reactive(teal.code::get_code(req(data()), labels = labels)) +} From f7f597d99fad42b5a9ef584e7d66a4153db3de54 Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 2 Apr 2025 13:32:47 +0200 Subject: [PATCH 31/35] use code labeling and pull_code in pca module --- R/tm_a_pca.R | 120 ++++++++++++++++++++------------------------------- 1 file changed, 46 insertions(+), 74 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 1451e703e..f7217baf3 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -433,11 +433,11 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl selector_list = selector_list, datasets = data ) - qenv <- teal.code::eval_code(data(), 'library("ggplot2");library("dplyr");library("tidyr")') # nolint quotes + qenv <- teal.code::eval_code(data(), 'library("ggplot2");library("dplyr");library("tidyr")', label = "libraries") # nolint quotes anl_merged_q <- reactive({ req(anl_merged_input()) qenv %>% - teal.code::eval_code(as.expression(anl_merged_input()$expr)) + teal.code::eval_code(as.expression(anl_merged_input()$expr), label = "data preparations") }) merged <- list( @@ -491,13 +491,15 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl substitute( expr = keep_columns <- keep_cols, env = list(keep_cols = keep_cols) - ) + ), + label = "computation model" ) if (na_action == "drop") { qenv <- teal.code::eval_code( qenv, - quote(ANL <- tidyr::drop_na(ANL, keep_columns)) + quote(ANL <- tidyr::drop_na(ANL, keep_columns)), + label = "computation model" ) } @@ -506,7 +508,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl substitute( expr = pca <- summary(stats::prcomp(ANL[keep_columns], center = center, scale. = scale, retx = TRUE)), env = list(center = center, scale = scale) - ) + ), + label = "computation model" ) }) computation_tbl_imp <- reactive({ @@ -515,7 +518,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl quote({ tbl_importance <- dplyr::as_tibble(pca$importance, rownames = "Metric") tbl_importance - }) + }), + label = "computation tbl imp" ) }) computation <- reactive({ @@ -524,7 +528,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl quote({ tbl_eigenvector <- dplyr::as_tibble(pca$rotation, rownames = "Variable") tbl_eigenvector - }) + }), + label = "computation tbl eig" ) }) @@ -638,7 +643,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl labs = parsed_ggplot2_args$labs, themes = parsed_ggplot2_args$theme ) - ) + ), + label = "plot" ) } @@ -710,7 +716,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl labs = `if`(is.null(parsed_ggplot2_args$labs), quote(labs()), parsed_ggplot2_args$labs), themes = parsed_ggplot2_args$theme ) - ) + ), + label = "plot" ) } @@ -739,7 +746,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl substitute( expr = pca_rot <- dplyr::as_tibble(pca$x[, c(x_axis, y_axis)]), env = list(x_axis = x_axis, y_axis = y_axis) - ) + ), + label = "plot" ) # rot_vars = data frame that displays arrows in the plot, need to be scaled to data @@ -756,7 +764,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl dplyr::mutate_at(vars(c(x_axis, y_axis)), function(x) r * x / sqrt(max(v_scale))) }, env = list(x_axis = x_axis, y_axis = y_axis) - ) + ), + label = "plot" ) %>% teal.code::eval_code( if (is.logical(pca$center) && !pca$center) { @@ -775,13 +784,15 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) } else { quote(rot_vars <- rot_vars %>% dplyr::mutate(xstart = 0, ystart = 0)) - } + }, + label = "plot" ) %>% teal.code::eval_code( substitute( expr = rot_vars <- rot_vars %>% dplyr::filter(label %in% variables), env = list(variables = variables) - ) + ), + label = "plot" ) } @@ -810,7 +821,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl qenv <- teal.code::eval_code( qenv, - substitute(response <- ANL[[resp_col]], env = list(resp_col = resp_col)) + substitute(response <- ANL[[resp_col]], env = list(resp_col = resp_col)), + label = "plot" ) dev_labs <- list(color = varname_w_label(resp_col, ANL)) @@ -823,13 +835,15 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) { qenv <- teal.code::eval_code( qenv, - quote(pca_rot$response <- as.factor(response)) + quote(pca_rot$response <- as.factor(response)), + label = "plot" ) quote(ggplot2::scale_color_brewer(palette = "Dark2")) } else if (inherits(response, "Date")) { qenv <- teal.code::eval_code( qenv, - quote(pca_rot$response <- numeric(response)) + quote(pca_rot$response <- numeric(response)), + label = "plot" ) quote( @@ -842,7 +856,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl } else { qenv <- teal.code::eval_code( qenv, - quote(pca_rot$response <- response) + quote(pca_rot$response <- response), + label = "plot" ) quote(ggplot2::scale_color_gradient( low = c(getOption("ggplot2.discrete.colour")[2], "darkred")[1], @@ -928,7 +943,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl env = list( plot_call = Reduce(function(x, y) call("+", x, y), pca_plot_biplot_expr) ) - ) + ), + label = "plot" ) } @@ -1006,7 +1022,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl pc = pc, plot_call = Reduce(function(x, y) call("+", x, y), ggplot_exprs) ) - ) + ), + label = "plot" ) } @@ -1037,7 +1054,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl expr = reactive({ substitute(print(.plot), env = list(.plot = as.name(obj_name))) }), - expr_is_reactive = TRUE + expr_is_reactive = TRUE, + label = "plot" ) }, names(output_q), @@ -1122,60 +1140,14 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) }) - # Render R code. - subset_code <- function(code, data) { - gsub(code, "", teal.data::get_code(data), fixed = TRUE) - } - setup_code_r <- reactive(teal.data::get_code(req(data()))) - libraries_code_r <- - reactive( - subset_code( - setup_code_r(), - qenv - ) - ) - - data_prep_code_r <- - reactive( - subset_code( - paste0(setup_code_r(), libraries_code_r()), - req(anl_merged_q()) - ) - ) - - computation_model_code_r <- - reactive( - subset_code( - paste0(setup_code_r(), data_prep_code_r()), - req(computation_model()) - ) - ) - - computation_tbl_imp_code_r <- - reactive( - subset_code( - paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r()), - req(computation_tbl_imp()) - ) - ) - - computation_tbl_eig_code_r <- - reactive( - subset_code( - paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation_tbl_imp_code_r()), - req(computation()) - ) - ) - - plot_code_r <- - reactive( - subset_code( - paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation_tbl_imp_code_r(), computation_tbl_eig_code_r()), - req(decorated_output_q()) - ) - ) - - source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) + setup_code_r <- pull_code(data) + libraries_code_r <- pull_code(decorated_output_q, labels = "libraries") + data_prep_code_r <- pull_code(decorated_output_q, labels = "data preparations") + computation_model_code_r <- pull_code(decorated_output_q, labels = "computation model") + computation_tbl_imp_code_r <- pull_code(decorated_output_q, labels = "computation tbl imp") + computation_tbl_eig_code_r <- pull_code(decorated_output_q, labels = "computation tbl eig") + plot_code_r <- pull_code(decorated_output_q, labels = "plot") + source_code_r <- pull_code(decorated_output_q) teal.widgets::verbatim_popup_srv( id = "rcode", From da18867d07fd23fe1e37be061526e8ade1b15cd4 Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 2 Apr 2025 13:55:19 +0200 Subject: [PATCH 32/35] cleanup --- R/tm_a_pca.R | 5 ++--- R/tm_a_regression.R | 1 - 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index f7217baf3..9f19e73c1 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -351,7 +351,6 @@ ui_a_pca <- function(id, ...) { # Server function for the PCA module srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args, decorators) { - with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") @@ -1140,6 +1139,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) }) + # Render R code. setup_code_r <- pull_code(data) libraries_code_r <- pull_code(decorated_output_q, labels = "libraries") data_prep_code_r <- pull_code(decorated_output_q, labels = "data preparations") @@ -1156,7 +1156,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) card_fun <- reactive({ - req(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation(), + req(setup_code_r(), libraries_code_r(), data_prep_code_r(), computation_model_code_r(), computation(), computation_tbl_imp_code_r(), computation_tbl_eig_code_r(), plot_code_r(), plot_r()) teal.reporter::report_document( @@ -1189,7 +1189,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) }) - ### list( report_card = card_fun ) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 228e7e01a..8aa3b93f6 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1110,7 +1110,6 @@ srv_a_regression <- function(id, ) }) - ### list( report_card = card_fun From 93567de7d166f63f104723e186a21e37fe9143fc Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 2 Apr 2025 13:55:37 +0200 Subject: [PATCH 33/35] adjust tm_g_scatterplot module --- R/tm_g_scatterplot.R | 78 +++++++++++++++++++++++++------------------- 1 file changed, 44 insertions(+), 34 deletions(-) diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index 9d1f78974..86a1bdb5a 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -371,9 +371,6 @@ ui_g_scatterplot <- function(id, ...) { DT::dataTableOutput(ns("data_table"), width = "100%") ), encoding = tags$div( - ### Reporter - teal.reporter::simple_reporter_ui(ns("simple_reporter")), - ### tags$label("Encodings", class = "text-primary"), teal.transform::datanames_input(args[c("x", "y", "color_by", "size_by", "row_facet", "col_facet")]), teal.transform::data_extract_ui( @@ -522,7 +519,6 @@ srv_g_scatterplot <- function(id, table_dec, ggplot2_args, decorators) { - with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") @@ -590,13 +586,13 @@ srv_g_scatterplot <- function(id, datasets = data, merge_function = "dplyr::inner_join" ) - qenv <- teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes + qenv <- teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")', label = "libraries") # nolint quotes anl_merged_q <- reactive({ req(anl_merged_input()) qenv %>% - teal.code::eval_code(as.expression(anl_merged_input()$expr)) %>% - teal.code::eval_code(quote(ANL)) # used to display table when running show-r-code code + teal.code::eval_code(as.expression(anl_merged_input()$expr), label = "data preparations") %>% + teal.code::eval_code(quote(ANL), label = "data preparations") # used to display table when running show-r-code code }) merged <- list( @@ -767,7 +763,8 @@ srv_g_scatterplot <- function(id, log_x_fn = as.name(log_x_fn), log_x_var = paste0(log_x_fn, "_", x_var) ) - ) + ), + label = "plot" ) } @@ -782,7 +779,8 @@ srv_g_scatterplot <- function(id, log_y_fn = as.name(log_y_fn), log_y_var = paste0(log_y_fn, "_", y_var) ) - ) + ), + label = "plot" ) } @@ -911,7 +909,8 @@ srv_g_scatterplot <- function(id, substitute( expr = ANL <- dplyr::filter(ANL, !is.na(x_var) & !is.na(y_var)), env = list(x_var = as.name(x_var), y_var = as.name(y_var)) - ) + ), + label = "plot" ) } rhs_formula <- substitute( @@ -1014,14 +1013,15 @@ srv_g_scatterplot <- function(id, plot_call <- substitute(expr = plot <- plot_call, env = list(plot_call = plot_call)) - teal.code::eval_code(plot_q, plot_call) + teal.code::eval_code(plot_q, plot_call, label = "plot") }) decorated_output_plot_q <- srv_decorate_teal_data( id = "decorator", data = output_q, decorators = select_decorators(decorators, "plot"), - expr = print(plot) + expr = print(plot), + label = "plot" ) plot_r <- reactive(req(decorated_output_plot_q())[["plot"]]) @@ -1064,7 +1064,11 @@ srv_g_scatterplot <- function(id, }) # Render R code. - source_code_r <- reactive(teal.code::get_code(req(decorated_output_plot_q()))) + setup_code_r <- pull_code(data) + libraries_code_r <- pull_code(decorated_output_plot_q, labels = "libraries") + data_prep_code_r <- pull_code(decorated_output_plot_q, labels = "data preparations") + plot_code_r <- pull_code(decorated_output_plot_q, labels = "plot") + source_code_r <- pull_code(decorated_output_plot_q) teal.widgets::verbatim_popup_srv( id = "rcode", @@ -1072,26 +1076,32 @@ srv_g_scatterplot <- function(id, title = "R Code for scatterplot" ) - ### REPORTER - if (with_reporter) { - card_fun <- function(comment, label) { - card <- teal::report_card_template( - title = "Scatter Plot", - label = label, - with_filter = with_filter, - filter_panel_api = filter_panel_api - ) - card$append_text("Plot", "header3") - card$append_plot(plot_r(), dim = pws$dim()) - if (!comment == "") { - card$append_text("Comment", "header3") - card$append_text(comment) - } - card$append_src(source_code_r()) - card - } - teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) - } - ### + + card_fun <- reactive({ + req(setup_code_r(), libraries_code_r(), data_prep_code_r(), plot_code_r(), plot_r()) + + teal.reporter::report_document( + + "## Setup", + teal.reporter::code_chunk(setup_code_r()), + + "## Libraries", + teal.reporter::code_chunk(libraries_code_r(), eval = TRUE), + + "## Data Preparations", + teal.reporter::code_chunk(data_prep_code_r()), + + "## Scatterplot", + teal.reporter::code_chunk( + plot_code_r() |> styler::style_text() |> paste(collapse = "\n") + ), + plot_r() + + ) + }) + + list( + report_card = card_fun + ) }) } From 2f2590656cf458c9b7953633f6675b6ff0703938 Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 25 Apr 2025 14:42:55 +0200 Subject: [PATCH 34/35] remove reporter argument from new modules --- R/tm_a_pca.R | 2 +- R/tm_a_regression.R | 1 - R/tm_g_scatterplot.R | 1 - 3 files changed, 1 insertion(+), 3 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 9f19e73c1..16fe74f48 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -350,7 +350,7 @@ ui_a_pca <- function(id, ...) { } # Server function for the PCA module -srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args, decorators) { +srv_a_pca <- function(id, data, filter_panel_api, dat, plot_height, plot_width, ggplot2_args, decorators) { with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 8aa3b93f6..be63be9aa 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -386,7 +386,6 @@ srv_a_regression <- function(id, filter_panel_api, response, regressor, - reporter, plot_height, plot_width, ggplot2_args, diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index 86a1bdb5a..859dccd95 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -506,7 +506,6 @@ ui_g_scatterplot <- function(id, ...) { # Server function for the scatterplot module srv_g_scatterplot <- function(id, data, - reporter, filter_panel_api, x, y, From 2aaadcbb6796f37c663b547b9a5e17629626b084 Mon Sep 17 00:00:00 2001 From: m7pr Date: Fri, 25 Apr 2025 15:37:01 +0200 Subject: [PATCH 35/35] remove pull_code --- R/tm_a_pca.R | 47 ++++++++++++++------------------------------ R/tm_a_regression.R | 25 ++++++++++------------- R/tm_g_scatterplot.R | 21 +++++++------------- R/utils.R | 6 ------ 4 files changed, 32 insertions(+), 67 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 16fe74f48..d9c9a0709 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -474,7 +474,7 @@ srv_a_pca <- function(id, data, filter_panel_api, dat, plot_height, plot_width, }) # computation ---- - computation_model <- reactive({ + computation <- reactive({ validation() # inputs @@ -509,21 +509,15 @@ srv_a_pca <- function(id, data, filter_panel_api, dat, plot_height, plot_width, env = list(center = center, scale = scale) ), label = "computation model" - ) - }) - computation_tbl_imp <- reactive({ + ) %>% teal.code::eval_code( - computation_model(), quote({ tbl_importance <- dplyr::as_tibble(pca$importance, rownames = "Metric") tbl_importance }), label = "computation tbl imp" - ) - }) - computation <- reactive({ + ) %>% teal.code::eval_code( - computation_tbl_imp(), quote({ tbl_eigenvector <- dplyr::as_tibble(pca$rotation, rownames = "Variable") tbl_eigenvector @@ -1140,14 +1134,7 @@ srv_a_pca <- function(id, data, filter_panel_api, dat, plot_height, plot_width, }) # Render R code. - setup_code_r <- pull_code(data) - libraries_code_r <- pull_code(decorated_output_q, labels = "libraries") - data_prep_code_r <- pull_code(decorated_output_q, labels = "data preparations") - computation_model_code_r <- pull_code(decorated_output_q, labels = "computation model") - computation_tbl_imp_code_r <- pull_code(decorated_output_q, labels = "computation tbl imp") - computation_tbl_eig_code_r <- pull_code(decorated_output_q, labels = "computation tbl eig") - plot_code_r <- pull_code(decorated_output_q, labels = "plot") - source_code_r <- pull_code(decorated_output_q) + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", @@ -1156,35 +1143,31 @@ srv_a_pca <- function(id, data, filter_panel_api, dat, plot_height, plot_width, ) card_fun <- reactive({ - req(setup_code_r(), libraries_code_r(), data_prep_code_r(), computation_model_code_r(), computation(), - computation_tbl_imp_code_r(), computation_tbl_eig_code_r(), plot_code_r(), plot_r()) + req(data(), decorated_output_q(), plot_r()) teal.reporter::report_document( - "## Setup", - teal.reporter::code_chunk(setup_code_r()), + teal.reporter::code_chunk(teal.code::get_code(data())), "## Libraries", - teal.reporter::code_chunk(libraries_code_r(), eval = TRUE), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "libraries"), eval = TRUE), "## Data Preparations", - teal.reporter::code_chunk(data_prep_code_r()), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "data preparations")), "## PCA Model", - teal.reporter::code_chunk(computation_model_code_r()), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "computation model")), "### Principal Components Table", - teal.reporter::code_chunk(computation_tbl_imp_code_r()), - computation()[["tbl_importance"]], + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "computation tbl imp")), + decorated_output_q()[["tbl_importance"]], "### Eigenvectors Table", - teal.reporter::code_chunk(computation_tbl_eig_code_r()), - computation()[["tbl_eigenvector"]], + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "computation tbl eig")), + decorated_output_q()[["tbl_eigenvector"]], - "### Plot", - teal.reporter::code_chunk( - plot_code_r() |> styler::style_text() |> paste(collapse = "\n") - ), + "## PCA Plot", + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "plot")), plot_r() ) }) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index be63be9aa..8768ec970 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -1032,13 +1032,7 @@ srv_a_regression <- function(id, ) }) - setup_code_r <- pull_code(data) - libraries_code_r <- pull_code(decorated_output_q, labels = "libraries") - data_prep_code_r <- pull_code(decorated_output_q, labels = "data preparations") - fit_code_r <- pull_code(decorated_output_q, labels = "fit") - plot_code_r <- pull_code(decorated_output_q, labels = "plot") - - source_code_r <- pull_code(decorated_output_q) + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", @@ -1048,20 +1042,20 @@ srv_a_regression <- function(id, ### REPORTER card_fun <- reactive({ - req(plot_r(), plot_code_r(), setup_code_r(), libraries_code_r(), data_prep_code_r(), fit_code_r(), fitted()) + req(data(), decorated_output_q(), plot_r()) teal.reporter::report_document( "## Setup", - teal.reporter::code_chunk(setup_code_r()), + teal.reporter::code_chunk(teal.code::get_code(data())), "## Libraries", - teal.reporter::code_chunk(libraries_code_r(), eval = TRUE), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "libraries"), eval = TRUE), "## Data Preparations", - teal.reporter::code_chunk(data_prep_code_r()), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "data preparations"), eval = TRUE), "## Model", - teal.reporter::code_chunk(fit_code_r()), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "fit"), eval = TRUE), teal.reporter::code_output( paste(utils::capture.output(summary(teal.code::dev_suppress(fitted())))[-1], collapse = "\n" @@ -1069,11 +1063,12 @@ srv_a_regression <- function(id, ), "## Plot", - teal.reporter::code_chunk( - plot_code_r() |> styler::style_text() |> paste(collapse = "\n") - ), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_q(), label = "plot")), plot_r(), + ### --- TODO: REST OF THIS CARD WILL BE DELETED + ### it is just here to test the reporter + "## rtables for testing", teal.reporter::code_chunk( "rtables::rtable( diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index 859dccd95..8136a3915 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -591,7 +591,7 @@ srv_g_scatterplot <- function(id, req(anl_merged_input()) qenv %>% teal.code::eval_code(as.expression(anl_merged_input()$expr), label = "data preparations") %>% - teal.code::eval_code(quote(ANL), label = "data preparations") # used to display table when running show-r-code code + teal.code::eval_code(quote(ANL), label = "data preparations") # used in show-r-code code }) merged <- list( @@ -1063,11 +1063,7 @@ srv_g_scatterplot <- function(id, }) # Render R code. - setup_code_r <- pull_code(data) - libraries_code_r <- pull_code(decorated_output_plot_q, labels = "libraries") - data_prep_code_r <- pull_code(decorated_output_plot_q, labels = "data preparations") - plot_code_r <- pull_code(decorated_output_plot_q, labels = "plot") - source_code_r <- pull_code(decorated_output_plot_q) + source_code_r <- reactive(teal.code::get_code(req(decorated_output_plot_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", @@ -1075,25 +1071,22 @@ srv_g_scatterplot <- function(id, title = "R Code for scatterplot" ) - card_fun <- reactive({ - req(setup_code_r(), libraries_code_r(), data_prep_code_r(), plot_code_r(), plot_r()) + req(data(), req(decorated_output_plot_q()), plot_r()) teal.reporter::report_document( "## Setup", - teal.reporter::code_chunk(setup_code_r()), + teal.reporter::code_chunk(teal.code::get_code(data())), "## Libraries", - teal.reporter::code_chunk(libraries_code_r(), eval = TRUE), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_plot_q(), label = "libraries"), eval = TRUE), "## Data Preparations", - teal.reporter::code_chunk(data_prep_code_r()), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_plot_q(), label = "data preparations")), "## Scatterplot", - teal.reporter::code_chunk( - plot_code_r() |> styler::style_text() |> paste(collapse = "\n") - ), + teal.reporter::code_chunk(teal.code::get_code(decorated_output_plot_q(), label = "plot")), plot_r() ) diff --git a/R/utils.R b/R/utils.R index 42d8f653f..5296cd6fa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -397,9 +397,3 @@ select_decorators <- function(decorators, scope) { list() } } - -#' @keywords internal -#' @noRd -pull_code <- function(data, labels = NULL){ - reactive(teal.code::get_code(req(data()), labels = labels)) -}