Major update doe

R/doeFactorial.R

@@ -17,7 +17,7 @@
 
 #' @export
 doeFactorial <- function(jaspResults, dataset, options, ...) {
-  ready <- options[["selectedRow"]] != -1L
+  ready <- options[["selectedRow"]] != -1L | options[["factorialType"]] == "generalFullFactorial" # If the design type is general full factorial no need to select a design
 
   .doeFactorialDesignSummaryTable(jaspResults, options)
 
@@ -51,7 +51,7 @@ doeFactorial <- function(jaspResults, dataset, options, ...) {
     "selectedDesign2",
     "factorialType",
     "factorialTypeSpecifyGenerators",
-    "numberHTCFactors",
+    "factorialDesignTypeSplitPlotNumberHardToChangeFactors",
     "blocks",
     "centerpoints",
     "replications",
@@ -65,12 +65,12 @@ doeFactorial <- function(jaspResults, dataset, options, ...) {
   if (!is.null(jaspResults[["doeFactorialDesignSummaryTable"]])) {
     return()
   }
-  twoLevelDesign <- options[["categoricalNoLevels"]] == 2
+  twoLevelDesign <- options[["factorialType"]] != "generalFullFactorial"
   tb <- createJaspTable(title = gettext("Design Summary"), position = 1L)
   tb$addColumnInfo(name = "title", title = gettext("Variable"), type = "string")
-  tb$addColumnInfo(name = "catFactors", title = gettext("Categorial factors"), type = "integer")
+  tb$addColumnInfo(name = "catFactors", title = gettext("Discrete predictors"), type = "integer")
   tb$addColumnInfo(name = "baseRuns", title = gettext("Base runs"), type = "integer")
-  if (options[["categoricalNoLevels"]] == 2) {
+  if (twoLevelDesign) {
     tb$addColumnInfo(name = "baseBlocks", title = gettext("Base blocks"), type = "integer")
     tb$addColumnInfo(name = "centerpoints", title = gettext("Centre points per block"), type = "integer")
   }
@@ -84,26 +84,31 @@ doeFactorial <- function(jaspResults, dataset, options, ...) {
   tb[["title"]] <- gettext("Value")
   tb[["catFactors"]] <- options[["numberOfCategorical"]]
   designSpec <- .doeFactorialGetSelectedDesign(jaspResults, options)
-  if (length(designSpec) == 0L) { # user did not select a design
+  if (options[["factorialType"]] != "generalFullFactorial" && length(designSpec) == 0L) { # user did not select a design
     tb$addFootnote(gettext("Please select a row in the design table."))
     return()
   }
-  tb[["baseRuns"]] <- designSpec[["runs"]]
-  if (options[["categoricalNoLevels"]] == 2) {
-    tb[["baseBlocks"]] <- designSpec[["blocks"]]
-    tb[["centerpoints"]] <- designSpec[["centerpoints"]]
-  }
   tb[["replications"]] <- designSpec[["replications"]]
   tb[["repetitions"]] <- designSpec[["repetitions"]]
   if (twoLevelDesign) {
-    tb[["totalRuns"]] <- (designSpec[["runs"]] * designSpec[["replications"]]) + (designSpec[["blocks"]] * designSpec[["centerpoints"]] * designSpec[["replications"]]) + designSpec[["repetitions"]]
+    tb[["baseRuns"]] <- designSpec[["runs"]]
+    tb[["baseBlocks"]] <- designSpec[["blocks"]]
+    tb[["centerpoints"]] <- designSpec[["centerpoints"]]
+    runs <- (designSpec[["runs"]] * designSpec[["replications"]]) + (designSpec[["blocks"]] * designSpec[["centerpoints"]] * designSpec[["replications"]]) + designSpec[["repetitions"]]
+    tb[["totalRuns"]] <- runs
     tb[["totalBlocks"]] <- designSpec[["replications"]] * designSpec[["blocks"]]
   } else {
     df <- .doeRsmCategorical2df(options[["categoricalVariables"]])
-    nLevels <- apply(df, 1, function(x) length(which(x[-1] != ".")))
-    tb[["totalRuns"]] <- prod(nLevels) * designSpec[["replications"]] + designSpec[["repetitions"]]
+    nLevels <- apply(df, 1, function(x) length(which(x[-1] != "")))
+    runs <- prod(nLevels) * designSpec[["replications"]] + designSpec[["repetitions"]]
+    tb[["baseRuns"]] <- runs
+    tb[["totalRuns"]] <- runs
     tb[["totalBlocks"]] <- designSpec[["replications"]]
   }
+  if (!is.na(runs) && runs > 1e+05) {
+    tb$setError(gettext("Cannote create designs with more than 100000 total runs."))
+    return()
+  }
   if (!options[["displayDesign"]]) {
     tb$addFootnote(gettext("Click 'Display design' to show the design."))
   }
@@ -118,7 +123,7 @@ doeFactorial <- function(jaspResults, dataset, options, ...) {
 
 .doeFactorialGetSelectedDesign <- function(jaspResults, options) {
   row <- options[["selectedRow"]] + 1L
-  if (row <= 0L) {
+  if (row <= 0L && options[["factorialType"]] != "generalFullFactorial") {
     return(list())
   }
   design <- .doeFactorialDefaultDesigns(jaspResults, options, row)
@@ -127,13 +132,97 @@ doeFactorial <- function(jaspResults, dataset, options, ...) {
 
 .doeFactorialDefaultDesigns <- function(jaspResults, options, row) {
   nFactors <- options[["numberOfCategorical"]]
-  twoLevelDesign <- options[["categoricalNoLevels"]] == 2
+  twoLevelDesign <- options[["factorialType"]] != "generalFullFactorial"
   if (!twoLevelDesign) {
+    row <- 1
     designs <- data.frame(
       name = "Full factorial",
       runs = options[["categoricalNoLevels"]]^nFactors,
       resolution = "Full"
     )
+  } else if (options[["factorialType"]] == "factorialTypeSplit") {
+    nHtcFactors <- options[["factorialDesignTypeSplitPlotNumberHardToChangeFactors"]]
+    if (nFactors == 2) {
+      designs <- data.frame(
+        name = "Full factorial",
+        runs = 4,
+        resolution = "Full"
+      )
+    } else if (nFactors == 3) {
+      designs <- data.frame(
+        name = "Full factorial",
+        runs = 8,
+        resolution = "Full"
+      )
+    } else if (nFactors == 4) {
+      if (nHtcFactors == 1) {
+        designs <- data.frame(
+          name = c("1/2 fraction", "Full factorial"),
+          runs = c(8, 16),
+          resolution = c("IV", "Full")
+        )
+      } else {
+        designs <- data.frame(
+          name = "Full factorial",
+          runs = 16,
+          resolution = "Full"
+        )
+      }
+    } else if (nFactors == 5) {
+      if (nHtcFactors == 1) {
+        designs <- data.frame(
+          name = c("1/4 fraction", "1/2 fraction", "Full factorial"),
+          runs = c(8, 16, 32),
+          resolution = c("III", "V", "Full")
+        )
+      } else if (nHtcFactors == 2) {
+        designs <- data.frame(
+          name = c("1/2 fraction", "Full factorial"),
+          runs = c(16, 32),
+          resolution = c("V", "Full")
+        )
+      } else {
+        designs <- data.frame(
+          name = "Full factorial",
+          runs = 32,
+          resolution = "Full"
+        )
+      }
+    } else if (nFactors == 6) {
+      if (nHtcFactors <= 2) {
+        designs <- data.frame(
+          name = c("1/4 fraction", "1/2 fraction", "Full factorial"),
+          runs = c(16, 32, 64),
+          resolution = c("IV", "VI", "Full")
+        )
+      } else {
+        designs <- data.frame(
+          name = c("1/2 fraction", "Full factorial"),
+          runs = c(32, 64),
+          resolution = c("VI", "Full")
+        )
+      }
+    } else if (nFactors == 7) {
+      if (nHtcFactors <= 2) {
+        designs <- data.frame(
+          name = c("1/4 fraction", "1/2 fraction", "Full factorial"),
+          runs = c(32, 64, 128),
+          resolution = c("IV", "VII", "Full")
+        )
+      } else {
+        designs <- data.frame(
+          name = c("1/2 fraction", "Full factorial"),
+          runs = c(64, 128),
+          resolution = c("VII", "Full")
+        )
+      }
+    } else if (nFactors > 7) {
+      designs <- data.frame(
+        name = "Full factorial",
+        runs = 2^nFactors,
+        resolution = "Full"
+      )
+    }
   } else {
     if (nFactors == 2) {
       designs <- data.frame(
@@ -217,7 +306,7 @@ doeFactorial <- function(jaspResults, dataset, options, ...) {
 
 .doeFactorialGenerateDesign <- function(jaspResults, options) {
   seed <- .doeGetAndSetSeed(jaspResults, options)
-  twoLevelDesign <- options[["categoricalNoLevels"]] == 2
+  twoLevelDesign <- options[["factorialType"]] != "generalFullFactorial"
   df <- .doeRsmCategorical2df(options[["categoricalVariables"]])
   designSpec <- .doeFactorialGetSelectedDesign(jaspResults, options)
   if (length(designSpec) == 0) {
@@ -259,14 +348,14 @@ doeFactorial <- function(jaspResults, dataset, options, ...) {
       design <- FrF2::FrF2(
         nfactors = designSpec[["factors"]],
         nruns = designSpec[["runs"]],
-        hard = options[["numberHTCFactors"]],
+        hard = options[["factorialDesignTypeSplitPlotNumberHardToChangeFactors"]],
         replications = designSpec[["replications"]],
         alias.block.2fis = TRUE,
         seed = seed
       )
     }
   } else {
-    nLevels <- apply(df, 1, function(x) length(which(x[-1] != ".")))
+    nLevels <- apply(df, 1, function(x) length(which(x[-1] != "")))
     design <- DoE.base::fac.design(
       nfactors = designSpec[["factors"]],
       nlevels = nLevels,
@@ -412,7 +501,7 @@ doeFactorial <- function(jaspResults, dataset, options, ...) {
   }
   tb$dependOn(options = c("displayDesign", "codedOutput", "runOrder", .doeFactorialBaseDependencies()))
   if (options[["factorialType"]] == "factorialTypeSplit") {
-    tb$addFootnote(gettextf("Hard-to-change factors: %1$s", paste0(df[["name"]][1:options[["numberHTCFactors"]]], collapse = ", ")))
+    tb$addFootnote(gettextf("Hard-to-change factors: %1$s", paste0(df[["name"]][1:options[["factorialDesignTypeSplitPlotNumberHardToChangeFactors"]]], collapse = ", ")))
   }
   jaspResults[["displayDesign"]] <- tb
   if (jaspResults$getError()) {

R/doeResponseSurfaceMethodology.R

@@ -39,8 +39,8 @@ doeResponseSurfaceMethodology <- function(jaspResults, dataset, options, ...) {
 
   tb <- createJaspTable(title = gettext("Design Summary"), position = 1L)
   tb$addColumnInfo(name = "title",       title = gettext("Variable"),               type = "string")
-  tb$addColumnInfo(name = "contFactors", title = gettext("Continuous factors"),     type = "integer")
-  tb$addColumnInfo(name = "catFactors",  title = gettext("Categorical factors"),    type = "integer")
+  tb$addColumnInfo(name = "contFactors", title = gettext("Continuous predictors"),     type = "integer")
+  tb$addColumnInfo(name = "catFactors",  title = gettext("Discrete predictors"),    type = "integer")
 
   tb$addColumnInfo(name = "baseRuns",    title = gettext("Base runs"),              type = "integer")
   tb$addColumnInfo(name = "baseBlocks",  title = gettext("Base blocks"),            type = "integer")
@@ -114,6 +114,7 @@ doeResponseSurfaceMethodology <- function(jaspResults, dataset, options, ...) {
 .doeRsmCategorical2df <- function(tableView) {
   df <- do.call(cbind.data.frame, lapply(tableView, `[[`, "values"))
   if (ncol(df) == 0L) return(df)
+  df <- df[, !apply(df, 2, function(col) all(col == ""))]
   colnames(df) <- c("name", paste0("level", seq_len(ncol(df) - 1L)))
   return(df)
 }
@@ -133,11 +134,11 @@ doeResponseSurfaceMethodology <- function(jaspResults, dataset, options, ...) {
   tb$addColumnInfo(name = "std.order", title = gettext("Standard order"), type = "integer")
 
   for (i in seq_len(options[["numberOfContinuous"]]))
-    tb$addColumnInfo(name = paste0("x", i), title = options[["continuousVariables"]][[1L]][["values"]][i],     type = "number", overtitle = gettext("Continuous factors"))
+    tb$addColumnInfo(name = paste0("x", i), title = options[["continuousVariables"]][[1L]][["values"]][i],     type = "number", overtitle = gettext("Continuous predictors"))
 
   noCat <- options[["numberOfCategorical"]]
   for (i in seq_len(noCat))
-    tb$addColumnInfo(name = paste0("x_cat", i), title = options[["continuousVariables"]][[1L]][["values"]][i], type = "number", overtitle = gettext("Categorical factors"))
+    tb$addColumnInfo(name = paste0("x_cat", i), title = options[["categoricalVariables"]][[1L]][["values"]][i], type = "number", overtitle = gettext("Discrete predictors"))
 
   # avoid any shenanigans with categorical factors having duplicate names
   if (noCat > 0L)
@@ -457,64 +458,64 @@ doeResponseSurfaceMethodology <- function(jaspResults, dataset, options, ...) {
 # old code ----
 
 .doeRsmAnalysisThatMayBreak <- function(jaspResults, dataset, options) {
-  
+
   op1 <- length(options[["modelTerms"]])
   op2 <- length(options[["rsmResponseVariables"]])
   op3 <- length(options[["rsmBlocks"]])
-  
+
   ready <- (op1 > 0 && op2 > 0) && any(options[["contour"]], options[["coef"]], options[["anova"]],
                                        options[["res"]], options[["pareto"]], options[["resNorm"]], options[["ResFitted"]],
                                        options[["displayDesign"]], options[["desirability"]],
                                        options[["contour"]])
-  
+
   if (!ready)
     return()
-  
+
   for (i in 1:op2) {
-    
+
     data <- .readDataSet(jaspResults, options, dataset, i)
-    
+
     #check for more than 5 unique
     .dataErrorCheck(data, options)
-    
+
     rsm[[i]] <- .responseSurfaceCalculate(jaspResults, options, dataset, data)
-    
+
     # if (options[["showDesign"]])
     #   .qualityControlDesignMainRSM(jaspResults,options, position = 1)
-    
+
     if (options[["contour"]])
       .responseSurfaceContour(jaspResults, options, data, rsm[[i]], i, position = 2)
-    
-    
+
+
     if (options[["coef"]])
       .responseSurfaceTableCall(jaspResults, options, rsm[[i]], i, position = 3)
-    
+
     if (options[["anova"]])
       .responseSurfaceTableAnovaCall(jaspResults, options, rsm = rsm[[i]], i, position = 4)
-    
+
     # if(options[["eigen"]])
     #   .responseSurfaceTableEigenCall(jaspResults, options, rsm, position = 5)
-    
+
     if (options[["res"]])
       .responsePlotResidualCall(jaspResults, options, rsm[[i]], i, position = 6)
-    
+
     if (options[["normalPlot"]])
       .responseNomralProbabilityPlot(data, jaspResults, options, rsm[[i]], i, position = 7)
-    
+
     if (options[["pareto"]])
       .responsePlotPareto(jaspResults, options, rsm[[i]], i, position = 8)
-    
+
     if (options[["resNorm"]])
       .responsePlotResNorm(jaspResults, options, rsm[[i]], i, position = 9)
-    
+
     if (options[["ResFitted"]])
       .responsePlotResFitted(jaspResults, options, rsm[[i]],i, position = 10)
-    
+
     if (options[["fourInOne"]])
       .responseFourInOnePlot(jaspResults, options, rsm[[i]],i, position = 11)
-    
+
   }
-  
+
   if (options[["desirability"]])
     .responseSurfaceOptimize(jaspResults, options, rsm, data, position = 11, dataset)
 }

inst/qml/common/ShowAndExportDesign.qml

@@ -23,7 +23,7 @@ Group
 {
 
 	columns : 1
-	CheckBox { name: "displayDesign"; label: qsTr("Display design"); checked: false 
+	CheckBox { name: "displayDesign"; label: qsTr("Display design"); checked: true 
 		CheckBox{ name: "codedOutput";	label: qsTr("Coded units")}
 		RadioButtonGroup
 		{