Merge branch 'teal_reportable' of https://github.com/insightsengineering/teal.modules.general into teal_reportable

Author: m7pr

R/tm_a_regression.R

@@ -1021,20 +1021,29 @@ srv_a_regression <- function(id,
       width = plot_width
     )
 
+    decorated_output_dims_q <- reactive({
+      dims <- req(pws$dim())
+      q <- req(decorated_output_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
     output$text <- renderText({
       req(iv_r()$is_valid())
       req(iv_out$is_valid())
       paste(utils::capture.output(summary(fitted()))[-1], collapse = "\n")
     })
 
     # Render R code.
-    source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_dims_q())))
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
       verbatim_content = source_code_r,
       title = "R code for the regression plot",
     )
-    decorated_output_q
+    decorated_output_dims_q
   })
 }

R/tm_g_association.R

@@ -542,16 +542,25 @@ srv_tm_g_association <- function(id,
       width = plot_width
     )
 
+    decorated_output_dims_q <- reactive({
+      dims <- req(pws$dim())
+      q <- req(decorated_output_grob_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
     output$title <- renderText(output_q()[["title"]])
 
     # Render R code.
-    source_code_r <- reactive(teal.code::get_code(req(decorated_output_grob_q())))
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_dims_q())))
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
       verbatim_content = source_code_r,
       title = "Association Plot"
     )
-    decorated_output_grob_q
+    decorated_output_dims_q
   })
 }

R/tm_g_bivariate.R

@@ -741,16 +741,25 @@ srv_g_bivariate <- function(id,
       width = plot_width
     )
 
+    decorated_output_dims_q <- reactive({
+      dims <- req(pws$dim())
+      q <- req(decorated_output_q_facets())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
     # Render R code.
 
-    source_code_r <- reactive(teal.code::get_code(req(decorated_output_q_facets())))
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_dims_q())))
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
       verbatim_content = source_code_r,
       title = "Bivariate Plot"
     )
-    decorated_output_q_facets
+    decorated_output_dims_q
   })
 }
 

R/tm_g_distribution.R

@@ -1339,20 +1339,7 @@ srv_distribution <- function(id,
       expr = quote(test_table)
     )
 
-    decorated_output_q <- reactive({
-      tab <- req(input$tabs) # tab is NULL upon app launch, hence will crash without this statement
-      test_q_out <- try(test_q(), silent = TRUE)
-      test_q_out <- output_test_q()
-
-      out_q <- switch(tab,
-        Histogram = decorated_output_dist_q(),
-        QQplot = decorated_output_qq_q()
-      )
-      c(out_q, output_summary_q(), test_q_out)
-    })
-
     dist_r <- reactive(req(decorated_output_dist_q())[["histogram_plot"]])
-
     qq_r <- reactive(req(decorated_output_qq_q())[["qq_plot"]])
 
     summary_r <- reactive({
@@ -1398,29 +1385,52 @@ srv_distribution <- function(id,
       brushing = FALSE
     )
 
-    output$t_stats <- DT::renderDataTable(tests_r()[["html"]])
+    decorated_output_dist_dims_q <- reactive({
+      dims <- req(pws1$dim())
+      q <- req(decorated_output_dist_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
 
-    # Render R code.
-    source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
+    decorated_output_qq_dims_q <- reactive({
+      dims <- req(pws2$dim())
+      q <- req(decorated_output_qq_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
 
-    teal.widgets::verbatim_popup_srv(
-      id = "rcode",
-      verbatim_content = source_code_r,
-      title = "R Code for distribution"
-    )
-    reactive(
+    decorated_output_q <- reactive({
+      tab <- req(input$tabs) # tab is NULL upon app launch, hence will crash without this statement
+      test_q_out <- output_test_q()
+
+      out_q <- switch(tab,
+        Histogram = decorated_output_dist_dims_q(),
+        QQplot = decorated_output_qq_dims_q()
+      )
       withCallingHandlers(
-        if (input$tabs == "Histogram") {
-          c(decorated_output_dist_q(), decorated_output_summary_q(), decorated_output_test_q())
-        } else if (input$tabs == "QQplot") {
-          c(decorated_output_qq_q(), decorated_output_summary_q(), decorated_output_test_q())
-        },
+        c(out_q, output_summary_q(), test_q_out),
         warning = function(w) {
           if (grepl("Restoring original content and adding only", conditionMessage(w))) {
             invokeRestart("muffleWarning")
           }
         }
       )
+    })
+
+    output$t_stats <- DT::renderDataTable(tests_r()[["html"]])
+
+    # Render R code.
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
+
+    teal.widgets::verbatim_popup_srv(
+      id = "rcode",
+      verbatim_content = source_code_r,
+      title = "R Code for distribution"
     )
+    decorated_output_q
   })
 }

R/tm_g_response.R

@@ -594,14 +594,23 @@ srv_g_response <- function(id,
       width = plot_width
     )
 
+    decorated_output_dims_q <- reactive({
+      dims <- req(pws$dim())
+      q <- req(decorated_output_plot_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
     # Render R code.
-    source_code_r <- reactive(teal.code::get_code(req(decorated_output_plot_q())))
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_dims_q())))
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
       verbatim_content = source_code_r,
       title = "Show R Code for Response"
     )
-    decorated_output_plot_q
+    decorated_output_dims_q
   })
 }

R/tm_g_scatterplot.R

@@ -1037,6 +1037,15 @@ srv_g_scatterplot <- function(id,
       brushing = TRUE
     )
 
+    decorated_output_dims_q <- reactive({
+      dims <- req(pws$dim())
+      q <- req(decorated_output_plot_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
     output$data_table <- DT::renderDataTable({
       plot_brush <- pws$brush()
 
@@ -1066,13 +1075,13 @@ srv_g_scatterplot <- function(id,
     })
 
     # Render R code.
-    source_code_r <- reactive(teal.code::get_code(req(decorated_output_plot_q())))
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_dims_q())))
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
       verbatim_content = source_code_r,
       title = "R Code for scatterplot"
     )
-    decorated_output_plot_q
+    decorated_output_dims_q
   })
 }

R/tm_g_scatterplotmatrix.R

@@ -479,6 +479,15 @@ srv_g_scatterplotmatrix <- function(id,
       width = plot_width
     )
 
+    decorated_output_dims_q <- reactive({
+      dims <- req(pws$dim())
+      q <- req(decorated_output_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
     # show a message if conversion to factors took place
     output$message <- renderText({
       req(iv_r()$is_valid())
@@ -502,14 +511,14 @@ srv_g_scatterplotmatrix <- function(id,
     })
 
     # Render R code.
-    source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
+    source_code_r <- reactive(teal.code::get_code(req(decorated_output_dims_q())))
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
       verbatim_content = source_code_r,
       title = "Show R Code for Scatterplotmatrix"
     )
-    decorated_output_q
+    decorated_output_dims_q
   })
 }
 

R/tm_missing_data.R

@@ -1373,16 +1373,43 @@ srv_missing_data <- function(id,
       width = plot_width
     )
 
+    decorated_summary_plot_dims_q <- reactive({
+      dims <- req(pws1$dim())
+      q <- req(decorated_summary_plot_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
+    decorated_combination_plot_dims_q <- reactive({
+      dims <- req(pws2$dim())
+      q <- req(decorated_combination_plot_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
+    decorated_by_subject_plot_dims_q <- reactive({
+      dims <- req(pws3$dim())
+      q <- req(decorated_by_subject_plot_q())
+      teal.reporter::teal_card(q) <- modify_last_chunk_outputs_attributes(
+        teal.reporter::teal_card(q), list(dev.width = dims[[1]], dev.height = dims[[2]])
+      )
+      q
+    })
+
     decorated_final_q <- reactive({
       sum_type <- req(input$summary_type)
       if (sum_type == "Summary") {
-        decorated_summary_plot_q()
+        decorated_output_summary_plot_dims_q()
       } else if (sum_type == "Combinations") {
-        decorated_combination_plot_q()
+        decorated_combination_plot_dims_q()
       } else if (sum_type == "By Variable Levels") {
         decorated_summary_table_q()
       } else if (sum_type == "Grouped by Subject") {
-        decorated_by_subject_plot_q()
+        decorated_by_subject_plot_dims_q()
       }
     })
 

R/tm_outliers.R

@@ -1170,6 +1170,8 @@ srv_outliers <- function(id, data, outlier_var,
       brushing = TRUE
     )
 
+
+
     choices <- reactive(teal.transform::variable_choices(data_obj()[[dataname_first]]))
 
     observeEvent(common_code_q(), {