wrap set_plot_dims (#914)

Signed-off-by: Marcin <[email protected]>
Co-authored-by: André Veríssimo <[email protected]>

Author: m7pr

R/tm_a_pca.R

@@ -1080,14 +1080,7 @@ srv_a_pca <- function(id, data, dat, plot_height, plot_width, ggplot2_args, deco
       graph_align = "center"
     )
 
-    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
-    })
+    decorated_output_dims_q <- set_plot_dims(pws, decorated_output_q)
 
     # tables ----
     output$tbl_importance <- renderTable(

R/tm_a_regression.R

@@ -1021,14 +1021,7 @@ 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
-    })
+    decorated_output_dims_q <- set_plot_dims(pws, decorated_output_q)
 
     output$text <- renderText({
       req(iv_r()$is_valid())

R/tm_g_association.R

@@ -542,14 +542,7 @@ 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
-    })
+    decorated_output_dims_q <- set_plot_dims(pws, decorated_output_grob_q)
 
     output$title <- renderText(output_q()[["title"]])
 

R/tm_g_bivariate.R

@@ -741,14 +741,7 @@ 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
-    })
+    decorated_output_dims_q <- set_plot_dims(pws, decorated_output_q_facets)
 
     # Render R code.
 

R/tm_g_distribution.R

@@ -1385,23 +1385,9 @@ srv_distribution <- function(id,
       brushing = FALSE
     )
 
-    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
-    })
+    decorated_output_dist_dims_q <- set_plot_dims(pws1, decorated_output_dist_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
-    })
+    decorated_output_qq_dims_q <- set_plot_dims(pws2, decorated_output_qq_q)
 
     decorated_output_q <- reactive({
       tab <- req(input$tabs) # tab is NULL upon app launch, hence will crash without this statement

R/tm_g_response.R

@@ -594,14 +594,7 @@ 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
-    })
+    decorated_output_dims_q <- set_plot_dims(pws, decorated_output_plot_q)
 
     # Render R code.
     source_code_r <- reactive(teal.code::get_code(req(decorated_output_dims_q())))

R/tm_g_scatterplot.R

@@ -1037,14 +1037,7 @@ 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
-    })
+    decorated_output_dims_q <- set_plot_dims(pws, decorated_output_plot_q)
 
     output$data_table <- DT::renderDataTable({
       plot_brush <- pws$brush()

R/tm_g_scatterplotmatrix.R

@@ -479,14 +479,7 @@ 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
-    })
+    decorated_output_dims_q <- set_plot_dims(pws, decorated_output_q)
 
     # show a message if conversion to factors took place
     output$message <- renderText({

R/tm_missing_data.R

@@ -1373,32 +1373,11 @@ 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_summary_plot_dims_q <- set_plot_dims(pws1, decorated_summary_plot_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_combination_plot_dims_q <- set_plot_dims(pws2, decorated_combination_plot_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_by_subject_plot_dims_q <- set_plot_dims(pws3, decorated_by_subject_plot_q)
 
     decorated_final_q <- reactive({
       sum_type <- req(input$summary_type)

R/utils.R

@@ -373,11 +373,11 @@ select_decorators <- function(decorators, scope) {
 #' This can be used to only change `recordedplot`, `ggplot2` or other type of objects.
 #' @importFrom utils modifyList
 #' @keywords internal
-modify_last_chunk_outputs_attributes <- function(teal_card,
-                                                 attributes,
-                                                 n = 1,
-                                                 inner_classes = NULL,
-                                                 quiet = FALSE) {
+set_chunk_attrs <- function(teal_card,
+                           attributes,
+                           n = 1,
+                           inner_classes = NULL,
+                           quiet = FALSE) {
   checkmate::assert_class(teal_card, "teal_card")
   checkmate::assert_list(attributes, names = "unique")
   checkmate::assert_int(n, lower = 1)
@@ -415,3 +415,34 @@ modify_last_chunk_outputs_attributes <- function(teal_card,
 
   teal_card
 }
+
+#' Create a reactive that sets plot dimensions on a teal_card
+#' 
+#' This is a convenience function that creates a reactive expression that
+#' automatically sets the dev.width and dev.height attributes on the last
+#' chunk outputs of a teal_card based on plot dimensions from a plot widget.
+#' 
+#' @param pws (`plot_widget`) plot widget that provides dimensions via `dim()` method
+#' @param decorated_output_q (`reactive`) reactive expression that returns a teal_card
+#' @param inner_classes (`character`) classes within `chunk_output` that should be modified.
+#' This can be used to only change `recordedplot`, `ggplot2` or other type of objects.
+#' 
+#' @return A reactive expression that returns the teal_card with updated dimensions
+#' 
+#' @keywords internal
+set_chunk_dims <- function(pws, decorated_output_q, inner_classes = NULL) {
+  checkmate::assert_class(pws, "plot_widget")
+  checkmate::assert_class(decorated_output_q, "reactive")
+  checkmate::assert_character(inner_classes, null.ok = TRUE)
+  
+  reactive({
+    dims <- req(pws$dim())
+    q <- req(decorated_output_q())
+    teal.reporter::teal_card(q) <- set_chunkt_attrs(
+      teal.reporter::teal_card(q), 
+      list(dev.width = dims[[1]], dev.height = dims[[2]]),
+      inner_classes = inner_classes
+    )
+    q
+  })
+}