skpr v1.5.1 Add shiny app testing via shinytest2 and fix contrasts on…

… custom and survival evaluation functions

-`eval_design_mc()` Ignore firth argument when glmfamily != "binomial"
-`eval_design_mc()` Fix glmfamily comparison

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: skpr
 Title: Design of Experiments Suite: Generate and Evaluate Optimal Designs
-Date: 2023-10-31
-Version: 1.5.0
+Date: 2023-11-08
+Version: 1.5.1
 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>.
@@ -33,7 +33,7 @@ Imports:
     doFuture,
     progressr
 LinkingTo: Rcpp, RcppEigen
-Suggests: testthat, mbest, ggplot2, lmtest, cli, gridExtra, rintrojs, shinythemes, shiny, shinyjs, gt
+Suggests: testthat, mbest, ggplot2, lmtest, cli, gridExtra, rintrojs, shinythemes, shiny, shinyjs, gt, shinytest2
 Encoding: UTF-8
 URL: https://github.com/tylermorganwall/skpr,
     https://tylermorganwall.github.io/skpr/

R/eval_design_custom_mc.R

@@ -54,8 +54,8 @@
 #'#To begin, first let us generate the same design and random generation function shown in the
 #'#eval_design_survival_mc examples:
 #'
-#'basicdesign = expand.grid(a = c(-1, 1))
-#'design = gen_design(candidateset = basicdesign, model = ~a, trials = 100,
+#'basicdesign = expand.grid(a = c(-1, 1), b = c("a","b","c"))
+#'design = gen_design(candidateset = basicdesign, model = ~a + b + a:b, trials = 100,
 #'                          optimality = "D", repeats = 100)
 #'
 #'#Random number generating function
@@ -87,15 +87,13 @@
 #'#And now we evaluate the design, passing the fitting function and p-value extracting function
 #'#in along with the standard inputs for eval_design_mc.
 #'#This has the exact same behavior as eval_design_survival_mc for the exponential distribution.
-#'d = eval_design_custom_mc(design = design, model = ~a,
-#'                          alpha = 0.05, nsim = 100,
-#'                          fitfunction = fitsurv, pvalfunction = pvalsurv,
-#'                          rfunction = rsurvival, effectsize = 1)
-#'
+#'eval_design_custom_mc(design = design, model = ~a + b + a:b,
+#'                      alpha = 0.05, nsim = 100,
+#'                      fitfunction = fitsurv, pvalfunction = pvalsurv,
+#'                      rfunction = rsurvival, effectsize = 1)
 #'#We can also use skpr's framework for parallel computation to automatically parallelize this
 #'#to speed up computation
-#'\dontrun{
-#'d = eval_design_custom_mc(design = design, model = ~a,
+#'\dontrun{eval_design_custom_mc(design = design, model = ~a + b + a:b,
 #'                          alpha = 0.05, nsim = 1000,
 #'                          fitfunction = fitsurv, pvalfunction = pvalsurv,
 #'                          rfunction = rsurvival, effectsize = 1,
@@ -195,6 +193,7 @@ eval_design_custom_mc = function(design, model = NULL, alpha = 0.05,
   for (x in names(RunMatrixReduced[lapply(RunMatrixReduced, class) %in% c("character", "factor")])) {
     if (!(x %in% names(presetcontrasts))) {
       contrastslist[[x]] = contrasts
+      stats::contrasts(RunMatrixReduced[[x]]) = contrasts
     } else {
       contrastslist[[x]] = presetcontrasts[[x]]
     }

R/eval_design_mc.R

@@ -233,7 +233,7 @@ eval_design_mc = function(design, model = NULL, alpha = 0.05,
                           effectsize = 2, contrasts = contr.sum, parallel = FALSE,
                           adjust_alpha_inflation = FALSE,
                           detailedoutput = FALSE, progress = TRUE, advancedoptions = NULL, ...) {
-  if(!firth) {
+  if(!firth || glmfamily != "binomial") {
     method = "glm.fit"
   } else {
     if(!(length(find.package("mbest", quiet = TRUE)) > 0)) {
@@ -334,7 +334,7 @@ eval_design_mc = function(design, model = NULL, alpha = 0.05,
     advancedoptions$progress_msg = "Type-I Error"
     nullresults = eval_design_mc(design = design, model = model, alpha = alpha,
                    blocking = blocking, nsim = nsim, glmfamily = glmfamily,
-                   calceffect = calceffect, effect_anova = effect_anova,
+                   calceffect = calceffect, effect_anova = effect_anova, adjust_alpha_inflation = FALSE,
                    varianceratios = varianceratios, rfunction = rfunction, anticoef = anticoef, firth = firth,
                    effectsize = effectsizetemp, contrasts = contrasts, parallel = parallel,
                    detailedoutput = detailedoutput, advancedoptions = advancedoptions, ...)
@@ -566,7 +566,7 @@ eval_design_mc = function(design, model = NULL, alpha = 0.05,
     anovatype = "III"
   }
   #-------------- -------------#
-  if(effect_anova && firth && glmfamily == "binomial" && !alpha_adjust) {
+  if(effect_anova && firth && glmfamilyname == "binomial" && !alpha_adjust) {
     warning(r"(skpr uses a likelihood ratio test (instead of a type-III ANOVA) for",
       "effect power when `firth = TRUE` and `glmfamily = "binomial"`: setting `effect_lr = TRUE`.)")
   }

R/eval_design_survival_mc.R

@@ -235,6 +235,7 @@ eval_design_survival_mc = function(design, model = NULL, alpha = 0.05,
   for (x in names(RunMatrixReduced)[lapply(RunMatrixReduced, class) %in% c("character", "factor")]) {
     if (!(x %in% names(presetcontrasts))) {
       contrastslist[[x]] = contrasts
+      stats::contrasts(RunMatrixReduced[[x]]) = contrasts
     } else {
       contrastslist[[x]] = presetcontrasts[[x]]
     }

R/skprGUI.R

@@ -5,14 +5,15 @@
 #'@param inputValue1 Required by Shiny
 #'@param inputValue2 Required by Shiny
 #'@param browser Default `FALSE`. Whether to open the application in an external browser.
+#'@param return_app Default `FALSE`. If `TRUE`, this will return the shinyApp object.
 #'
 #'@import doRNG
 #'@export
 #'@examples
 #'#Type `skprGUI()` to begin
 #'
 # nocov start
-skprGUI = function(inputValue1, inputValue2, browser = FALSE) {
+skprGUI = function(browser = FALSE, return_app = FALSE) {
   check_for_suggest_packages(c("shiny","shinythemes","shinyjs","gt","rintrojs"))
   skpr_progress = getOption("skpr_progress",  TRUE)
 
@@ -481,10 +482,7 @@ skprGUI = function(inputValue1, inputValue2, browser = FALSE) {
                 min = 0,
                 max = 1,
                 value = c(0.4, 0.6)
-              )
-            ),
-            conditionalPanel(
-              condition = "input.evaltype == \'glm\'",
+              ),
               checkboxInput(
                 inputId = "firth_correction",
                 "Use Firth Correction",
@@ -1140,7 +1138,7 @@ skprGUI = function(inputValue1, inputValue2, browser = FALSE) {
           first = paste(c(first, ", <br>", rep("&nbsp;", 15),
                           "glmfamily = \"", input$glmfamily, "\""), collapse = "")
         }
-        if (input$adjust_error) {
+        if (input$adjust_alpha) {
           first = paste(c(first, ", <br>", rep("&nbsp;", 15),
                           "adjust_alpha_inflation  = TRUE"), collapse = "")
         } else {
@@ -2077,6 +2075,9 @@ skprGUI = function(inputValue1, inputValue2, browser = FALSE) {
                  ))
     outputOptions(output, "separationwarning", suspendWhenHidden = FALSE)
   }
+  if(return_app) {
+    return(shinyApp(ui, server, enableBookmarking = "url"))
+  }
   if(browser) {
     runGadget(shinyApp(ui, server, enableBookmarking = "url"), viewer = browserViewer())
   } else {

tests/testthat/apps/app.R

@@ -0,0 +1,6 @@
+library(skpr)
+
+options("skpr_progress" = FALSE)
+on.exit(options("skpr_progress" = NULL), add = TRUE)
+skprGUI(return_app = TRUE)
+

tests/testthat/apps/tests/testthat.R

@@ -0,0 +1 @@
+shinytest2::test_app()