diff --git a/R/attributesCharts.R b/R/attributesCharts.R index a17fa888..58377488 100644 --- 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 index 76ff0e93..28b0b114 100644 --- 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 index 9575e7be..aefb4c27 100644 --- 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 b/R/legacyCode/definitiveScreeningAnalysis.R similarity index 100% rename from R/definitiveScreeningAnalysis.R rename to R/legacyCode/definitiveScreeningAnalysis.R diff --git a/R/doeFull.R b/R/legacyCode/doeFull.R similarity index 100% rename from R/doeFull.R rename to R/legacyCode/doeFull.R diff --git a/R/doeModifyDesign.R b/R/legacyCode/doeModifyDesign.R similarity index 100% rename from R/doeModifyDesign.R rename to R/legacyCode/doeModifyDesign.R diff --git a/R/doeScreening.R b/R/legacyCode/doeScreening.R similarity index 100% rename from R/doeScreening.R rename to R/legacyCode/doeScreening.R diff --git a/R/msaAttribute.R b/R/msaAttribute.R index 4290b660..6dbca4bb 100644 --- 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 index 3b9a2429..a74180d7 100644 --- 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 index 9820bce0..ec285ee8 100644 --- 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)) } diff --git a/R/msaGaugeRRnonrep.R b/R/msaGaugeRRnonrep.R index 2dbede0a..18250dd0 100644 --- a/R/msaGaugeRRnonrep.R +++ b/R/msaGaugeRRnonrep.R @@ -17,7 +17,7 @@ #' @export msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { - + wideFormat <- options[["gaugeRRNonRepDataFormat"]] == "gaugeRRNonRepWideFormat" if(!wideFormat){ measurements <- unlist(options$measurements) @@ -32,9 +32,9 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { factor.vars <- factor.vars[factor.vars != ""] if(!wideFormat){ - ready <- (measurements != "" && operators != "" && parts != "") + ready <- (!identical(measurements, "") && !identical(operators, "") && !identical(parts, "")) }else{ - ready <- (length(measurements) > 1 && operators != "" && parts != "") + ready <- (length(measurements) > 1 && !identical(operators, "") && !identical(parts, "")) } if (is.null(dataset)) { dataset <- .readDataSetToEnd(columns.as.numeric = numeric.vars, columns.as.factor = factor.vars) @@ -62,7 +62,6 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { longMeasurementCols <- "Measurement" } - # Report if (options[["anovaGaugeNestedReport"]] && ready) { if (is.null(jaspResults[["anovaGaugeNestedReport"]])) { @@ -111,7 +110,7 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { } #Measurement by part x operator plot - if (options[["NRpartOperatorGraph"]] & ready) { + if (options[["NRpartOperatorGraph"]] && ready) { if (is.null(jaspResults[["NRpartOperatorGraph"]])) { jaspResults[["NRpartOperatorGraph"]] <- createJaspContainer(gettext("Measurement by part x operator plot")) jaspResults[["NRpartOperatorGraph"]]$position <- 4 @@ -374,7 +373,7 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { } .reshapeToWide <- function(dataset, measurements, parts, operators) { - dataset <- dataset[order(dataset[parts]),] + dataset <- dataset[order(dataset[[parts]]),] index <- sequence(dplyr::count(dataset, dplyr::across(dplyr::all_of(c(parts, operators))))$n) dataset$index <- index dataset <- tidyr::spread(dataset, index, measurements) diff --git a/R/msaTestRetest.R b/R/msaTestRetest.R index 5338e407..5bd3a00a 100644 --- a/R/msaTestRetest.R +++ b/R/msaTestRetest.R @@ -32,9 +32,9 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { factor.vars <- factor.vars[factor.vars != ""] if (wideFormat){ - ready <- (length(measurements) > 1 && parts != "") + ready <- (length(measurements) > 1 && !identical(parts, "")) }else{ - ready <- (measurements != "" && operators != "" && parts != "") + ready <- (!identical(measurements, "") && !identical(operators, "") && !identical(parts, "")) } if (is.null(dataset)) { @@ -68,7 +68,7 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { } # Rchart Range method - if (options[["rangeRchart"]] & ready) { + if (options[["rangeRchart"]] && ready) { if (is.null(jaspResults[["rangeRchart"]])) { jaspResults[["rangeRchart"]] <- createJaspContainer(gettext("Range Method R Chart")) jaspResults[["rangeRchart"]]$position <- 3 @@ -90,7 +90,7 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { } # Traffic light graph - if(options[["trafficPlot"]] & is.null(jaspResults[["trafficPlot"]] )) { + if(options[["trafficPlot"]] && is.null(jaspResults[["trafficPlot"]] )) { jaspResults[["trafficPlot"]] <- createJaspContainer(gettext("Traffic light chart")) jaspResults[["trafficPlot"]]$position <- 4 jaspResults[["trafficPlot"]]$dependOn(c("trafficPlot", "rangePSD", "EnableRangePSD", "rangeTolerance", "EnableRangeTolerance")) diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index ed68143f..313e6bd6 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -35,7 +35,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (wideFormat) ready <- length(measurements) > 0 else - ready <- (measurements != "" && (options[["manualSubgroupSize"]] | subgroups != "")) + ready <- (!identical(measurements, "") && (options[["manualSubgroupSize"]] | !identical(subgroups, ""))) if (makeSplit && ready) { dataset.factors <- .readDataSetToEnd(columns=num.vars, columns.as.factor=splitName) @@ -77,7 +77,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { # Error Handling .hasErrors(dataset, type = c('infinity', 'missingValues'), all.target = measurements, exitAnalysisIfErrors = TRUE) - if (options[["capabilityStudyType"]] == "nonnormalCapabilityAnalysis" & ready) { + if (options[["capabilityStudyType"]] == "nonnormalCapabilityAnalysis" && ready) { .hasErrors(dataset, all.target = measurements, custom = function () { diff --git a/R/variablesChartsIndividuals.R b/R/variablesChartsIndividuals.R index d57f1221..70df977d 100644 --- a/R/variablesChartsIndividuals.R +++ b/R/variablesChartsIndividuals.R @@ -34,7 +34,7 @@ variablesChartsIndividuals <- function(jaspResults, dataset, options) { dataset <- .readDataSetToEnd(columns.as.numeric = numeric_variables, columns.as.factor = factorVariables) } - if (makeSplit & ready) { + if (makeSplit && ready) { splitFactor <- dataset[[.v(subgroups)]] splitLevels <- levels(splitFactor) # remove missing values from the grouping variable diff --git a/tests/testthat/_snaps/doeAnalysis/normal-probability-plot-of-residuals.svg b/tests/testthat/_snaps/doeAnalysis/normal-probability-plot-of-residuals.svg index 2a9c10fc..f4354954 100644 --- a/tests/testthat/_snaps/doeAnalysis/normal-probability-plot-of-residuals.svg +++ b/tests/testthat/_snaps/doeAnalysis/normal-probability-plot-of-residuals.svg @@ -32,7 +32,7 @@ - + @@ -40,7 +40,7 @@ - + diff --git a/tests/testthat/test-designOfExperiments.R b/tests/testthat/test-designOfExperiments.R deleted file mode 100644 index f9c7d318..00000000 --- a/tests/testthat/test-designOfExperiments.R +++ /dev/null @@ -1 +0,0 @@ -context("Design of experiments") diff --git a/tests/testthat/test-doeAnalysis.R b/tests/testthat/test-doeAnalysis.R index 2df41a83..64b03593 100644 --- a/tests/testthat/test-doeAnalysis.R +++ b/tests/testthat/test-doeAnalysis.R @@ -133,24 +133,6 @@ test_that("ANOVA table results match", { 20, "", "", "Total")) }) -test_that("Contour plot of Vdk vs Inlet_feeding and Oil_temperature matches", { - plotName <- results[["results"]][["contourSurfacePlot"]][["collection"]][["contourSurfacePlot_Contour plot of Vdk vs Inlet_feeding and Oil_temperature"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "contour-plot-of-vdk-vs-inlet_feeding-and-oil_temperature") -}) - -test_that("Contour plot of Vdk vs Inlet_feeding and Time matches", { - plotName <- results[["results"]][["contourSurfacePlot"]][["collection"]][["contourSurfacePlot_Contour plot of Vdk vs Inlet_feeding and Time"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "contour-plot-of-vdk-vs-inlet_feeding-and-time") -}) - -test_that("Contour plot of Vdk vs Time and Oil_temperature matches", { - plotName <- results[["results"]][["contourSurfacePlot"]][["collection"]][["contourSurfacePlot_Contour plot of Vdk vs Time and Oil_temperature"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "contour-plot-of-vdk-vs-time-and-oil_temperature") -}) - test_that("Coded Coefficients table results match", { table <- results[["results"]][["tableCoefficients"]][["data"]] jaspTools::expect_equal_tables(table, @@ -187,38 +169,3 @@ test_that("Model Summary table results match", { list(0.965793350741183, 0.937924676228648, 0.981186342907651, 0.709314769228775 )) }) - - -# Testing RSM surface plot -options <- analysisOptions("doeAnalysis") -options$designType <- "responseSurfaceDesign" -options$dependent <- "Vdk" -options$continuousFactors <- c("Inlet_feeding", "Time", "Oil_temperature") -options$rsmPredefinedModel <- TRUE -options$rsmPredefinedTerms <- "fullQuadratic" -options$modelTerms <- NULL -options$contourSurfacePlot <- TRUE -options$contourSurfacePlotType <- "surfacePlot" -options$contourSurfacePlotVariables <- c("Inlet_feeding", "Time", "Oil_temperature") -options$contourSurfacePlotResponseDivision <- 5 -options$tableAlias <- FALSE -set.seed(1) -results <- runAnalysis("doeAnalysis", "QT 9 p17 - RSM (15+6) Ovality Vdk.csv", options) - -test_that("Surface plot of Vdk vs Inlet_feeding and Oil_temperature matches", { - plotName <- results[["results"]][["contourSurfacePlot"]][["collection"]][["contourSurfacePlot_Surface plot of Vdk vs Inlet_feeding and Oil_temperature"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "surface-plot-of-vdk-vs-inlet_feeding-and-oil_temperature") -}) - -test_that("Surface plot of Vdk vs Inlet_feeding and Time matches", { - plotName <- results[["results"]][["contourSurfacePlot"]][["collection"]][["contourSurfacePlot_Surface plot of Vdk vs Inlet_feeding and Time"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "surface-plot-of-vdk-vs-inlet_feeding-and-time") -}) - -test_that("Surface plot of Vdk vs Time and Oil_temperature matches", { - plotName <- results[["results"]][["contourSurfacePlot"]][["collection"]][["contourSurfacePlot_Surface plot of Vdk vs Time and Oil_temperature"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "surface-plot-of-vdk-vs-time-and-oil_temperature") -})