diff --git a/DESCRIPTION b/DESCRIPTION index 7f97acc..beca19d 100644 --- a/DESCRIPTION +++ b/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 = "tylermw@gmail.com", role = c("aut", "cre")), person("George", "Khoury", email = "george.m.khoury@gmail.com", 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) . diff --git a/R/eval_design_mc.R b/R/eval_design_mc.R index 6a946f0..940f395 100644 --- a/R/eval_design_mc.R +++ b/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) { diff --git a/R/skprGUI.R b/R/skprGUI.R index 23779bd..20d33af 100644 --- a/R/skprGUI.R +++ b/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,7 +2438,7 @@ 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()) @@ -2446,7 +2446,7 @@ skprGUI = function(browser = FALSE, return_app = FALSE, multiuser = FALSE, progr }, 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")) { diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf index 3e61392..6d25ec3 100644 Binary files a/tests/testthat/Rplots.pdf and b/tests/testthat/Rplots.pdf differ diff --git a/tests/testthat/testExampleCode.R b/tests/testthat/testExampleCode.R index 5a5c7c9..8b94240 100644 --- a/tests/testthat/testExampleCode.R +++ b/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") - - })