Fixes after updating to R4.3.1 and some cleanup (#279)

* Fix unit tests under R4.3.1 * Some code cleaning and removal * Inconsistent line
jasp-stats · Sep 26, 2023 · 45452e9 · 45452e9
1 parent 9452f4e
commit 45452e9
Show file tree

Hide file tree

Showing 17 changed files with 78 additions and 150 deletions.
diff --git a/R/attributesCharts.R b/R/attributesCharts.R
@@ -27,7 +27,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
 
   # Data reading
   if (is.null(dataset))
-    if (timeStamp != "") {
+    if (!identical(timeStamp, "")) {
       dataset <- .readDataSetToEnd(columns.as.numeric = numeric_variables, columns.as.factor = timeStamp)
       xLabs <- as.vector(dataset[, timeStamp])
     } else {
@@ -159,7 +159,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
     }
   }
   #ImRchart for attributes
-  if (options$Attributes == "ImR" && D != "") {
+  if (options$Attributes == "ImR" &&  !identical(D, "")) {
     jaspResults[["IPlotA"]] <- createJaspPlot(title = gettext("Individuals and Moving Range Chart"), width = 1200, height = 500, position = 1)
     IMRchart <- .Ichart_attributes(dataset = dataset, options = options, timeStamp = timeStamp)
     jaspResults[["IPlotA"]]$plotObject <- PlotReport <- IMRchart$p
@@ -286,7 +286,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
       ggplot2::geom_step(ggplot2::aes(x = c(n, n + 1), y = LCL[n], color = "red"), size = 1.5)
   }
 
-  if (timeStamp != "")
+  if (!identical(timeStamp, ""))
     p <- p + ggplot2::scale_x_continuous(name =  gettext('Sample'), breaks = xBreaks, limits = range(xLimits), labels = as.vector(dataset[, timeStamp]))
 
   return(list(p = p, sixsigma = sixsigma))
@@ -330,7 +330,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
     jaspGraphs::geom_point(size = 4, fill = ifelse(NelsonLaws(sixsigma, chart = "c")$red_points, 'red', 'blue')) +
     jaspGraphs::themeJaspRaw()
 
-  if (timeStamp != "")
+  if (!identical(timeStamp, ""))
     p <- p + ggplot2::scale_x_continuous(name =  gettext('Sample'), breaks = xBreaks, limits = range(xLimits), labels = as.vector(dataset[, timeStamp]))
 
   return(list(p = p, sixsigma = sixsigma))
@@ -374,7 +374,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
     jaspGraphs::geom_rangeframe() +
     jaspGraphs::themeJaspRaw()
 
-  if (timeStamp != "")
+  if (!identical(timeStamp, ""))
     p <- p + ggplot2::scale_x_continuous(name =  gettext('Sample'), breaks = xBreaks, limits = range(xLimits), labels = as.vector(dataset[, timeStamp]))
 
   return(list(p = p, sixsigma = sixsigma))
@@ -443,7 +443,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
 
   }
 
-  if (timeStamp != "")
+  if (!identical(timeStamp, ""))
     p <- p + ggplot2::scale_x_continuous(name =  gettext('Sample'), breaks = xBreaks, limits = range(xLimits), labels = as.vector(dataset[, timeStamp]))
 
   return(list(p = p, sixsigma = sixsigma))
@@ -488,7 +488,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
     jaspGraphs::geom_rangeframe() +
     jaspGraphs::themeJaspRaw()
 
-  if (timeStamp != "")
+  if (!identical(timeStamp, ""))
     p1 <- p1 + ggplot2::scale_x_continuous(name =  gettext('Sample'), breaks = xBreaks, limits = range(xLimits), labels = as.vector(dataset[, timeStamp])[xBreaks])
 
   #data
@@ -529,7 +529,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
     jaspGraphs::geom_rangeframe() +
     jaspGraphs::themeJaspRaw()
 
-  if (timeStamp != "")
+  if (!identical(timeStamp, ""))
     p2 <- p2 + ggplot2::scale_x_continuous(name =  gettext('Sample'), breaks = xBreaks, limits = range(xLimits), labels = as.vector(dataset[, timeStamp])[xBreaks])
 
   p3 <-  jaspGraphs::ggMatrixPlot(plotList = list(p1, p2), layout = matrix(1:2, 2), removeXYlabels= "x")
@@ -608,7 +608,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
 
   }
 
-  if (timeStamp != "")
+  if (!identical(timeStamp, ""))
     p <- p + ggplot2::scale_x_continuous(name =  gettext('Sample'), breaks = xBreaks, limits = range(xLimits), labels = as.vector(dataset[, timeStamp]))
 
   return(list(p = p, sixsigma = sixsigma))
@@ -684,7 +684,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
 
   }
 
-  if (timeStamp != "")
+  if (!identical(timeStamp, ""))
     p <- p + ggplot2::scale_x_continuous(name =  gettext('Sample'), breaks = xBreaks, limits = range(xLimits), labels = dataset[, options$timeStamp])
 
   return(list(p = p, sixsigma = sixsigma))
@@ -706,7 +706,7 @@ attributesCharts <- function(jaspResults, dataset, options) {
 
   Report <- createJaspContainer(gettext("Report"))
 
-  if (ccTitle == ""){
+  if (identical(ccTitle, "")) {
     title <- gettext("Control Charts for Attributes Report")
   }else{
     title <- ccTitle

diff --git a/R/doeAnalysis.R b/R/doeAnalysis.R
@@ -53,19 +53,19 @@ doeAnalysis <- function(jaspResults, dataset, options, ...) {
   }
   factorVars <- NULL
   numericVars <- NULL
-  if (options[["dependent"]] != "") {
+  if (!identical(options[["dependent"]], "")) {
     numericVars <- c(numericVars, options[["dependent"]])
   }
-  if (length(options[["continuousFactors"]]) > 0 && options[["continuousFactors"]] != "") {
+  if (length(options[["continuousFactors"]]) > 0 && !identical(options[["continuousFactors"]], "")) {
     numericVars <- c(numericVars, unlist(options[["continuousFactors"]]))
   }
-  if (length(options[["fixedFactors"]]) > 0 && options[["fixedFactors"]] != "") {
+  if (length(options[["fixedFactors"]]) > 0 && !identical(options[["fixedFactors"]], "")) {
     factorVars <- c(factorVars, unlist(options[["fixedFactors"]]))
   }
-  if (options[["blocks"]] != "") {
+  if (length(options[["blocks"]]) > 0 && !identical(options[["blocks"]], "")) {
     factorVars <- c(factorVars, options[["blocks"]])
   }
-  if (length(options[["covariates"]]) > 0 && options[["covariates"]] != "") {
+  if (length(options[["covariates"]]) > 0 && !identical(options[["covariates"]], "")) {
     numericVars <- c(numericVars, unlist(options[["covariates"]]))
   }
   dataset <- .readDataSetToEnd(columns.as.numeric = numericVars, columns.as.factor = factorVars)
@@ -163,7 +163,7 @@ doeAnalysis <- function(jaspResults, dataset, options, ...) {
                             "fullQuadratic" = paste0(options[["dependent"]], " ~ rsm::FO(", numPredString, ")", catPredString, " + rsm::TWI(", numPredString, ") +  rsm::PQ(", numPredString, ")")
     )
   }
-  if (options[["blocks"]] != "") {
+  if (length(options[["blocks"]]) > 0 && !identical(options[["blocks"]], "")) {
     formulaString <- paste0(formulaString, " + ", options[["blocks"]])
   }
   formula <- as.formula(formulaString)

diff --git a/R/doeResponseSurfaceMethodology.R b/R/doeResponseSurfaceMethodology.R
@@ -28,21 +28,6 @@ doeResponseSurfaceMethodology <- function(jaspResults, dataset, options, ...) {
     .doeRsmGenerateDesignTable(jaspResults, options, design)
 
     .doeRsmExportDesign(options, design)
-
-    error <- try({.doeRsmAnalysisThatMayBreak(jaspResults, dataset, options)})
-
-    if (isTryError(error)) {
-      if (inherits(attr(error, "condition"), "validationError")) {
-        # the error was thrown in .dataErrorCheck -> .hasErrors, so we rethrow it
-        stop(attr(error, "condition"))
-      } else {
-        # an unexpected error occured, so crash gracefully
-        tb <- createJaspTable()
-        tb$setError(gettextf("The analysis failed with the following error message: %s", .extractErrorMessage(error)))
-        jaspResults[["errorTable"]] <- tb
-      }
-    }
-
   }
 
 }
@@ -469,76 +454,71 @@ doeResponseSurfaceMethodology <- function(jaspResults, dataset, options, ...) {
   return(cubeSize + starSize + designTypeCorrection)
 }
 
-.doeRsmAnalysisThatMayBreak <- 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)
-
 }
 
-
-
-
-
-
-# old code ----
 .cubeDesign <- function(jaspResults, options) {
 
   # TODO: rename "ccd" in jaspResults[["ccd"]] to "ccdTable"

diff --git a/R/definitiveScreeningAnalysis.R → R/legacyCode/definitiveScreeningAnalysis.R b/R/definitiveScreeningAnalysis.R → R/legacyCode/definitiveScreeningAnalysis.R
diff --git a/R/doeFull.R → R/legacyCode/doeFull.R b/R/doeFull.R → R/legacyCode/doeFull.R
diff --git a/R/doeModifyDesign.R → R/legacyCode/doeModifyDesign.R b/R/doeModifyDesign.R → R/legacyCode/doeModifyDesign.R
diff --git a/R/doeScreening.R → R/legacyCode/doeScreening.R b/R/doeScreening.R → R/legacyCode/doeScreening.R
diff --git a/R/msaAttribute.R b/R/msaAttribute.R
@@ -36,9 +36,9 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
 
   # Ready
   if (wideFormat){
-    ready <- (length(measurements) != 0 && operators != "" && parts != "")
+    ready <- (length(measurements) != 0 && !identical(operators, "") && !identical(parts, ""))
   } else {
-    ready <- (measurements != "" && operators != "" && parts != "")
+    ready <- (!identical(measurements, "") && !identical(operators, "") && !identical(parts, ""))
   }
 
 
@@ -68,8 +68,8 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
 
 
   # Error handling
-
-  if (standards == "" && options$PositiveRef != "" && options[["AAAcohensKappa"]]) {
+  
+  if (identical(standards, "") && !identical(options[["PositiveRef"]], "") && options[["AAAcohensKappa"]]) {
     jaspResults[["tableReference"]] <- createJaspContainer(title = gettext("Reference Tables and Plots"))
     jaspResults[["tableReference"]]$position <- 10
     jaspResults[["tableReference"]]$dependOn(c("PositiveRef", "standard"))
@@ -195,7 +195,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
   }
   cors <- cbind(appraiserVector, round(cor(as.data.frame(listCor)), 2))
 
-  if (!any(options$PositiveRef == as.character(unique(unlist(dataset[measurements])))) && options$PositiveRef != "" && !options$AAAkendallTau)
+  if (!any(options$PositiveRef == as.character(unique(unlist(dataset[measurements])))) && !identical(options[["PositiveRef"]], "") && !options$AAAkendallTau)
     table$setError(gettext("Please inseret a vaild Positive reference as used in the 'Results' variables."))
 
 
@@ -294,7 +294,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
       appraiserVector <- as.character(unique(dataset[[operators]]))
       numberInspected <- length(unique(dataset[[parts]]))
 
-      if ((length(unique(unlist(dataset[measurements]))) != 2 | length(unique(dataset[[standards]])) != 2) && !options$AAAkendallTau && options$PositiveRef != "") {
+      if ((length(unique(unlist(dataset[measurements]))) != 2 | length(unique(dataset[[standards]])) != 2) && !options$AAAkendallTau && !identical(options[["PositiveRef"]], "")) {
         table$setError(gettext("Invalid Reference and/or Results were inserted."))
         return(table)
       }
@@ -351,10 +351,10 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
         tableDecisions$addColumnInfo(name = "Miss", title = gettext("Miss rate"), type = "string")
         tableDecisions$addColumnInfo(name = "False", title = gettext("False alarm rate"), type = "string")
 
-        if (!any(options$PositiveRef == as.character(unique(unlist(dataset[measurements])))) && options$PositiveRef != "" && !options$AAAkendallTau)
+        if (!any(options$PositiveRef == as.character(unique(unlist(dataset[measurements])))) && !identical(options[["PositiveRef"]], "") && !options$AAAkendallTau)
           tableDecisions$setError(gettext("Please inseret a vaild Positive reference as used in the 'Results' variables."))
 
-        if (!options$AAAkendallTau && standards != "" && options$PositiveRef != "" && any(options$PositiveRef == dataset[measurements]))
+        if (!options$AAAkendallTau && !identical(standards, "") && !identical(options[["PositiveRef"]], "") && any(options$PositiveRef == dataset[measurements]))
         {
           PositiveRef <- options$PositiveRef
           Misses <- vector()
@@ -574,7 +574,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
       AAA[["AllVsStandard"]] <- tableAllVsStandard
     }
 
-    if (options$standard != "" && options$PositiveRef != "" && length(measurements) > 1)
+    if (!identical(options[["standard"]], "") && !identical(options[["PositiveRef"]], "") && length(measurements) > 1)
       AAA[["StudyEffectiveness"]] <- tableDecisions
   }
   return(AAA)

diff --git a/R/msaGaugeLinearity.R b/R/msaGaugeLinearity.R
@@ -22,7 +22,7 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) {
   parts <- unlist(options$parts)
   standards <- unlist(options$standard)
 
-  ready <- (measurements != "" && parts != "" && standards != "")
+  ready <- (!identical(measurements, "") && !identical(parts, "") && !identical(standards, ""))
 
   numeric.vars <- c(measurements, standards)
   numeric.vars <- numeric.vars[numeric.vars != ""]

diff --git a/R/msaGaugeRR.R b/R/msaGaugeRR.R
@@ -27,16 +27,19 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
 
   parts <- unlist(options$parts)
   operators <- unlist(options$operators)
-
+  
   #ready statement
-  if (wideFormat && !options$Type3)
-    ready <- (length(measurements) != 0 && operators != "" && parts != "")
-  else if (options$Type3)
-    ready <- (measurements != "" && parts != "" & length(measurements) != 0)
-  else
-    ready <- (measurements != "" && operators != "" && parts != "")
-
-
+  if (wideFormat && !options[["Type3"]]) {
+    ready <- (length(measurements) > 1 && !identical(operators, "") && !identical(parts, ""))
+  } else if (wideFormat && options[["Type3"]]) {
+    ready <- (length(measurements) > 1 && !identical(parts, "")) 
+  } else if (!wideFormat && !options[["Type3"]]) {
+    ready <- (measurements != "" && !identical(operators, "") && !identical(parts, ""))
+  }  else if (!wideFormat && options[["Type3"]]) {
+    ready <- (!identical(measurements, "") && !identical(parts, ""))
+  }
+
+
   numeric.vars <- measurements
   numeric.vars <- numeric.vars[numeric.vars != ""]
   factor.vars <- c(parts, operators)
@@ -70,7 +73,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
     dataset <- dataset[order(dataset[[parts]]),]
   }
 
-  if(ready & !options$Type3){
+  if(ready && !options$Type3){
    crossed <- .checkIfCrossed(dataset, operators, parts, measurements)
     if(!crossed){
      plot <- createJaspPlot(title = gettext("Gauge r&R"), width = 700, height = 400)
@@ -556,7 +559,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
     anovaTables[['plot']] <- plot
 
 
-    if (length(measurements) >= 1 && operators != "" && parts != "" && ready) {
+    if (length(measurements) >= 1 && !identical(operators, "") && !identical(parts, "") && ready) {
       RRtable1$setError(gettextf("Number of observations is < 2 in %1$s after grouping on %2$s", parts, operators))
       RRtable2$setError(gettextf("Number of observations is < 2 in %1$s after grouping on %2$s", parts, operators))
     }