skpr v1.7.3: Properly validate inputs when restoring previous state i…

…n skprGUI()

-`eval_design_mc()` all functions are exported to future

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: skpr
 Title: Design of Experiments Suite: Generate and Evaluate Optimal Designs
-Date: 2024-03-29
-Version: 1.7.2
+Date: 2024-07-11
+Version: 1.7.3
 Authors@R: c(person("Tyler", "Morgan-Wall", email = "[email protected]", role = c("aut", "cre")),
              person("George", "Khoury", email = "[email protected]", role = c("aut")))
 Description: Generates and evaluates D, I, A, Alias, E, T, and G optimal designs. Supports generation and evaluation of blocked and split/split-split/.../N-split plot designs. Includes parametric and Monte Carlo power evaluation functions, and supports calculating power for censored responses. Provides a framework to evaluate power using functions provided in other packages or written by the user. Includes a Shiny graphical user interface that displays the underlying code used to create and evaluate the design to improve ease-of-use and make analyses more reproducible. For details, see Morgan-Wall et al. (2021) <doi:10.18637/jss.v099.i01>.

R/eval_design_mc.R

@@ -768,10 +768,7 @@ eval_design_mc = function(design, model = NULL, alpha = 0.05,
       set_up_progressr_handler(sprintf("Evaluating %s",progress_message), "sims")
     }
     modelmat = model.matrix(model_formula, data=RunMatrixReduced,contrasts = contrastslist)
-    packagelist = c()
-    if(firth) {
-      packagelist = "mbest"
-    }
+    packagelist = c("mbest", "lmerTest", "skpr", "lme4", "lmtest", "car" )
     nc =  future::nbrOfWorkers()
     run_search = function(iterations, is_shiny) {
       prog = progressr::progressor(steps = nsim)
@@ -782,7 +779,7 @@ eval_design_mc = function(design, model = NULL, alpha = 0.05,
                                                            "responses", "contrastslist", "model_formula", "glmfamily", "glmfamilyname", "calceffect",
                                                            "anovatype", "pvalstring", "anovatest", "firth", "effect_terms", "effect_anova", "method",
                                                            "modelmat", "aliasing_checked", "parameter_names", "progressbarupdates",
-                                                           "alpha_parameter", "alpha_effect", "prog", "nsim", "num_updates", "nc"),
+                                                           "alpha_parameter", "alpha_effect", "prog", "nsim", "num_updates", "nc", "_skpr_genOptimalDesign"),
                                                seed = TRUE)) %dofuture% {
         if(j %in% progressbarupdates) {
           if(is_shiny) {

R/skprGUI.R

@@ -1214,7 +1214,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
     }, label = "multiuser_observer_runmatrix", priority = 2)
 
     multiuser_helper_glm = observe({
-      req(powerresultsglm_container())
+      req(powerresultsglm_container(), cancelOutput = TRUE)
       if(multiuser && evaluationtype() == "glm") {
         invalidateLater(500)
         power_results_glm_resolved = future::resolved(powerresultsglm_container())
@@ -1269,7 +1269,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
     }, label = "multiuser_observer_glm", priority = 1)
 
     multiuser_helper_surv = observe({
-      req(powerresultssurv_container())
+      req(powerresultssurv_container(), cancelOutput = TRUE)
       if(multiuser && evaluationtype() == "surv") {
         invalidateLater(500)
         power_results_surv_resolved = future::resolved(powerresultssurv_container())
@@ -1448,7 +1448,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
         disclevels_n = sprintf("disclevels%i",i)
         levels_n = sprintf("levels%i",i)
         blockdepth_n = sprintf("blockdepth%i",i)
-
+        req(input[[factortype_n]], cancelOutput = TRUE)
         if (input[[factortype_n]] == "numeric") {
           candidateset1[[ input[[factorname_n]] ]] = seq(input[[numericlow_n]], input[[numerichigh_n]], length.out = input[[numericlength_n]])
         }
@@ -1463,7 +1463,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
     })
 
     inputstring = reactive({
-      req(update)
+      req(update, cancelOutput = TRUE)
       updatevector = list()
       finalstring = c()
       commacount = input$numberfactors - 1
@@ -1477,7 +1477,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
         levels_n = sprintf("levels%i",i)
         blockdepth_n = sprintf("blockdepth%i",i)
         finalstring = c(finalstring, input[[factorname_n]], " = ")
-        req(input[[factortype_n]])
+        req(input[[factortype_n]], cancelOutput = TRUE)
         if (input[[factortype_n]] == "numeric") {
           finalstring = c(finalstring, "seq(", input[[numericlow_n]], ",", input[[numerichigh_n]], ", length.out = ", input[[numericlength_n]], ")")
         }
@@ -2115,7 +2115,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
 
     ###### Power Results GLM ######
     powerresultsglm_container = reactive({
-      req(runmatrix())
+      req(runmatrix(), cancelOutput = TRUE)
       if (evaluationtype() == "glm") {
         if(!multiuser) {
           if(!as.logical(input$parallel_eval_glm) && skpr_progress) {
@@ -2250,7 +2250,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
 
     ###### Power Results Survival ######
     powerresultssurv_container = reactive({
-      req(runmatrix())
+      req(runmatrix(), cancelOutput = TRUE)
 
       if(!multiuser && (!as.logical(input$parallel_eval_surv) && skpr_progress)) {
         pb = inc_progress_session
@@ -2273,7 +2273,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
       if (evaluationtype() == "surv") {
         if(input$distribution == "lognormal" && input$censorpoint <= 0) {
           showNotification(sprintf("When calculating power for a lognormal survival model, the censor point must be greater than 0 (currently set to %0.2f).", input$censorpoint), type = "warning", duration = 10)
-          req(input$distribution == "lognormal" && input$censorpoint > 0)
+          req(input$distribution == "lognormal" && input$censorpoint > 0, cancelOutput = TRUE)
         } else {
           if (input$setseed) {
             set.seed(input$seed)
@@ -2420,7 +2420,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
     }
 
     output$runmatrix = gt::render_gt({
-      req(runmatrix())
+      req(runmatrix(), cancelOutput = TRUE)
       ord_design = input$orderdesign
       trials =  isolate(input$trials)
       opt = isolate(input$optimality)
@@ -2438,15 +2438,15 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
     }
 
     output$powerresults = gt::render_gt( {
-      req(powerresults())
+      req(powerresults(), cancelOutput = TRUE)
       alpha = isolate(input$alpha)
       colorblind = isolate(input$colorblind)
       pwr_results = filter_power_results(powerresults())
       format_table(pwr_results, gt::gt(pwr_results), alpha, 0,colorblind)
     }, align = "left")
 
     output$powerresultsglm = gt::render_gt({
-      req(powerresultsglm())
+      req(powerresultsglm(), cancelOutput = TRUE)
       alpha = isolate(input$alpha)
       nsim = isolate(input$nsim)
       colorblind = isolate(input$colorblind)
@@ -2456,7 +2456,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
       bindEvent(powerresultsglm())
 
     output$powerresultssurv = gt::render_gt({
-      req(powerresultssurv())
+      req(powerresultssurv(), cancelOutput = TRUE)
       alpha = isolate(input$alpha)
       nsim_surv = isolate(input$nsim_surv)
       colorblind = isolate(input$colorblind)
@@ -2466,7 +2466,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
       bindEvent(powerresultssurv())
 
     output$aliasplot = renderPlot({
-      req(runmatrix())
+      req(runmatrix(), cancelOutput = TRUE)
       if(displayed_design_number_factors() > 1) {
         runmatrix() %>%
           plot_correlations()
@@ -2522,7 +2522,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr
       bindEvent(runmatrix())
 
     output$optimalsearch = renderPlot({
-      req(runmatrix())
+      req(runmatrix(), cancelOutput = TRUE)
       optimal_design_plot = function(runmat) {
         if (isolate(optimality()) %in% c("D", "G", "A")) {
           if(attr(runmat, "blocking") || attr(runmat, "splitplot")) {

tests/testthat/testExampleCode.R

@@ -1,4 +1,5 @@
 library(lme4)
+library(skpr)
 
 context("Run Examples")
 
@@ -78,6 +79,7 @@ test_that("eval_design example code runs without errors", {
 test_that("gen_design parallel example code runs without errors", {
   prev_options = options()
   options("skpr_progress" = FALSE)
+  options(cores = 2)
   on.exit(options(prev_options), add = TRUE)
   skip_on_cran()
   set.seed(1)
@@ -86,19 +88,19 @@ test_that("gen_design parallel example code runs without errors", {
                           Vineyard = as.factor(c("A", "B", "C", "D")),
                           Age = c(1, -1))
 
-  options(cores = 2)
   gen_design(candlist3, ~Location, trials = 6, parallel = TRUE, progress = FALSE)
   expect_silent(gen_design(candlist3, ~Location, trials = 6, parallel = TRUE, progress = FALSE) -> temp)
   expect_silent(gen_design(candlist3, ~Location + Climate, trials = 12, splitplotdesign = temp, blocksizes = rep(2, 6), parallel = TRUE, progress = FALSE) -> temp)
   expect_silent(gen_design(candlist3, ~Location, trials = 6, parallel = TRUE, progress = FALSE) -> temp)
   expect_silent(gen_design(candlist3, ~Location + Climate, trials = 12, splitplotdesign = temp, blocksizes = rep(2, 6), parallel = TRUE, progress = FALSE) -> temp2)
+  #Evaluate once to remove package load warnings
+  eval_design_mc(temp, ~., 0.2, nsim = 10, parallel = TRUE, progress = FALSE)
   expect_silent(eval_design_mc(temp, ~., 0.2, nsim = 10, parallel = TRUE, progress = FALSE))
+
   expect_silent(eval_design_mc(temp2, ~., 0.2, nsim = 10, parallel = TRUE, progress = FALSE))
   expect_silent(eval_design_mc(temp, ~., 0.2, nsim = 10, glmfamily = "poisson", effectsize = c(1, 10), parallel = TRUE))
   expect_silent(eval_design_mc(temp2, ~., 0.2, nsim = 10, glmfamily = "poisson", effectsize = c(1, 10), parallel = TRUE))
   expect_warning(eval_design_mc(temp, ~., 0.2, nsim = 10, glmfamily = "poisson"), " This can lead to unrealistic effect sizes")
-
-
 })