fix: problem when dimensions is not yet known

Author: averissimo

R/tm_outliers.R

@@ -1101,7 +1101,10 @@ srv_outliers <- function(id, data, outlier_var,
 
     pws_list <- list(box_plot = box_pws, density_plot = density_pws, cumulative_plot = cum_density_pws)
     decorated_final_q <- reactive({
-      set_chunk_dims(pws_list[[req(current_tab_r())]], decorated_q[[current_tab_r()]])()
+      pws <- pws_list[[req(current_tab_r())]]
+      req(pws$dim())
+      req(decorated_q[[current_tab_r()]]())
+      set_chunk_dims(pws, decorated_q[[current_tab_r()]])()
     })
 
     summary_table_r <- reactive({

R/utils.R

@@ -425,26 +425,32 @@ set_chunk_attrs <- function(teal_card,
 #' 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 q_r (`reactive`) reactive expression that returns a `teal_reporter`
 #' @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) {
+set_chunk_dims <- function(pws, q_r, inner_classes = NULL) {
   checkmate::assert_list(pws)
   checkmate::assert_names(names(pws), must.include = "dim")
   checkmate::assert_class(pws$dim, "reactive")
-  checkmate::assert_class(decorated_output_q, "reactive")
+  checkmate::assert_class(q_r, "reactive")
   checkmate::assert_character(inner_classes, null.ok = TRUE)
 
   reactive({
-    dims <- req(pws$dim())
-    q <- req(decorated_output_q())
+    pws_dim <- stats::setNames(as.list(req(pws$dim())), c("width", "height"))
+    if (identical(pws_dim$width, "auto")) { # ignore non-numeric values (such as "auto")
+      pws_dim$width <- NULL
+    }
+    if (identical(pws_dim$height, "auto")) { # ignore non-numeric values (such as "auto")
+      pws_dim$height <- NULL
+    }
+    q <- req(q_r())
     teal.reporter::teal_card(q) <- set_chunk_attrs(
       teal.reporter::teal_card(q),
-      list(dev.width = dims[[1]], dev.height = dims[[2]]),
+      list(dev.width = pws_dim$width, dev.height = pws_dim$height),
       inner_classes = inner_classes
     )
     q

tests/testthat/test-utils.R

@@ -47,3 +47,18 @@ testthat::describe("set_chunk_attrs", {
     testthat::expect_equal(attributes(new_card[[3]]), list(class = "chunk_output"))
   })
 })
+
+testthat::describe("set_chunk_dims", {
+  it("skips when one of the dimensions is auto string", {
+    pws <- list(dim = shiny::reactive(list("auto", 200)))
+    q <- teal.reporter::teal_report()
+    teal.reporter::teal_card(q) <- teal.reporter::teal_card("## Header", structure(list(2), class = "chunk_output"))
+    q_r <- shiny::reactive(q)
+
+    q_dims_r <- set_chunk_dims(pws, q_r)
+    testthat::expect_equal(
+      attributes(teal.reporter::teal_card(shiny::isolate(q_dims_r()))[[2]]),
+      list(class = "chunk_output", dev.height = 200)
+    )
+  })
+})