revert

insightsengineering · Nov 24, 2022 · de76932 · de76932
1 parent 129e49a
commit de76932
Show file tree

Hide file tree

Showing 19 changed files with 125 additions and 551 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -31,7 +31,6 @@ Imports:
     styler
 Suggests:
     knitr,
-    lattice,
     magrittr,
     rmarkdown,
     shinytest2,

diff --git a/R/app_pws.R b/R/app_pws.R
diff --git a/R/app_tws.R b/R/app_tws.R
diff --git a/R/plot_with_settings.R b/R/plot_with_settings.R
@@ -315,22 +315,20 @@ plot_with_settings_srv <- function(id,
       }
     })
 
-    plot_reactive <- reactive({
-      if (plot_type() == "gg" && dblclicking) {
-        plot_r() +
-          ggplot2::coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE)
-      } else if (plot_type() == "grob") {
-        # calling grid.draw on plot_r() is needed;
-        # otherwise the plot will not re-render if the user triggers the zoom in or out feature of the browser.
-        grid::grid.newpage()
-        grid::grid.draw(plot_r())
-      } else {
-        plot_r()
-      }
-    })
-
     output$plot_modal <- output$plot_main <- renderPlot(
-      plot_reactive(),
+      expr = {
+        if (plot_type() == "gg" && dblclicking) {
+          plot_r() +
+            ggplot2::coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = FALSE)
+        } else if (plot_type() == "grob") {
+          # calling grid.draw on plot_r() is needed;
+          # otherwise the plot will not re-render if the user triggers the zoom in or out feature of the browser.
+          grid::grid.newpage()
+          grid::grid.draw(plot_r())
+        } else {
+          plot_r()
+        }
+      },
       res = get_plot_dpi()
     )
 
@@ -511,8 +509,39 @@ type_download_srv <- function(id, plot_reactive, plot_type, plot_w, default_w, p
             svg = grDevices::svg(file, width / get_plot_dpi(), height / get_plot_dpi())
           )
 
-          print_plot(plot_reactive(), plot_type())
-
+          if (plot_type() == "other") {
+            graphics::plot.new()
+            graphics::text(
+              x = graphics::grconvertX(0.5, from = "npc"),
+              y = graphics::grconvertY(0.5, from = "npc"),
+              labels = "This plot graphic type is not yet supported to download"
+            )
+          } else {
+            g <- plot_reactive()
+            wm <- grid::grid.text(
+              "DRAFT",
+              draw = FALSE,
+              rot = -45,
+              gp = grid::gpar(
+                alpha = 0.3,
+                fontface = "bold",
+                cex = 3
+              )
+            )
+            g_fin <- grid::gTree(
+              children = grid::gList(
+                if (plot_type() == "grob") {
+                  g
+                } else if (plot_type() == "gg") {
+                  ggplot2::ggplotGrob(g)
+                } else if (plot_type() == "trel") {
+                  grid::grid.grabExpr(print(g), warn = 0, wrap.grobs = TRUE)
+                },
+                wm
+              )
+            )
+            grid::grid.draw(g_fin)
+          }
           grDevices::dev.off()
         }
       )
@@ -571,51 +600,3 @@ get_plot_dpi <- function() {
   }
   dpi
 }
-
-
-
-#' Print plot for download functionality
-#'
-#' @param plot (`reactive`)\cr
-#'  reactive expression to draw a plot
-#' @param plot_type (`reactive`)\cr
-#'  reactive plot type (`gg`, `trel`, `grob`, `other`)
-#'
-#' @return Nothing returned, the plot is printed.
-#' @keywords internal
-#'
-print_plot <- function(plot, plot_type) {
-  if (plot_type == "other") {
-    graphics::plot.new()
-    graphics::text(
-      x = graphics::grconvertX(0.5, from = "npc"),
-      y = graphics::grconvertY(0.5, from = "npc"),
-      labels = "This plot graphic type is not yet supported to download"
-    )
-  } else {
-    g <- plot
-    wm <- grid::grid.text(
-      "DRAFT",
-      draw = FALSE,
-      rot = -45,
-      gp = grid::gpar(
-        alpha = 0.3,
-        fontface = "bold",
-        cex = 3
-      )
-    )
-    g_fin <- grid::gTree(
-      children = grid::gList(
-        if (plot_type == "grob") {
-          g
-        } else if (plot_type == "gg") {
-          ggplot2::ggplotGrob(g)
-        } else if (plot_type == "trel") {
-          grid::grid.grabExpr(print(g), warn = 0, wrap.grobs = TRUE)
-        },
-        wm
-      )
-    )
-    grid::grid.draw(g_fin)
-  }
-}
diff --git a/inst/tws/app.R b/inst/tws/app.R
@@ -0,0 +1,24 @@
+library(shiny)
+library(rtables)
+library(magrittr)
+library(teal.widgets)
+
+shinyApp(
+  ui = fluidPage(
+    table_with_settings_ui(
+      id = "table_with_settings"
+    )
+  ),
+  server = function(input, output, session) {
+    table_r <- reactive({
+      l <- basic_table() %>%
+        split_cols_by("ARM") %>%
+        analyze(c("SEX", "AGE"))
+
+      tbl <- build_table(l, DM)
+
+      tbl
+    })
+    table_with_settings_srv(id = "table_with_settings", table_r = table_r)
+  }
+)
diff --git a/inst/tws/tests/testthat.R b/inst/tws/tests/testthat.R
@@ -0,0 +1 @@
+shinytest2::test_app()
diff --git a/inst/tws/tests/testthat/_snaps/shinytest2.md b/inst/tws/tests/testthat/_snaps/shinytest2.md
@@ -0,0 +1,12 @@
+# {shinytest2} snapshotting inputs
+
+    "\n    \n      \n      A: Drug X\n      B: Placebo\n      C: Combination\n    \n    \n      SEX\n      \n      \n      \n    \n    \n      F\n      70\n      56\n      61\n    \n    \n      M\n      51\n      50\n      68\n    \n    \n      U\n      0\n      0\n      0\n    \n    \n      UNDIFFERENTIATED\n      0\n      0\n      0\n    \n    \n      AGE\n      \n      \n      \n    \n    \n      Mean\n      34.91\n      33.02\n      34.57\n    \n    \n        \n          \n        \n        \n      \n    \n  "
+
+# {shinytest2} txt csv download
+
+    "tab1.csv"
+
+---
+
+    "tab2.txt"
+
diff --git a/inst/tws/tests/testthat/_snaps/shinytest2/tws-001.download b/inst/tws/tests/testthat/_snaps/shinytest2/tws-001.download
@@ -0,0 +1,8 @@
+"1","","A: Drug X","B: Placebo","C: Combination"
+"2","SEX","","",""
+"3","F","70","56","61"
+"4","M","51","50","68"
+"5","U","0","0","0"
+"6","UNDIFFERENTIATED","0","0","0"
+"7","AGE","","",""
+"8","Mean","34.91","33.02","34.57"
diff --git a/inst/tws/tests/testthat/_snaps/shinytest2/tws-002.download b/inst/tws/tests/testthat/_snaps/shinytest2/tws-002.download
@@ -0,0 +1,9 @@
+                     A: Drug X   B: Placebo   C: Combination
+————————————————————————————————————————————————————————————
+SEX                                                         
+  F                     70           56             61      
+  M                     51           50             68      
+  U                      0           0              0       
+  UNDIFFERENTIATED       0           0              0       
+AGE                                                         
+  Mean                 34.91       33.02          34.57     
diff --git a/inst/tws/tests/testthat/setup.R b/inst/tws/tests/testthat/setup.R
@@ -0,0 +1,2 @@
+# Load application support files into testing environment
+shinytest2::load_app_env()
diff --git a/tests/testthat/test-tws.R → inst/tws/tests/testthat/test-shinytest2.R b/tests/testthat/test-tws.R → inst/tws/tests/testthat/test-shinytest2.R
@@ -1,45 +1,28 @@
 library(shinytest2)
-library(testthat)
 
-# launch app for all tests
-tws <- app_tws()
-app <- AppDriver$new(tws, name = "tws")
-
-# Testing snapshots
-testthat::test_that("file name and table content", {
-  skip_on_cran()
-  skip_on_ci()
-
-  # default file name
-  file_name <- app$get_value(input = "table_with_settings-downbutton-file_name")
-  file_name <- sub("_\\d{6}$", "", file_name)
-  expected_file_name <- paste0("table_", strftime(Sys.Date(),
-    format = "%Y%m%d"
-  ))
-  testthat::expect_equal(file_name, expected_file_name)
-
-  # check for table content
-  app$expect_text("table")
-})
-
-# downloading tables
-testthat::test_that("txt and csv download", {
-  skip_on_cran()
-  skip_on_ci()
-
-  # download table in .csv
+test_that("{shinytest2} txt/csv download", {
+  app <- AppDriver$new(name = "tws", height = 820, width = 1551)
   app$click("table_with_settings-downbutton-dwnl")
   app$set_inputs(`table_with_settings-downbutton-dwnl_state` = TRUE)
   app$set_inputs(`table_with_settings-downbutton-file_format` = ".csv")
   app$set_inputs(`table_with_settings-downbutton-dwnl_state` = FALSE)
   app$set_inputs(`table_with_settings-downbutton-file_name` = "tab1")
   app$expect_download("table_with_settings-downbutton-data_download")
-
-  # download table in .txt
   app$set_inputs(`table_with_settings-downbutton-file_format` = ".txt")
   app$set_inputs(`table_with_settings-downbutton-dwnl_state` = TRUE)
   app$set_inputs(`table_with_settings-downbutton-file_name` = "tab2")
   app$expect_download("table_with_settings-downbutton-data_download")
+  app$set_inputs(`table_with_settings-downbutton-dwnl_state` = FALSE)
 })
 
-app$stop()
+test_that("{shinytest2} snapshotting inputs", {
+  app <- AppDriver$new(name = "tws_filename")
+  file_name <- app$get_value(input = "table_with_settings-downbutton-file_name")
+  file_name <- sub("_\\d{6}$", "", file_name)
+  expected_file_name <- paste0("table_", strftime(Sys.Date(),
+    format = "%Y%m%d"
+  ))
+  testthat::expect_equal(file_name, expected_file_name)
+  app$expect_text("table")
+  app$stop()
+})
diff --git a/man/app_pws.Rd b/man/app_pws.Rd
diff --git a/man/app_tws.Rd b/man/app_tws.Rd
diff --git a/man/print_plot.Rd b/man/print_plot.Rd