diff --git a/R/commonQualityControl.R b/R/commonQualityControl.R index 8e1c73e3..837eae03 100644 --- a/R/commonQualityControl.R +++ b/R/commonQualityControl.R @@ -1456,12 +1456,8 @@ KnownControlStats.RS <- function(N, sigma = 3) { theta <- fix.arg[["scale"]] # scale } else { fitWeibull <- try(fitdistrplus::fitdist(data, "weibull", method = "mle", - control = list(maxit = 10000), fix.arg = fix.arg)) - - - if (jaspBase::isTryError(fitWeibull)) stop(estimationErrorMessage, call. = FALSE) @@ -1510,7 +1506,6 @@ KnownControlStats.RS <- function(N, sigma = 3) { # Estimate parameters using fitdistrplus, because it can keep values fixed lnorm3Fit <- try(fitdistrplus::fitdist(data, "lnorm3Temp", method = "mle", - control = list(maxit = 10000), start = lnorm3startList, fix.arg = fix.arg)) if (jaspBase::isTryError(lnorm3Fit)) diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index 3d411ced..94f93a5f 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -1131,20 +1131,20 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (options[["target"]] && options[["processCapabilityPlotSpecificationLimits"]]) xLimits <- range(xLimits, options[["targetValue"]]) - # Addition to consider that if distributions are set historically, they may fall outside the usual limits - if (distribution == "normal" && options[["historicalMean"]]) - xLimits <- range(xLimits, options[["historicalMeanValue"]] - 1.5 * sdo, options[["historicalMeanValue"]] + 1.5 * sdo) - if (distribution == "weibull" || distribution == "3ParameterWeibull" && options[["historicalScale"]]) - xLimits <- range(xLimits, options[["historicalScaleValue"]] - 1.5 * sdo, options[["historicalScaleValue"]] + 1.5 * sdo) - if (distribution == "lognormal" || distribution == "3ParameterLognormal" && options[["historicalLogMean"]]) - xLimits <- range(xLimits, exp(options[["historicalLogMeanValue"]]) - 1.5 * sdo, - exp(options[["historicalLogMeanValue"]]) + 1.5 * sdo) - if (distribution == "exponential") - xLimits <- range(xLimits, 0) - if (distribution == "gamma" && options[["historicalShape"]] && options[["historicalScale"]]) - xLimits <- range(xLimits, options[["historicalScaleValue"]] * (options[["historicalShapeValue"]] - 1)) - if ((distribution == "logistic" || distribution == "loglogistic") && options[["historicalLocation"]]) - xLimits <- range(xLimits, options[["historicalLocationValue"]]) + # Addition to consider that if distributions are set historically, they may fall outside the usual limits + if (distribution == "normal" && options[["historicalMean"]]) + xLimits <- range(xLimits, options[["historicalMeanValue"]] - 1.5 * sdo, options[["historicalMeanValue"]] + 1.5 * sdo) + if ((distribution == "weibull" || distribution == "3ParameterWeibull") && options[["historicalScale"]]) + xLimits <- range(xLimits, options[["historicalScaleValue"]] - 1.5 * sdo, options[["historicalScaleValue"]] + 1.5 * sdo) + if ((distribution == "lognormal" || distribution == "3ParameterLognormal") && options[["historicalLogMean"]]) + xLimits <- range(xLimits, exp(options[["historicalLogMeanValue"]]) - 1.5 * sdo, + exp(options[["historicalLogMeanValue"]]) + 1.5 * sdo) + if (distribution == "exponential") + xLimits <- range(xLimits, 0) + if (distribution == "gamma" && options[["historicalShape"]] && options[["historicalScale"]]) + xLimits <- range(xLimits, options[["historicalScaleValue"]] * (options[["historicalShapeValue"]] - 1)) + if ((distribution == "logistic" || distribution == "loglogistic") && options[["historicalLocation"]]) + xLimits <- range(xLimits, options[["historicalLocationValue"]]) xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(allData)) xStep <- diff(xBreaks)[1] @@ -3093,16 +3093,16 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { } table$addColumnInfo(name = "n", title = gettext("N"), type = "integer") if (options[["nullDistribution"]] == "normal") { - table$addColumnInfo(name = "mean", title = gettextf("Mean (%1$s)", "\u03BC"), type = "number") - table$addColumnInfo(name = "sd", title = gettextf("Std. dev. (%1$s)", "\u03C3"), type = "number") + table$addColumnInfo(name = "parameterEstimate1", title = gettextf("Mean (%1$s)", "\u03BC"), type = "number") + table$addColumnInfo(name = "parameterEstimate2", title = gettextf("Std. dev. (%1$s)", "\u03C3"), type = "number") } else if (options[["nullDistribution"]] == "lognormal") { - table$addColumnInfo(name = "mean", title = gettextf("Log mean (%1$s)", "\u03BC"), type = "number") - table$addColumnInfo(name = "sd", title = gettextf("Log std.dev (%1$s)", "\u03C3"), type = "number") + table$addColumnInfo(name = "parameterEstimate1", title = gettextf("Log mean (%1$s)", "\u03BC"), type = "number") + table$addColumnInfo(name = "parameterEstimate2", title = gettextf("Log std.dev (%1$s)", "\u03C3"), type = "number") } else if (options[["nullDistribution"]] == "weibull") { - table$addColumnInfo(name = "mean", title = gettextf("Shape (%1$s)", "\u03B2"), type = "number") - table$addColumnInfo(name = "sd", title = gettextf("Scale (%1$s)", "\u03B8"), type = "number") + table$addColumnInfo(name = "parameterEstimate1", title = gettextf("Shape (%1$s)", "\u03B2"), type = "number") + table$addColumnInfo(name = "parameterEstimate2", title = gettextf("Scale (%1$s)", "\u03B8"), type = "number") } - table$addColumnInfo(name = "ad", title = gettext("AD"), type = "integer") + table$addColumnInfo(name = "ad", title = gettext("AD"), type = "number") table$addColumnInfo(name = "p", title = gettext("p-value"), type = "pvalue") table$addFootnote(gettextf("The Anderson-Darling statistic AD is calculated against the %1$s distribution.", distributionTitle)) table$addFootnote(gettextf("Red dotted lines in the probability plot below represent a 95%% confidence interval.")) @@ -3115,7 +3115,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { container[["probabilityTable"]] <- table return() } - tableColNames <- c("mean", "sd", "n", "ad", "p") + tableColNames <- c("parameterEstimate1", "parameterEstimate2", "n", "ad", "p") if (nStages > 1) tableColNames <- c("stage", tableColNames) tableDf <- data.frame(matrix(ncol = length(tableColNames), nrow = 0)) @@ -3123,39 +3123,42 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { for (i in seq_len(nStages)) { stage <- unique(dataset[[stages]])[i] dataCurrentStage <- dataset[which(dataset[[stages]] == stage), ][!names(dataset) %in% stages] - values <- as.vector(na.omit(unlist(dataCurrentStage[measurements]))) # distribution fitting function complains if this is not explicitly a vector + stageValues <- as.vector(na.omit(unlist(dataCurrentStage[measurements]))) # distribution fitting function complains if this is not explicitly a vector if (options[["nullDistribution"]] == "normal") { - meanx <- mean(values) - sdx <- sd(values) - test <- goftest::ad.test(x = values, "norm", mean = meanx, sd = sdx) + parameterEstimate1 <- mean(stageValues) + parameterEstimate2 <- stats::sd(stageValues) + andersonDarlingTest <- goftest::ad.test(x = stageValues, "norm", mean = parameterEstimate1, sd = parameterEstimate2) } else if (options[["nullDistribution"]] == "lognormal") { - fit <- EnvStats::elnorm(values) - meanx <- fit$parameters[1] - sdx <- fit$parameters[2] - test <- goftest::ad.test(x = values, "plnorm", meanlog = meanx, sdlog = sdx) + fitPars <- .distributionParameters(stageValues, distribution = "lognormal") + parameterEstimate1 <- fitPars$beta + parameterEstimate2 <- fitPars$theta + andersonDarlingTest <- goftest::ad.test(x = stageValues, "plnorm", meanlog = parameterEstimate1, sdlog = parameterEstimate2) } else if (options[["nullDistribution"]] == "weibull") { - fit <- fitdistrplus::fitdist(values, 'weibull', - control = list(maxit = 10000)) - meanx <- fit$estimate[1] - sdx <- fit$estimate[2] - test <- goftest::ad.test(x = values, "pweibull", shape = meanx, scale = sdx) - } - n <- length(values) - ad <- test$statistic - adStar <- ad*(1 + (0.75/n) + (2.25/(n^2))) - if(ad >= 0.6) { - p <- exp(1.2937 - (5.709 * adStar) + 0.0186 * (adStar^2)) - } else if(adStar < 0.6 && adStar > 0.34) { - p <- exp(0.9177 - (4.279 * adStar) - 1.38 * (adStar^2)) - } else if(adStar < 0.34 && adStar > 0.2) { - p <- 1 - exp(-8.318 + (42.796 * adStar) - 59.938 * (adStar^2)) - } else if(adStar <= 0.2) { - p <- 1 - exp(-13.436 + (101.14 * adStar) - 223.73 * (adStar^2)) #Jaentschi & Bolboaca (2018) + fitPars <- .distributionParameters(stageValues, distribution = "weibull") + parameterEstimate1 <- fitPars$beta + parameterEstimate2 <- fitPars$theta + andersonDarlingTest <- goftest::ad.test(x = stageValues, "pweibull", shape = parameterEstimate1, scale = parameterEstimate2) + } + sampleSize <- length(stageValues) + adStatistic <- andersonDarlingTest$statistic + adStatisticAdjusted <- adStatistic * (1 + (0.75 / sampleSize) + (2.25 / (sampleSize^2))) + if (adStatisticAdjusted >= 0.6) { + pValue <- exp(1.2937 - (5.709 * adStatisticAdjusted) + 0.0186 * (adStatisticAdjusted^2)) + } else if (adStatisticAdjusted < 0.6 && adStatisticAdjusted > 0.34) { + pValue <- exp(0.9177 - (4.279 * adStatisticAdjusted) - 1.38 * (adStatisticAdjusted^2)) + } else if (adStatisticAdjusted < 0.34 && adStatisticAdjusted > 0.2) { + pValue <- 1 - exp(-8.318 + (42.796 * adStatisticAdjusted) - 59.938 * (adStatisticAdjusted^2)) + } else if (adStatisticAdjusted <= 0.2) { + pValue <- 1 - exp(-13.436 + (101.14 * adStatisticAdjusted) - 223.73 * (adStatisticAdjusted^2)) #Jaentschi & Bolboaca (2018) } else { - p <- test$p.value + pValue <- andersonDarlingTest$p.value } - tableDfCurrentStage <- data.frame(mean = meanx, sd = sdx, n = n, ad = round(ad, .numDecimals), p = round(p, .numDecimals)) + tableDfCurrentStage <- data.frame(parameterEstimate1 = parameterEstimate1, + parameterEstimate2 = parameterEstimate2, + n = sampleSize, + ad = round(adStatistic, .numDecimals), + p = round(pValue, .numDecimals)) if (i == 1 && nStages > 1) baseLineDf <- tableDfCurrentStage if (i > 1) { diff --git a/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-process-subplot-1.svg b/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-process-subplot-1.svg new file mode 100644 index 00000000..73ceff82 --- /dev/null +++ b/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-process-subplot-1.svg @@ -0,0 +1,99 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +LSL = 0 + +USL = 0.04 + + + + + + + + + + + + + + + + + + +-0.005 +0.000 +0.005 +0.010 +0.015 +0.020 +0.025 +0.030 +0.035 +0.040 +0.045 +Measurement +Density + + + + +Weibull dist. +capability-of-the-process-subplot-1 + + diff --git a/tests/testthat/_snaps/processCapabilityStudies/histogram-subplot-1.svg b/tests/testthat/_snaps/processCapabilityStudies/histogram-subplot-1.svg new file mode 100644 index 00000000..ff583489 --- /dev/null +++ b/tests/testthat/_snaps/processCapabilityStudies/histogram-subplot-1.svg @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 + + + + + + + + + + + + +0.000 +0.005 +0.010 +0.015 +0.020 +0.025 +0.030 +Measurement +Counts + + + + +Weibull dist. +histogram-subplot-1 + + diff --git a/tests/testthat/_snaps/processCapabilityStudies/probability-plot-against-weibull-distribution-subplot-1.svg b/tests/testthat/_snaps/processCapabilityStudies/probability-plot-against-weibull-distribution-subplot-1.svg new file mode 100644 index 00000000..bf5c2bdc --- /dev/null +++ b/tests/testthat/_snaps/processCapabilityStudies/probability-plot-against-weibull-distribution-subplot-1.svg @@ -0,0 +1,512 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.1 +1 +5 +10 +20 +30 +40 +50 +60 +70 +80 +90 +95 +99 +99.9 + + + + + + + + + + + + + + + + + + +0 +0.01 +Measurement +Percent + + + diff --git a/tests/testthat/_snaps/processCapabilityStudies/probability-plot-against-weibull-distribution5-subplot-1.svg b/tests/testthat/_snaps/processCapabilityStudies/probability-plot-against-weibull-distribution5-subplot-1.svg index fbddac62..2a714f74 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/probability-plot-against-weibull-distribution5-subplot-1.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/probability-plot-against-weibull-distribution5-subplot-1.svg @@ -1,5 +1,6 @@ - + + - - + + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.1 +1 +5 +10 +20 +30 +40 +50 +60 +70 +80 +90 +95 +99 +99.9 + + + + + + + + + + + + + + + + + + + + + +3.1 +5.6 +7 +8.4 +10.9 +Measurement +Percent +1 - - -0.1 -1 -5 -10 -20 -30 -40 -50 -60 -70 -80 -90 -95 -99 -99.9 - - - - - - - - - - - - - - - - - - - - - -3.1 -5.6 -7 -8.4 -10.9 -Measurement -Percent -1 diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-10.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-10.svg index 00047fbb..b73b7ccd 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-10.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-10.svg @@ -1,5 +1,6 @@ - + + - - + + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.1 +1 +5 +10 +20 +30 +40 +50 +60 +70 +80 +90 +95 +99 +99.9 + + + + + + + + + + + + + + + + + + + + + + +2 +4 +6 +8 +10 +12 +Measurement +Percent +1 - - -0.1 -1 -5 -10 -20 -30 -40 -50 -60 -70 -80 -90 -95 -99 -99.9 - - - - - - - - - - - - - - - - - - - - - - -2 -4 -6 -8 -10 -12 -Measurement -Percent -1 diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-4.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-4.svg index 30347642..b0754b13 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-4.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-4.svg @@ -45,7 +45,7 @@ - + diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-5.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-5.svg index 201364be..2b86da69 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-5.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-5.svg @@ -1,5 +1,6 @@ - + + - - + + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.1 +1 +5 +10 +20 +30 +40 +50 +60 +70 +80 +90 +95 +99 +99.9 + + + + + + + + + + + + + + + + + + + + + + + +2 +4 +6 +8 +10 +12 +14 +Measurement +Percent +2 - - -0.1 -1 -5 -10 -20 -30 -40 -50 -60 -70 -80 -90 -95 -99 -99.9 - - - - - - - - - - - - - - - - - - - - - - - -2 -4 -6 -8 -10 -12 -14 -Measurement -Percent -2 diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-6.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-6.svg index 268fe3fd..cba4c97b 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-6.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-6.svg @@ -582,12 +582,12 @@ -3562.35 +3563.27 -3562.35 +3563.27 @@ -597,12 +597,12 @@ -2044.04 +2041.66 -2044.04 +2041.66 @@ -612,12 +612,12 @@ --1518.31 +-1521.61 --1518.31 +-1521.61 Non-conformance statistics diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-9.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-9.svg index 9d74dd89..170b59ee 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-9.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-report23-subplot-9.svg @@ -43,7 +43,7 @@ - + diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-10.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-10.svg index a5ec2444..6de1fa48 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-10.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-10.svg @@ -1,5 +1,6 @@ - + + - - + + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.1 +1 +5 +10 +20 +30 +40 +50 +60 +70 +80 +90 +95 +99 +99.9 + + + + + + + + + + + + + + + + + + + + + + +2 +4 +6 +8 +10 +12 +Measurement +Percent +1 - - -0.1 -1 -5 -10 -20 -30 -40 -50 -60 -70 -80 -90 -95 -99 -99.9 - - - - - - - - - - - - - - - - - - - - - - -2 -4 -6 -8 -10 -12 -Measurement -Percent -1 diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-4.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-4.svg index 274f8a06..cd0f2868 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-4.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-4.svg @@ -45,7 +45,7 @@ - + diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-6.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-6.svg index 620cf03b..29b266f5 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-6.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-6.svg @@ -582,12 +582,12 @@ -2793.87 +2792.62 -2793.87 +2792.62 @@ -597,12 +597,12 @@ -2300.19 +2297.03 -2300.19 +2297.03 @@ -612,12 +612,12 @@ --493.68 +-495.59 --493.68 +-495.59 Non-conformance statistics diff --git a/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-9.svg b/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-9.svg index c6ae471d..1883f444 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-9.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/process-capability-reportw18-subplot-9.svg @@ -43,7 +43,7 @@ - + diff --git a/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/capability-of-the-process-subplot-1.rds b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/capability-of-the-process-subplot-1.rds new file mode 100644 index 00000000..0fd18832 Binary files /dev/null and b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/capability-of-the-process-subplot-1.rds differ diff --git a/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/histogram-subplot-1.rds b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/histogram-subplot-1.rds new file mode 100644 index 00000000..5d32b63a Binary files /dev/null and b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/histogram-subplot-1.rds differ diff --git a/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/probability-plot-against-weibull-distribution-subplot-1.rds b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/probability-plot-against-weibull-distribution-subplot-1.rds new file mode 100644 index 00000000..0ea0c962 Binary files /dev/null and b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/probability-plot-against-weibull-distribution-subplot-1.rds differ diff --git a/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/probability-plot-against-weibull-distribution5-subplot-1.rds b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/probability-plot-against-weibull-distribution5-subplot-1.rds index 88706de6..1b53f215 100644 Binary files a/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/probability-plot-against-weibull-distribution5-subplot-1.rds and b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/probability-plot-against-weibull-distribution5-subplot-1.rds differ diff --git a/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/x-bar-r-control-chart-subplot-1.rds b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/x-bar-r-control-chart-subplot-1.rds new file mode 100644 index 00000000..5a27007e Binary files /dev/null and b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/x-bar-r-control-chart-subplot-1.rds differ diff --git a/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/x-bar-r-control-chart-subplot-2.rds b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/x-bar-r-control-chart-subplot-2.rds new file mode 100644 index 00000000..d629bb4a Binary files /dev/null and b/tests/testthat/_snaps/processCapabilityStudies/reference_plotobject/x-bar-r-control-chart-subplot-2.rds differ diff --git a/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart-subplot-1.svg b/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart-subplot-1.svg new file mode 100644 index 00000000..8945daa9 --- /dev/null +++ b/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart-subplot-1.svg @@ -0,0 +1,203 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +CL = 0.01 + +LCL = 0 + +UCL = 0.01 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.000 +0.002 +0.004 +0.006 +0.008 +0.010 +0.012 +0.014 +0.016 + + + + + + + + + + + + + + + + + +1 +20 +40 +60 +80 +100 +120 +Sample +Sample average +x-bar-r-control-chart-subplot-1 + + diff --git a/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart-subplot-2.svg b/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart-subplot-2.svg new file mode 100644 index 00000000..d16c5968 --- /dev/null +++ b/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart-subplot-2.svg @@ -0,0 +1,197 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +CL = 0.01 + +LCL = 0 + +UCL = 0.02 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.000 +0.005 +0.010 +0.015 +0.020 +0.025 + + + + + + + + + + + + + + +1 +20 +40 +60 +80 +100 +120 +Sample +Sample range +x-bar-r-control-chart-subplot-2 + + diff --git a/tests/testthat/datasets/processCapabilityStudy/realDataExample2.csv b/tests/testthat/datasets/processCapabilityStudy/realDataExample2.csv new file mode 100644 index 00000000..ba3f31a5 --- /dev/null +++ b/tests/testthat/datasets/processCapabilityStudy/realDataExample2.csv @@ -0,0 +1,601 @@ +"Column.1" +0.006 +0.013 +0.012 +0.005 +0.005 +0.015 +0.016 +0.016 +0.004 +0.009 +0.012 +0.017 +0.014 +0.009 +0.006 +0.005 +0.009 +0.004 +0.012 +0.005 +0.008 +0.011 +0.008 +0.013 +0.005 +0.005 +0.006 +0.006 +0.006 +0.011 +0.018 +0.009 +0.008 +0.007 +0.005 +0.008 +0.015 +0.003 +0.006 +0.002 +0.006 +0.015 +0.004 +0.007 +0.009 +0.005 +0.011 +0.013 +0.009 +0.009 +0.01 +0.009 +0.006 +0.003 +0.006 +0.002 +0.009 +0.017 +0.004 +0.002 +0.005 +0.006 +0.009 +0.005 +0.006 +0.005 +0.004 +0.007 +0.015 +0.021 +0.007 +0.004 +0.007 +0.003 +0.025 +0.008 +0.004 +0.006 +0.005 +0.019 +0.003 +0.005 +0.014 +0.012 +0.006 +0.014 +0.005 +0.01 +0.004 +0.011 +0.006 +0.003 +0.012 +0.003 +0.016 +0.012 +0.007 +0.011 +0.007 +0.009 +0.01 +0.004 +0.006 +0.002 +0.015 +0.002 +0.009 +0.002 +0.003 +0.01 +0.003 +0.006 +0.005 +0.009 +0.016 +0.007 +0.009 +0.014 +0.006 +0.007 +0.012 +0.005 +0.006 +0.003 +0.012 +0.001 +0.01 +0.002 +0.006 +0.01 +0.01 +0.003 +0.01 +0.007 +0.005 +0.011 +0.005 +0.005 +0.008 +0.009 +0.012 +0.008 +0.006 +0.005 +0.019 +0.009 +0.002 +0.002 +0.003 +0.006 +0.004 +0.012 +0.017 +0.017 +0.001 +0.005 +0.004 +0.004 +0.002 +0.003 +0.005 +0.001 +0.003 +0.015 +0.02 +0.002 +0.009 +0.016 +0.006 +0.017 +0.003 +0.016 +0.011 +0.005 +0.003 +0.016 +0.009 +0.008 +0.005 +0.018 +0.002 +0.003 +0.007 +0.007 +0.011 +0.007 +0.006 +0.01 +0.006 +0.005 +0.012 +0.01 +0.006 +0.005 +0.007 +0.006 +0.003 +0.004 +0.021 +0.008 +0.005 +0.007 +0.011 +0.011 +0.011 +0.011 +0.008 +0.002 +0.004 +0.002 +0.003 +0.01 +0.003 +0.005 +0.009 +0.017 +0.01 +0.004 +0.016 +0.006 +0.011 +0.008 +0.008 +0.007 +0.005 +0.008 +0.005 +0.003 +0.019 +0.004 +0.006 +0.006 +0.011 +0.013 +0.003 +0.006 +0.005 +0.007 +0.011 +0.016 +0.003 +0.009 +0.005 +0.012 +0.006 +0.003 +0.017 +0.006 +0.01 +0.008 +0.004 +0.012 +0.015 +0.01 +0.007 +0.006 +0.013 +0.003 +0.011 +0.007 +0.014 +0.005 +0.015 +0.003 +0.009 +0.017 +0.007 +0.008 +0.009 +0.008 +0.008 +0.006 +0.011 +0.003 +0.006 +0.01 +0.007 +0.007 +0.002 +0.006 +0.017 +0.006 +0.006 +0.011 +0.004 +0.006 +0.014 +0.003 +0.003 +0.005 +0.006 +0.011 +0.016 +0.011 +0.011 +0.004 +0.004 +0.013 +0.008 +0.009 +0.009 +0.018 +0.004 +0.004 +0.009 +0.008 +0.004 +0.014 +0.005 +0.004 +0.008 +0.008 +0.006 +0.003 +0.008 +0.018 +0.013 +0.004 +0.017 +0.009 +0.004 +0.007 +0.008 +0.009 +0.004 +0.006 +0.006 +0.009 +0.008 +0.009 +0.008 +0.015 +0.006 +0.007 +0.005 +0.021 +0.003 +0.012 +0.002 +0.006 +0.017 +0.008 +0.002 +0.005 +0.002 +0.008 +0.008 +0.015 +0.016 +0.004 +0.008 +0.003 +0.007 +0.007 +0.008 +0.009 +0.005 +0.012 +0.01 +0.003 +0.005 +0.005 +0.018 +0.009 +0.004 +0.013 +0.024 +0.007 +0.005 +0.003 +0.007 +0.004 +0.014 +0.003 +0.012 +0.002 +0.004 +0.009 +0.005 +0.007 +0.01 +0.007 +0.004 +0.014 +0.016 +0.012 +0.011 +0.013 +0.004 +0.006 +0.005 +0.01 +0.01 +0.009 +0.012 +0.006 +0.014 +0.005 +0.006 +0.01 +0.018 +0.004 +0.007 +0.004 +0.004 +0.003 +0.003 +0.021 +0.014 +0.014 +0.009 +0.007 +0.011 +0.009 +0.003 +0.006 +0.017 +0.003 +0.014 +0.006 +0.008 +0.004 +0.003 +0.002 +0.01 +0.009 +0.017 +0.019 +0.005 +0.003 +0.011 +0.005 +0.027 +0.015 +0.004 +0.005 +0.006 +0.007 +0.005 +0.004 +0.005 +0.014 +0.006 +0.006 +0.006 +0.002 +0.015 +0.016 +0.006 +0.004 +0.018 +0.004 +0.017 +0.003 +0.005 +0.013 +0.001 +0.004 +0.012 +0.012 +0.008 +0.008 +0.018 +0.023 +0.005 +0.009 +0.01 +0.028 +0.006 +0.007 +0.017 +0.011 +0.005 +0.007 +0.002 +0.011 +0.001 +0.004 +0.006 +0.004 +0.009 +0.005 +0.006 +0.012 +0.016 +0.007 +0.018 +0.01 +0.009 +0.013 +0.006 +0.01 +0.002 +0.013 +0.012 +0.006 +0.001 +0.006 +0.009 +0.01 +0.016 +0.004 +0.006 +0.006 +0.017 +0.007 +0.008 +0.005 +0.008 +0.011 +0.006 +0.006 +0.011 +0.009 +0.003 +0.004 +0.003 +0.005 +0.011 +0.002 +0.009 +0.004 +0.014 +0.004 +0.006 +0.009 +0.007 +0.005 +0.006 +0.012 +0.018 +0.003 +0.009 +0.008 +0.004 +0.003 +0.011 +0.018 +0.007 +0.004 +0.005 +0.01 +0.017 +0.021 +0.005 +0.007 +0.011 +0.008 +0.004 +0.01 +0.006 +0.014 +0.002 +0.005 +0.012 +0.005 +0.004 +0.005 +0.003 +0.009 +0.008 +0.018 +0.006 +0.006 +0.007 +0.004 +0.021 +0.016 +0.002 +0.008 +0.006 +0.005 +0.014 +0.006 +0.007 +0.01 +0.008 +0.013 +0.006 +0.013 +0.013 +0.006 +0.002 +0.01 +0.009 +0.005 +0.004 +0.004 +0.004 +0.005 +0.01 +0.003 +0.003 +0.019 +0.011 +0.018 +0.006 +0.021 +0.012 +0.007 diff --git a/tests/testthat/test-processCapabilityStudies.R b/tests/testthat/test-processCapabilityStudies.R index db992f83..21c0893e 100644 --- a/tests/testthat/test-processCapabilityStudies.R +++ b/tests/testthat/test-processCapabilityStudies.R @@ -387,8 +387,8 @@ test_that("LF5.4 (Weibull) Basic tests of process summary table with manual subg table <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_summaryTableNonNormal"]][["data"]] jaspTools::expect_equal_tables(table, list(4.04074076167675, 0, 7.0825, 40, 1.9949792750032, "1 (BL)", 6, - 7.82155648030048, 12, 4.18662734025142, 0, 7.07833333333333, - 60, 1.77526237417885, 2, 6, 7.76307853935701, 12, 0.146094153376669, + 7.82187513782923, 12, 4.18683491505342, 0, 7.07833333333333, + 60, 1.77526237417885, 2, 6, 7.76289753922706, 12, 0.146094153376669, "-", -0.00416666666666643, 20, -0.21971690082435, "Change (2 vs. BL)", "-", -0.0589775986021728, "-")) }) @@ -3277,32 +3277,114 @@ results <- runAnalysis("processCapabilityStudies", "datasets/processCapabilityStudy/realDataExample1.csv", options) -test_that("LF55.1 Additional 3-paraneter Weibull verification - Non-conformance statistics table results match", { +test_that("LF55.1 Additional 3-parameter Weibull verification - Non-conformance statistics table results match", { table <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_PerformanceNonNormal"]][["data"]] jaspTools::expect_equal_tables(table, list(0, 0, "ppm < LSL", 25245.93, 23529.41, "ppm > USL", 25245.93, 23529.41, "Total ppm")) }) -test_that("LF55.2 Additional 3-paraneter Weibull verification - Capability of the process plot matches", { +test_that("LF55.2 Additional 3-parameter Weibull verification - Capability of the process plot matches", { plotName <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_capabilityPlot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] jaspTools::expect_equal_plots(testPlot, "capability-of-the-processL55") }) -test_that("LF55.3 Additional 3-paraneter Weibull verification - Process performance (total) table results match", { +test_that("LF55.3 Additional 3-parameter Weibull verification - Process performance (total) table results match", { table <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_overallCapabilityNonNormal"]][["data"]] jaspTools::expect_equal_tables(table, list("", 0.65, "", 0.65)) }) -test_that("LF55.4 Additional 3-paraneter Weibull verification - Process summary table results match", { +test_that("LF55.4 Additional 3-parameter Weibull verification - Process summary table results match", { table <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_summaryTableNonNormal"]][["data"]] jaspTools::expect_equal_tables(table, list(1.3700977922031, 0, 2.05529411764706, 170, 0.789203160763612, 1.16155570981569, 0.994201851901342, 4)) }) +## Additional verification test for Weibull (verified with other software) #### +options <- analysisOptions("processCapabilityStudies") +options$testSet <- "jaspDefault" +options$measurementLongFormat <- "Column.1" +options$subgroupSizeType <- "manual" +options$manualSubgroupSizeValue <- 5 +options$probabilityPlotRankMethod <- "bernard" +options$capabilityStudyType <- "nonNormalCapabilityAnalysis" +options$nonNormalDistribution <- "weibull" +options$nonNormalMethod <- "nonConformance" +options$nullDistribution <- "weibull" +options$controlChartType <- "xBarR" +options$lowerSpecificationLimit <- TRUE +options$upperSpecificationLimit <- TRUE +options$lowerSpecificationLimitValue <- 0 +options$upperSpecificationLimitValue <- .04 +set.seed(1) +results <- runAnalysis("processCapabilityStudies", + "datasets/processCapabilityStudy/realDataExample2.csv", options) + +test_that("LF56.1 Additional Weibull verification - Non-conformance statistics table results match", { + table <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_PerformanceNonNormal"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0, 0, "ppm < LSL", 0.59, 0, "ppm > USL", 0.59, 0, "Total ppm" + )) +}) + +test_that("LF56.2 Additional Weibull verification - Capability of the process plot matches", { + plotName <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_capabilityPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "capability-of-the-process") +}) + +test_that("LF56.3 Additional Weibull verification - Process performance (total) table results match", { + table <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_overallCapabilityNonNormal"]][["data"]] + jaspTools::expect_equal_tables(table, + list("", 1.62, "", 1.62)) +}) + +test_that("LF56.4 Additional Weibull verification - Process summary table results match", { + table <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_summaryTableNonNormal"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.83317332958471, 0, 0.00827666666666667, 600, 0.00480471272080215, + 0.00935763177913401, 0.04)) +}) + +test_that("LF56.5 Additional Weibull verification - Histogram plot matches", { + plotName <- results[["results"]][["histogram"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "histogram") +}) + +test_that("LF56.6 Additional Weibull verification - Probability plot against Weibull distribution matches", { + plotName <- results[["results"]][["probabilityContainer"]][["collection"]][["probabilityContainer_ProbabilityPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "probability-plot-against-weibull-distribution") +}) + +test_that("LF56.7 Additional Weibull verification - Summary of test against the Weibull distribution table results match", { + table <- results[["results"]][["probabilityContainer"]][["collection"]][["probabilityContainer_probabilityTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(4.4, 600, 0, 1.83317332958471, 0.00935763177913401)) +}) + +test_that("LF56.8 Additional Weibull verification - X-bar & R control chart plot matches", { + plotName <- results[["results"]][["xBar"]][["collection"]][["xBar_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "x-bar-r-control-chart") +}) + +test_that("LF56.9 Additional Weibull verification - Test results for range chart table results match", { + table <- results[["results"]][["xBar"]][["collection"]][["xBar_tableSecondPlot"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + +test_that("LF56.10 Additional Weibull verification - Test results for x-bar chart table results match", { + table <- results[["results"]][["xBar"]][["collection"]][["xBar_tableXBar"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + # Wide / Row format #### ## (Normal) Basic tests #### @@ -3516,7 +3598,7 @@ test_that("WF3.3 (Weibull) Basic tests of Process performance (total) table", { test_that("WF3.4 (Weibull) Basic tests of Process summary table", { table <- results[["results"]][["capabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis"]][["collection"]][["capabilityAnalysis_nonNormalCapabilityAnalysis_summaryTableNonNormal"]][["data"]] jaspTools::expect_equal_tables(table, - list(4.13179160447975, 0, 7.08, 100, 1.85635681000733, 6, 7.78757547787008, + list(4.13213439552013, 0, 7.08, 100, 1.85635681000733, 6, 7.78757547787008, 12)) })