diff --git a/R/commonQualityControl.R b/R/commonQualityControl.R index 3bf4be74..03435fe3 100644 --- a/R/commonQualityControl.R +++ b/R/commonQualityControl.R @@ -275,6 +275,10 @@ NelsonLaws <- function(data, allsix = FALSE, chart = "i", xLabels = NULL) { if (length(rowRemovalIndex) > 0) df <- df[-rowRemovalIndex, ] + # return sdWithin = 0 if no groups have more than 1 obs + if (length(df) == 0) + return(0) + if (type == "r") { rowRanges <- .rowRanges(df, na.rm = TRUE)$ranges n <- .rowRanges(df)$n @@ -527,7 +531,8 @@ KnownControlStats.RS <- function(N, sigma = 3) { qccObject <- qcc::qcc(dataCurrentStage, type ='R', plot = FALSE, center = mu, std.dev = sigma, sizes = ncol(dataCurrentStage), nsigmas = nSigmasControlLimits) # the qcc package returns -Inf when all values are NA, which does not look good in ggplot. So we replace it with NA. qccObject$statistics[is.infinite(qccObject$statistics)] <- NA - plotStatistic <- qccObject$statistics + # the qcc package just returns the values instead of the ranges when there is only one column + plotStatistic <- if (ncol(dataCurrentStage) == 1) rep(0, nrow(dataCurrentStage)) else qccObject$statistics limits <- .controlLimits(mu, sigma, n = n, type = "r", k = nSigmasControlLimits) center <- mu UCL <- limits$UCL @@ -765,7 +770,9 @@ KnownControlStats.RS <- function(N, sigma = 3) { xAxisTitle = "", clLabelSize = 4.5) { plotType <- match.arg(plotType) - yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(pointData$plotStatistic, clData$LCL, clData$UCL, clData$center)) + yBreakDeterminants <- c(pointData$plotStatistic, clData$LCL, clData$UCL, clData$center) + # if all statistics are 0, pretty will select c(-1, 0). But c(0, 1) is better + yBreaks <- if (identical(unique(na.omit(yBreakDeterminants)), 0)) c(0, 1) else jaspGraphs::getPrettyAxisBreaks(yBreakDeterminants) yLimits <- range(yBreaks) xBreaks <- unique(as.integer(jaspGraphs::getPrettyAxisBreaks(pointData$subgroup))) # we only want integers on the x-axis if (xBreaks[1] == 0) # never start counting at 0 on x axis diff --git a/R/doeAnalysis.R b/R/doeAnalysis.R index 657861c4..fecb5990 100644 --- a/R/doeAnalysis.R +++ b/R/doeAnalysis.R @@ -772,7 +772,7 @@ get_levels <- function(var, num_levels, dataset) { return() } codedString <- ifelse(options[["codeFactors"]], gettext("Coded"), gettext("Uncoded")) - tb <- createJaspTable(gettextf("Regression Equation in %s Units", codedString)) + tb <- createJaspTable(gettextf("Regression equation in %s Units", codedString)) tb$addColumnInfo(name = "formula", title = "", type = "string") tb$dependOn(options = .doeAnalysisBaseDependencies()) tb$position <- 4 diff --git a/R/msaAttribute.R b/R/msaAttribute.R index 5fd2c1f9..9ddde1e3 100644 --- a/R/msaAttribute.R +++ b/R/msaAttribute.R @@ -72,13 +72,13 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { # Error handling if (identical(standards, "") && !identical(options[["positiveReference"]], "") && options[["cohensKappa"]]) { - jaspResults[["tableReference"]] <- createJaspContainer(title = gettext("Reference Tables and Plots")) + jaspResults[["tableReference"]] <- createJaspContainer(title = gettext("Reference tables and plots")) jaspResults[["tableReference"]]$position <- 10 jaspResults[["tableReference"]]$dependOn(c("positiveReference", "standardLongFormat", "standardWideFormat")) Container <- jaspResults[["tableReference"]] - tableReference <- createJaspTable(title = gettext("Reference Tables and Plots")) + tableReference <- createJaspTable(title = gettext("Reference tables and plots")) tableReference$setError(gettext("Please insert a reference value before specifying a positive reference.")) Container[["TableError"]] <- tableReference @@ -90,14 +90,14 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { # Attribute Agreement Analysis Table & Graph if (length(measurements) == 0) { if (is.null(jaspResults[["AAAtableGraphs"]])) { - jaspResults[["AAAtableGraphs"]] <- createJaspContainer(gettext("Attributes Agreement Analysis")) + jaspResults[["AAAtableGraphs"]] <- createJaspContainer(gettext("Attributes agreement analysis")) jaspResults[["AAAtableGraphs"]]$position <- 16 } jaspResults[["AAAtableGraphs"]] <- .aaaTableGraphs(ready = ready, dataset = dataset, measurements = measurements, parts = parts, operators = operators, options = options, standards = standards) }else{ if (is.null(jaspResults[["AAAtableGraphs"]])) { - jaspResults[["AAAtableGraphs"]] <- createJaspContainer(gettext("Attributes Agreement Analysis")) + jaspResults[["AAAtableGraphs"]] <- createJaspContainer(gettext("Attributes agreement analysis")) jaspResults[["AAAtableGraphs"]]$position <- 16 } jaspResults[["AAAtableGraphs"]] <- .aaaTableGraphs(ready = ready, dataset = dataset, measurements = measurements, parts = parts, operators = operators, options = options, standards = standards) @@ -106,7 +106,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { # Cohen's Kappa Operator vs Standard if (options[["cohensKappa"]] && ready) { if (is.null(jaspResults[["cohensKappa"]])) { - jaspResults[["cohensKappa"]] <- createJaspContainer(gettext("Cohen's Kappa")) + jaspResults[["cohensKappa"]] <- createJaspContainer(gettext("Cohen's kappa")) jaspResults[["cohensKappa"]]$position <- 18 } @@ -118,7 +118,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { # Fleiss' Kappa if (options[["fleissKappa"]] && ready) { if (is.null(jaspResults[["fleissKappa"]])) { - jaspResults[["fleissKappa"]] <- createJaspContainer(gettext("Cohen's Kappa")) + jaspResults[["fleissKappa"]] <- createJaspContainer(gettext("Cohen's kappa")) jaspResults[["fleissKappa"]]$position <- 19 } @@ -129,7 +129,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { # Kendall Tau if (options[["kendallsTau"]] && ready) { if (is.null(jaspResults[["KendallTau"]])) { - jaspResults[["KendallTau"]] <- createJaspContainer(gettext("Kendall's Tau")) + jaspResults[["KendallTau"]] <- createJaspContainer(gettext("Kendall's tau")) jaspResults[["KendallTau"]]$position <- 20 } @@ -145,12 +145,12 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { dataset <- tidyr::gather(dataset, Repetition, Measurement, measurements[1]:measurements[length(measurements)], factor_key=TRUE) - table <- createJaspTable(title = gettext("Cohen's Kappa for Appraiser vs Standard")) + table <- createJaspTable(title = gettext("Cohen's kappa for appraiser vs standard")) table$dependOn(c("cohensKappa")) table$addColumnInfo(name = "Appraiser", title = gettext("Appraiser"), type = "string") - table$addColumnInfo(name = "CK", title = gettext("Cohen's Kappa"), type = "number") + table$addColumnInfo(name = "CK", title = gettext("Cohen's kappa"), type = "number") appraiserVector <- vector(mode = "character") kappaVector <- vector(mode = "numeric") @@ -175,7 +175,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { .corCohenTable <- function(dataset, ready, measurements, parts, operators, options) { - table <- createJaspTable(title = gettext("Cohen's Kappa correlations summary")) + table <- createJaspTable(title = gettext("Cohen's kappa correlations summary")) table$dependOn(c("cohensKappa")) table$addColumnInfo(name = "appraiserVector", title = gettext("Appraiser"), type = "string") @@ -199,7 +199,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { cors <- cbind(appraiserVector, round(cor(as.data.frame(listCor)), 2)) if (!any(options[["positiveReference"]] == as.character(unique(unlist(dataset[measurements])))) && !identical(options[["positiveReference"]], "") && !options[["kendallsTau"]]) - table$setError(gettext("Please inseret a vaild Positive reference as used in the 'Results' variables.")) + table$setError(gettext("Please inseret a vaild positive reference as used in the results variables.")) table$setData(ifelse(cors == "1", "-", cors)) @@ -208,15 +208,15 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { .fleissKappa <- function(dataset, measurements, parts, operators, standards, options) { - table <- createJaspTable(title = gettext("Fleiss' Kappa")) + table <- createJaspTable(title = gettext("Fleiss' kappa")) table$dependOn(c("fleissKappa")) table$addColumnInfo(name = "appraiser", title = gettext("Appraiser"), type = "string") - table$addColumnInfo(name = "within", title = gettext("Within Appraisers"), type = "number") + table$addColumnInfo(name = "within", title = gettext("Within appraisers"), type = "number") if (standards != "") - table$addColumnInfo(name = "vsStandard", title = gettext("Appraiser vs Standard"), type = "number") - table$addColumnInfo(name = "between", title = gettext("Between Appraisers"), type = "number") + table$addColumnInfo(name = "vsStandard", title = gettext("Appraiser vs standard"), type = "number") + table$addColumnInfo(name = "between", title = gettext("Between appraisers"), type = "number") appraiserVector <- vector(mode = "character") kappaWithinVector <- vector(mode = "numeric") @@ -269,15 +269,15 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { .aaaTableGraphs <- function(ready, dataset, measurements, parts, operators, standards, options) { - AAA <- createJaspContainer(gettext("Attributes Agreement Analysis")) + AAA <- createJaspContainer(gettext("Attributes agreement analysis")) AAA$dependOn(c("measurementsWideFormat", "measurementLongFormat", "partWideFormat", "partLongFormat", "operatorWideFormat", "operatorLongFormat", "standardLongFormat", "standardWideFormat")) if (standards != "") { - tableWithin <- createJaspTable(title = gettext("Within Appraisers")) - tableBetween <- createJaspTable(title = gettext("Between Appraisers")) - tableEachVsStandard <- createJaspTable(title = gettext("Each Appraiser vs Standard")) - tableAllVsStandard <- createJaspTable(title = gettext("All Appraisers vs Standard")) + tableWithin <- createJaspTable(title = gettext("Within appraisers")) + tableBetween <- createJaspTable(title = gettext("Between appraisers")) + tableEachVsStandard <- createJaspTable(title = gettext("Each appraiser vs standard")) + tableAllVsStandard <- createJaspTable(title = gettext("All appraisers vs standard")) allTables <- list(tableWithin, tableBetween, tableEachVsStandard, tableAllVsStandard) @@ -299,7 +299,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { numberInspected <- length(unique(dataset[[parts]])) if ((length(unique(unlist(dataset[measurements]))) != 2 | length(unique(dataset[[standards]])) != 2) && !options[["kendallsTau"]] && !identical(options[["positiveReference"]], "")) { - table$setError(gettext("Invalid Reference and/or Results were inserted.")) + table$setError(gettext("Invalid reference and/or results were inserted.")) return(table) } @@ -345,7 +345,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { percentAllVsStandard <- matchesAllVsStandard / numberInspected* 100 if (length(measurements) == 1 & !options[["kendallsTau"]]) { - tableWithin$setError(gettext("More than 1 Measurement per Operator required.")) + tableWithin$setError(gettext("More than 1 measurement per operator required.")) }else{ tableDecisions <- createJaspTable(title = gettext("Study effectiveness summary")) tableDecisions$addColumnInfo(name = "Appraiser", title = gettext("Appraiser"), type = "string") @@ -354,7 +354,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { tableDecisions$addColumnInfo(name = "False", title = gettext("False alarm rate"), type = "string") if (!any(options[["positiveReference"]] == as.character(unique(unlist(dataset[measurements])))) && !identical(options[["positiveReference"]], "") && !options[["kendallsTau"]]) - tableDecisions$setError(gettext("Please inseret a vaild Positive reference as used in the 'Results' variables.")) + tableDecisions$setError(gettext("Please inseret a vaild positive reference as used in the results variables.")) if (!options[["kendallsTau"]] && !identical(standards, "") && !identical(options[["positiveReference"]], "") && any(options[["positiveReference"]] == dataset[measurements])) { PositiveRef <- options[["positiveReference"]] @@ -374,9 +374,9 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { "Effectiveness" = .decisionNote(percentEachVsStandard), "Miss" = .decisionNote(Misses, type = "Miss"), "False" = .decisionNote(Falses, type = "Falses"))) - tableDecisions$addFootnote(gettextf("Acceptable: x >= 90%% (Effectiveness), x =< 2%% (Miss rate), x =< 5%% (False alarm rate)")) - tableDecisions$addFootnote(gettextf("Marginally acceptable: x >= 80%% (Effectiveness), x =< 5%% (Miss rate), x =< 10%% (False alarm rate)")) - tableDecisions$addFootnote(gettextf("Unacceptable: x < 80%% (Effectiveness), x > 5%% (Miss rate), x > 10%% (False alarm rate)")) + tableDecisions$addFootnote(gettextf("Acceptable: x >= 90%% (effectiveness), x =< 2%% (miss rate), x =< 5%% (false alarm rate)")) + tableDecisions$addFootnote(gettextf("Marginally acceptable: x >= 80%% (effectiveness), x =< 5%% (miss rate), x =< 10%% (false alarm rate)")) + tableDecisions$addFootnote(gettextf("Unacceptable: x < 80%% (effectiveness), x > 5%% (miss rate), x > 10%% (false alarm rate)")) } CIWithin <- .AAACI(matchesWithin, rep(numberInspected, length(appraiserVector))) @@ -457,8 +457,8 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { } } else{ - tableWithin <- createJaspTable(title = gettext("Within Appraisers")) - tableBetween <- createJaspTable(title = gettext("Between Appraisers")) + tableWithin <- createJaspTable(title = gettext("Within appraisers")) + tableBetween <- createJaspTable(title = gettext("Between appraisers")) allTables <- list(tableWithin, tableBetween) @@ -504,7 +504,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { percentBetween <- matchesBetween / numberInspected* 100 if (length(measurements) == 1 && !options[["kendallsTau"]]) { - tableWithin$setError(gettext("More than 1 Measurement per Operator required.")) + tableWithin$setError(gettext("More than one measurement per operator required.")) }else{ CIWithin <- .AAACI(matchesWithin, rep(numberInspected, length(appraiserVector))) tableWithin$setData(list( "Appraiser" = appraiserVector, @@ -523,7 +523,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { "CIU" = unique(CIBetween$upper))) } - AAA <- createJaspContainer(gettext("Attributes Agreement Analysis")) + AAA <- createJaspContainer(gettext("Attributes agreement analysis")) AAA$dependOn(c("measurementsWideFormat", "measurementLongFormat", "partWideFormat", "partLongFormat", "operatorWideFormat", "operatorLongFormat", "standardLongFormat", "standardWideFormat")) @@ -538,12 +538,15 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { withinDataframe <- data.frame(x = appraiserVector, y = percentWithin) - pw <- ggplot2::ggplot(withinDataframe, ggplot2::aes(x = x, y = y)) + jaspGraphs::geom_point() + pw <- ggplot2::ggplot(withinDataframe, ggplot2::aes(x = x, y = y)) + + jaspGraphs::geom_point() + ggplot2::ylab("Percent") + ggplot2::xlab("Appraiser") + ggplot2::scale_y_continuous(limits = c(0, 100), breaks = seq(0, 100, 10)) + ggplot2::geom_errorbar(ggplot2::aes(ymin = c(CIWithin$lower), - ymax = c(CIWithin$upper))) + ymax = c(CIWithin$upper))) + + jaspGraphs::geom_rangeframe() + + jaspGraphs::themeJaspRaw() plotWithin$plotObject <- pw @@ -591,7 +594,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { operatorVector <- as.character(unique(dataset[[operators]])) - table <- createJaspTable(title = gettext("Kendall's Tau")) + table <- createJaspTable(title = gettext("Kendall's tau")) table$dependOn(c("kendallsTau", "measurementsWideFormat", "measurementLongFormat", "partWideFormat", "partLongFormat", "operatorWideFormat", "operatorLongFormat", "standardLongFormat", "standardWideFormat")) @@ -600,9 +603,9 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { return(table) if (!is.numeric(dataset[[measurements[1]]])) { - table$setError(gettext("Kendall's Tau is only available for numeric measurements.")) + table$setError(gettext("Kendall's tau is only available for numeric measurements.")) } else if (length(unique(unlist(dataset[measurements]))) <= 2) { - table$setError(gettext("Kendall's Tau is only available for non-binary measurements.")) + table$setError(gettext("Kendall's tau is only available for non-binary measurements.")) } else{ table$addColumnInfo(name = "Operator", title = gettext("Operator"), type = "string") @@ -689,20 +692,20 @@ msaAttribute <- function(jaspResults, dataset, options, ...) { if (type == "Effectiveness"){ for (i in 1:length(vec)){ if (vec[i] < decisionCriterions[1]) - decisionVec[i] = gettextf("%g (Unacceptable)", round(vec[i],2)) + decisionVec[i] = gettextf("%g (unacceptable)", round(vec[i],2)) else if (vec[i] >= decisionCriterions[1] & vec[i] <= decisionCriterions[2]) - decisionVec[i] = gettextf("%g (Marginally acceptable)", round(vec[i],2)) + decisionVec[i] = gettextf("%g (marginally acceptable)", round(vec[i],2)) else - decisionVec[i] = gettextf("%g (Acceptable)", round(vec[i],2)) + decisionVec[i] = gettextf("%g (acceptable)", round(vec[i],2)) } } else{ for (i in 1:length(vec)){ if (vec[i] > decisionCriterions[1]) - decisionVec[i] = gettextf("%g (Unacceptable)", round(vec[i],2)) + decisionVec[i] = gettextf("%g (unacceptable)", round(vec[i],2)) else if (vec[i] <= decisionCriterions[1] & vec[i] >= decisionCriterions[2]) - decisionVec[i] = gettextf("%g (Marginally acceptable)", round(vec[i],2)) + decisionVec[i] = gettextf("%g (marginally acceptable)", round(vec[i],2)) else - decisionVec[i] = gettextf("%g (Acceptable)", round(vec[i],2)) + decisionVec[i] = gettextf("%g (acceptable)", round(vec[i],2)) } } diff --git a/R/msaGaugeLinearity.R b/R/msaGaugeLinearity.R index b1f043ba..270e42aa 100644 --- a/R/msaGaugeLinearity.R +++ b/R/msaGaugeLinearity.R @@ -38,7 +38,7 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { # Linearity and Bias Analysis if (is.null(jaspResults[["LB"]])) { - jaspResults[["LB"]] <- createJaspContainer(gettext("Linearity and Bias")) + jaspResults[["LB"]] <- createJaspContainer(gettext("Linearity and bias")) jaspResults[["LB"]]$position <- 1 } jaspResults[["LB"]] <- .linearityAndBias(ready = ready, dataset = dataset, options = options, measurements = measurements, parts = parts, standards = standards) @@ -49,28 +49,31 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { .linearityAndBias <- function(ready, dataset, options, measurements, parts, standards) { - tablesAndGraphs <- createJaspContainer(gettext("Linearity and Bias")) + tablesAndGraphs <- createJaspContainer(gettext("Linearity and bias")) - table1 <- createJaspTable(title = gettext("Gauge Bias")) + table1 <- createJaspTable(title = gettext("Gauge bias")) table1$addColumnInfo(name = "part", title = gettext("Part"), type = "string") table1$addColumnInfo(name = "referenceValue", title = gettext("Reference value"), type = "number") - table1$addColumnInfo(name = "observedMean", title = gettext("Mean per reference value"), type = "number") - table1$addColumnInfo(name = "bias", title = gettext("Bias per reference value"), type = "number") - table1$addColumnInfo(name = "pvalue", title = gettext("p(t-test of bias against 0)"), type = "pvalue") + table1$addColumnInfo(name = "observedMean", title = gettext("Observed mean"), type = "number") + table1$addColumnInfo(name = "bias", title = gettext("Mean bias"), type = "number") + table1$addColumnInfo(name = "pvalue", title = gettext("p-value"), type = "pvalue") - table2 <- createJaspTable(title = gettext("Regression Model")) + table2 <- createJaspTable(title = gettext("Regression model")) table2$addColumnInfo(name = "predictor", title = gettext("Predictor"), type = "string") table2$addColumnInfo(name = "coefficient", title = gettext("Coefficient"), type = "number") - table2$addColumnInfo(name = "Tvalues", title = gettext("t-statistic"), type = "number") - table2$addColumnInfo(name = "SEcoefficient", title = gettext("Std. Error coefficients"), type = "number") - table2$addColumnInfo(name = "pvalue", title = gettext("p"), type = "pvalue") + table2$addColumnInfo(name = "SEcoefficient", title = gettext("Std. error"), type = "number") + table2$addColumnInfo(name = "Tvalues", title = gettext("t-value"), type = "number") + table2$addColumnInfo(name = "pvalue", title = gettext("p-value"), type = "pvalue") - table3 <- createJaspTable(title = gettext("Gauge Linearity")) + tableEquation <- createJaspTable(gettext("Regression equation")) + tableEquation$addColumnInfo(name = "formula", title = "", type = "string") - table3$addColumnInfo(name = "S", title = gettext("S"), type = "number") + table3 <- createJaspTable(title = gettext("Gauge linearity")) + + table3$addColumnInfo(name = "S", title = gettext("Std. error"), type = "number") table3$addColumnInfo(name = "rsq", title = gettextf("R%1$s", "\u00B2"), type = "number") table3$addColumnInfo(name = "percentLin", title = gettextf("%% Linearity"), type = "number") @@ -79,15 +82,15 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { table2$addFootnote(Note) table3$addFootnote(Note) - plot1 <- createJaspPlot(title = gettext("Bias and Linearity"), width = 500, height = 500) + plot1 <- createJaspPlot(title = gettext("Bias and linearity"), width = 500, height = 500) - plot2 <- createJaspPlot(title = gettext("Percentage Process Variation Graph"), width = 500, height = 500) + plot2 <- createJaspPlot(title = gettext("Percentage process variation graph"), width = 500, height = 500) if (ready) { # Error conditions if (length(dataset[[measurements]]) < 2){ - table2$setError(gettextf("T-Test requires more than 1 measurement. %1$i valid measurement(s) detected in %2$s.", length(dataset[[measurements]]), measurements)) + table2$setError(gettextf("t-test requires more than 1 measurement. %1$i valid measurement(s) detected in %2$s.", length(dataset[[measurements]]), measurements)) return(table2) } else if (length(unique(dataset[[standards]])) != length(unique(dataset[[parts]]))) { @@ -95,23 +98,23 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { return(table2) } else if(any(table(dataset[[parts]]) < 2)) { singleMeasurementParts <- paste(names(which(table(dataset[[parts]]) < 2)), collapse = ", ") - table2$setError(gettextf("T-Test requires more than 1 measurement per part. Less than 2 valid measurement(s) detected in Part(s) %s.", singleMeasurementParts)) + table2$setError(gettextf("t-test requires more than 1 measurement per part. Less than 2 valid measurement(s) detected in Part(s) %s.", singleMeasurementParts)) return(table2) } variancePerPart <- tapply(dataset[[measurements]], dataset[[parts]], var) if(any(variancePerPart == 0)) { noVarParts <- paste(names(which(variancePerPart == 0)), collapse = ", ") - table2$setError(gettextf("T-Test not possible. No variance detected in Part(s) %s.", noVarParts)) + table2$setError(gettextf("t-test not possible. No variance detected in Part(s) %s.", noVarParts)) return(table2) } else if(any(table(dataset[[parts]]) < 2)) { singleMeasurementParts <- paste(names(which(table(dataset[[parts]]) < 2)), collapse = ", ") - table2$setError(gettextf("T-Test requires more than 1 measurement per part. Less than 2 valid measurement(s) detected in Part(s) %s.", singleMeasurementParts)) + table2$setError(gettextf("t-test requires more than 1 measurement per part. Less than 2 valid measurement(s) detected in Part(s) %s.", singleMeasurementParts)) return(table2) } variancePerPart <- tapply(dataset[[measurements]], dataset[[parts]], var) if(any(variancePerPart == 0)) { noVarParts <- paste(names(which(variancePerPart == 0)), collapse = ", ") - table2$setError(gettextf("T-Test not possible. No variance detected in Part(s) %s.", noVarParts)) + table2$setError(gettextf("t-est not possible. No variance detected in part(s) %s.", noVarParts)) return(table2) } @@ -130,7 +133,7 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { Bias <- ObservedMean - Ref pvalue <- t.test(ReferenceData[[measurements]] - Ref, mu = 0)$p.value df <- rbind(df, list(Part = Part,Ref = rep(Ref,length(Part)), ObservedMean = rep(ObservedMean,length(Part)), Bias = rep(Bias,length(Part)), pvalue = rep(pvalue,length(Part)))) - biases <- c(biases, ReferenceData[[measurements]] - ReferenceData[[standards]][1]) + biases <- c(biases, ReferenceData[[measurements]] - Ref) references <- c(references, ReferenceData[[standards]]) } @@ -151,6 +154,7 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { linearity <- abs(coefficientSlope) * options[["manualProcessVariationValue"]] percentLin <- (linearity / options[["manualProcessVariationValue"]]) * 100 plusOrMin <- if (coefficientSlope > 0) "+" else "-" + regressionEquation <- gettextf("Bias = %1$.2f %2$s %3$.2f * Reference value", coefficientConstant, plusOrMin, abs(coefficientSlope)) p1 <- ggplot2::ggplot(data = df2, mapping = ggplot2::aes(x = Ref, y = Bias)) + ggplot2::geom_hline(yintercept = 0, lty = 2, color = "grey") + @@ -159,8 +163,6 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { jaspGraphs::geom_point(data = df2, mapping = ggplot2::aes(x = Ref, y = Bias), fill = "blue", size = 4, shape = "X") + jaspGraphs::geom_point(data = df, mapping = ggplot2::aes(x = Ref, y = Bias), fill = "red",size = 4) + ggplot2::scale_y_continuous(limits = c(min(df2$Bias), max(df2$Bias) * 2)) + - ggplot2::annotate("text", x = mean(df2$Ref), y = max(df2$Bias)*1.25, size = 5.5, - label = sprintf("y = %.2f %s %.2fx", coefficientConstant, plusOrMin, abs(coefficientSlope))) + jaspGraphs::geom_rangeframe() + jaspGraphs::themeJaspRaw() @@ -172,11 +174,14 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { "SEcoefficient" = SEcoefficients, "pvalue" = pvalues)) + regressionEquationRow <- data.frame(formula = regressionEquation) + tableEquation$addRows(regressionEquationRow) + if (options[["manualProcessVariation"]]) { - table1$addColumnInfo(name = "percentBias", title = gettext("Percent bias per reference value"), type = "number") + table1$addColumnInfo(name = "percentBias", title = gettext("Percent bias"), type = "number") table3$addColumnInfo(name = "linearity", title = gettext("Linearity"), type = "number") - table1$setData(list("part" = c(df$Part,gettext("Average")), + table1$setData(list("part" = c(df$Part,gettext("Total")), "referenceValue" = df$Ref, "observedMean" = df$ObservedMean, "bias" = c(df$Bias, averageBias), @@ -188,7 +193,7 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { "rsq" = rsq, "percentLin" = percentLin)) } else { - table1$setData(list("part" = c(df$Part,gettext("Average")), + table1$setData(list("part" = c(df$Part,gettext("Total")), "referenceValue" = df$Ref, "observedMean" = df$ObservedMean, "bias" = c(df$Bias, averageBias), @@ -199,12 +204,12 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { "percentLin" = percentLin)) } - df3 <- data.frame(Source = c("Linearity", "Bias"), Percent = c(percentLin, (abs(averageBias) / options[["manualProcessVariationValue"]]) * 100)) + df3 <- data.frame(Source = factor(x = c("Linearity", "Bias"), levels = c("Linearity", "Bias")), Percent = c(percentLin, (abs(averageBias) / options[["manualProcessVariationValue"]]) * 100)) yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, df3$Percent)) yLimits <- range(yBreaks) p2 <- ggplot2::ggplot() + - ggplot2::geom_col(data = df3, mapping = ggplot2::aes(x = Source, y = Percent)) + + ggplot2::geom_col(data = df3, mapping = ggplot2::aes(x = Source, y = Percent), fill = "gray", col = "black", linewidth = 1) + ggplot2::scale_y_continuous(breaks = yBreaks, limits = yLimits) + ggplot2::xlab(ggplot2::element_blank()) + jaspGraphs::geom_rangeframe() + @@ -219,6 +224,7 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) { if (options[["linearityTable"]]) { tablesAndGraphs[["table2"]] <- table2 + tablesAndGraphs[["tableEquation"]] <- tableEquation tablesAndGraphs[["table3"]] <- table3 } diff --git a/R/msaGaugeRR.R b/R/msaGaugeRR.R index eef48604..652e4984 100644 --- a/R/msaGaugeRR.R +++ b/R/msaGaugeRR.R @@ -57,7 +57,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { # Checking for infinity and missingValues .hasErrors(dataset, type = c('infinity', 'missingValues'), infinity.target = measurements, - missingValues.target = measurements, + missingValues.target = c(measurements, parts, operators), exitAnalysisIfErrors = TRUE) #Converting long to wide data @@ -111,9 +111,9 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { if (options[["report"]] && ready) { nElements <- sum(options[["reportVariationComponents"]], options[["reportMeasurementsByPartPlot"]], options[["reportRChartByOperator"]], options[["reportMeasurementsByOperatorPlot"]], options[["reportAverageChartByOperator"]], - options[["reportPartByOperatorPlot"]], options[["reportTrafficLightCHart"]], options[["reportMetaData"]]) + options[["reportPartByOperatorPlot"]], options[["reportTrafficLightChart"]], options[["reportMetaData"]]) plotHeight <- ceiling(nElements/2) * 500 - reportPlot <- createJaspPlot(title = gettext("Gauge r&R Report"), width = 1250, height = plotHeight) + reportPlot <- createJaspPlot(title = gettext("Gauge r&R report"), width = 1250, height = plotHeight) jaspResults[["report"]] <- reportPlot jaspResults[["report"]]$dependOn(c("measurementLongFormat", "operatorLongFormat", "partLongFormat", "measurementsWideFormat", "operatorWideFormat", "partWideFormat", "type3", "processVariationReference", "historicalSdValue", @@ -126,7 +126,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { "reportLocation", "reportLocationText", "reportPerformedBy", "reportPerformedByText", "reportDate", "reportDateText", "reportVariationComponents", "reportMeasurementsByPartPlot", "reportRChartByOperator", "reportMeasurementsByOperatorPlot", "reportAverageChartByOperator", - "reportPartByOperatorPlot", "reportTrafficLightCHart", "reportMetaData")) + "reportPartByOperatorPlot", "reportTrafficLightChart", "reportMetaData")) if (nElements == 0) { reportPlot$setError(gettext("No report components selected.")) @@ -138,7 +138,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { # Plot meta data if (options[["reportTitle"]] ) { - title <- if (options[["reportTitleText"]] == "") gettext("Gauge r&R Report") else options[["reportTitleText"]] + title <- if (options[["reportTitleText"]] == "") gettext("Gauge r&R report") else options[["reportTitleText"]] } else { title <- "" } @@ -192,7 +192,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { plotIndexCounter <- plotIndexCounter + 1 } - if (options[["reportTrafficLightCHart"]]) { + if (options[["reportTrafficLightChart"]]) { valuesVec <- .gaugeANOVA(dataset = dataset, measurements = measurements, parts = parts, operators = operators, options = options, ready = TRUE, returnTrafficValues = TRUE, Type3 = Type3) trafficPlots <- .trafficplot(StudyVar = valuesVec$study, ToleranceUsed = options$tolerance, @@ -205,14 +205,32 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { plots[[plotIndexCounter]] <- trafficPlots } } - reportPlotObject <- .qcReport(text = text, plots = plots, textMaxRows = 8, - reportTitle = title) + + # Gauge evaluation table + tables <- list() + tableTitles <- list() + if (options[["reportGaugeTable"]]) { + gaugeEvalOutput <- .gaugeANOVA(dataset = dataset, measurements = measurements, parts = parts, operators = operators, + options = options, ready = TRUE, returnTrafficValues = FALSE, Type3 = Type3, + gaugeEvaluationDfOnly = TRUE) + if (!all(is.na(gaugeEvalOutput))) { + gaugeEvalDf <- gaugeEvalOutput[["gaugeEvalDf"]] + nCategories <- gaugeEvalOutput[["nCategories"]] + nCategoriesDf <- data.frame("x1" = gettext("Number of distinct categories"), "x2" = nCategories) + names(nCategoriesDf) <- NULL + tables[[1]] <- list(gaugeEvalDf, nCategoriesDf) + tableTitles[[1]] <- list("Gauge evaluation", "") + } + } + + reportPlotObject <- .qcReport(text = text, plots = plots, tables = tables, textMaxRows = 8, + tableTitles = tableTitles, reportTitle = title, tableSize = 6) reportPlot$plotObject <- reportPlotObject } else { # Gauge r&R ANOVA Table if (options[["anova"]]) { if (is.null(jaspResults[["gaugeANOVA"]])) { - jaspResults[["gaugeANOVA"]] <- createJaspContainer(gettext("Gauge r&R ANOVA Table")) + jaspResults[["gaugeANOVA"]] <- createJaspContainer(gettext("Gauge r&R ANOVA table")) jaspResults[["gaugeANOVA"]]$dependOn(c("processVariationReference", "historicalSdValue", "report")) jaspResults[["gaugeANOVA"]]$position <- 1 } @@ -238,7 +256,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { # Xbar chart by operator if (options[["xBarChart"]] && is.null(jaspResults[["xBarChart"]])) { - jaspResults[["xBarChart"]] <- createJaspContainer(gettext("Xbar Chart by Operator")) + jaspResults[["xBarChart"]] <- createJaspContainer(gettext("Xbar chart by operator")) jaspResults[["xBarChart"]]$position <- 4 jaspResults[["xBarChart"]]$dependOn(c("xBarChart", "gaugeRRmethod", "anovaGaugeReport", "measurementLongFormat", "measurementsWideFormat", "report")) @@ -256,7 +274,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { # gauge Scatter Plot Operators if (options[["scatterPlot"]]) { if (is.null(jaspResults[["gaugeScatterOperators"]])) { - jaspResults[["gaugeScatterOperators"]] <- createJaspContainer(gettext("Scatterplot Operators")) + jaspResults[["gaugeScatterOperators"]] <- createJaspContainer(gettext("Scatterplot operators")) jaspResults[["gaugeScatterOperators"]]$position <- 5 } jaspResults[["gaugeScatterOperators"]] <- .gaugeScatterPlotOperators(jaspResults = jaspResults, dataset = dataset, measurements = measurements, parts = parts, operators = operators, options = options, ready = ready) @@ -266,7 +284,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { # Measurement by Part Graph if (options[["partMeasurementPlot"]] & ready) { if (is.null(jaspResults[["gaugeByPart"]])) { - jaspResults[["gaugeByPart"]] <- createJaspContainer(gettext("Measurement by Part Graph")) + jaspResults[["gaugeByPart"]] <- createJaspContainer(gettext("Measurement by part graph")) jaspResults[["gaugeByPart"]]$dependOn("report") jaspResults[["gaugeByPart"]]$position <- 6 } @@ -276,7 +294,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { # Measurement by Operator Box Plot if (options[["operatorMeasurementPlot"]]) { if (is.null(jaspResults[["gaugeByOperator"]])) { - jaspResults[["gaugeByOperator"]] <- createJaspContainer(gettext("Measurements by Operator Graph")) + jaspResults[["gaugeByOperator"]] <- createJaspContainer(gettext("Measurements by operator graph")) jaspResults[["gaugeByOperator"]]$dependOn("report") jaspResults[["gaugeByOperator"]]$position <- 7 } @@ -286,7 +304,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { # Parts by Operator Interaction Plot if (options[["partByOperatorMeasurementPlot"]]) { if (is.null(jaspResults[["gaugeByInteraction"]])) { - jaspResults[["gaugeByInteraction"]] <- createJaspContainer(gettext("Part by Operator Interaction Graph")) + jaspResults[["gaugeByInteraction"]] <- createJaspContainer(gettext("Part by operator interaction graph")) jaspResults[["gaugeByInteraction"]]$dependOn("report") jaspResults[["gaugeByInteraction"]]$position <- 8 } @@ -308,33 +326,34 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { return() } -.gaugeANOVA <- function(dataset, measurements, parts, operators, options, ready, returnPlotOnly = FALSE, returnTrafficValues = FALSE, Type3 = FALSE) { - anovaTables <- createJaspContainer(gettext("ANOVA Table")) +.gaugeANOVA <- function(dataset, measurements, parts, operators, options, ready, returnPlotOnly = FALSE, returnTrafficValues = FALSE, + gaugeEvaluationDfOnly = FALSE, Type3 = FALSE) { + anovaTables <- createJaspContainer(gettext("Gauge r&R study - crossed ANOVA")) anovaTables$dependOn(c("anova", "gaugeRRmethod", "report")) anovaTables$position <- 1 - anovaTable1 <- createJaspTable(title = ifelse(Type3, gettext("One-way ANOVA Table"), gettext("Two-way ANOVA Table with Interaction"))) + anovaTable1 <- createJaspTable(title = ifelse(Type3, gettext("One-way ANOVA table"), gettext("Two-way ANOVA table with interaction"))) anovaTable1$addColumnInfo(title = gettext("Source"), name = "source", type = "string" ) anovaTable1$addColumnInfo(title = gettext("df"), name = "Df", type = "integer") - anovaTable1$addColumnInfo(title = gettext("Sum of Squares"), name = "Sum Sq", type = "number") - anovaTable1$addColumnInfo(title = gettext("Mean Squares"), name = "Mean Sq", type = "number") + anovaTable1$addColumnInfo(title = gettext("Sum of squares"), name = "Sum Sq", type = "number") + anovaTable1$addColumnInfo(title = gettext("Mean squares"), name = "Mean Sq", type = "number") anovaTable1$addColumnInfo(title = gettext("F"), name = "F value", type = "number") anovaTable1$addColumnInfo(title = gettext("p-value"), name = "Pr(>F)", type = "pvalue") - RRtable1 <- createJaspTable(title = gettext("Variance Components")) + RRtable1 <- createJaspTable(title = gettext("Variance components")) RRtable1$dependOn(c("anova", "operatorWideFormat", "operatorLongFormat", "partWideFormat", "partLongFormat", "measurementsWideFormat", "measurementLongFormat")) RRtable1$addColumnInfo(name = "Source", title = gettext("Source"), type = "string") RRtable1$addColumnInfo(name = "Variation", title = gettext("Variance"), type = "number") RRtable1$addColumnInfo(name = "Percent", title = gettextf("%% Contribution"), type = "integer") - RRtable2 <- createJaspTable(title = gettext("Gauge Evaluation")) + RRtable2 <- createJaspTable(title = gettext("Gauge evaluation")) RRtable2$dependOn(c("anova", "operatorWideFormat", "operatorLongFormat", "partWideFormat", "partLongFormat", "measurementsWideFormat", "measurementLongFormat")) RRtable2$addColumnInfo(name = "source", title = gettext("Source"), type = "string") - RRtable2$addColumnInfo(name = "SD", title = gettext("Std. Deviation"), type = "number") - RRtable2$addColumnInfo(name = "studyVar", title = gettextf("Study Variation"), type = "number") - RRtable2$addColumnInfo(name = "percentStudyVar", title = gettextf("%% Study Variation"), type = "integer") + RRtable2$addColumnInfo(name = "SD", title = gettext("Std. dev."), type = "number") + RRtable2$addColumnInfo(name = "studyVar", title = gettextf("Study variation"), type = "number") + RRtable2$addColumnInfo(name = "percentStudyVar", title = gettextf("%% Study variation"), type = "integer") if(options[["tolerance"]]) RRtable2$addColumnInfo(name = "percentTolerance", title = gettextf("%% Tolerance"), type = "integer") @@ -437,15 +456,15 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { if (singleOperator || interactionSignificant){ #r & R varcomps - if(singleOperator){ + if (singleOperator) { varCompList <- .gaugeCrossedVarCompsSingleOP(data, operators, parts, measurements, msPart, msRepWithInteraction) varCompRepeat <- varCompList$repeatability varCompPart <- varCompList$part varCompTotalGauge <- varCompList$totalGauge varCompTotalVar <- varCompList$totalVar varCompVector <- c(varCompTotalGauge, varCompRepeat, varCompPart, varCompTotalVar) - sources <- gettext(c("Total Gauge r&R", "Repeatability", "Part-to-Part", "Total Variation")) - }else{ + sources <- gettext(c("Total gauge r&R", "Repeatability", "Part-to-part", "Total variation")) + } else { varCompList <- .gaugeCrossedVarComps(data, operators, parts, measurements, msPart, msOperator, msRepWithInteraction, msInteraction) varCompRepeat <- varCompList$repeatability varCompOperator <- varCompList$operator @@ -454,11 +473,13 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { varCompTotalGauge <- varCompList$totalGauge varCompTotalVar <- varCompList$totalVar varCompInteraction <- varCompList$interaction - varCompVector <- c(varCompTotalGauge, varCompRepeat, varCompReprod, varCompOperator, varCompPart, varCompInteraction, varCompTotalVar) - sources <- gettext(c("Total Gauge r&R", "Repeatability", "Reproducibility", operators, "Part-to-Part", paste(parts," * ", operators), "Total Variation")) + varCompVector <- c("varCompTotalGauge" = varCompTotalGauge, "varCompRepeat" = varCompRepeat, "varCompReprod" = varCompReprod, + "varCompOperator" = varCompOperator, "varCompInteraction" = varCompInteraction, "varCompPart" = varCompPart, + "varCompTotalVar" = varCompTotalVar) + sources <- gettext(c("Total gauge r&R", "Repeatability", "Reproducibility", operators, paste(parts," * ", operators), "Part-to-part", "Total variation")) } - if (options[["processVariationReference"]] == "historicalSd"){ + if (options[["processVariationReference"]] == "historicalSd") { if (Type3) varCompVector <- list(varCompTotalGauge = varCompTotalGauge, varCompRepeat = varCompRepeat, varCompPart = varCompPart, varCompTotalVar = varCompTotalVar) histSD <- options[["historicalSdValue"]] @@ -479,18 +500,17 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { histSD <- options[["historicalSdValue"]] - if(!singleOperator){ + if(!singleOperator) { if (options[["processVariationReference"]] == "historicalSd" && histSD >= sqrt(varCompTotalGauge)) { SD <- c(sqrt(c(varCompTotalGauge, varCompRepeat, varCompReprod, varCompOperator)), - sqrt(histSD^2 - varCompTotalGauge), - sqrt(varCompInteraction), histSD) + sqrt(varCompInteraction), sqrt(histSD^2 - varCompTotalGauge), histSD) - }else{ + }else { SD <- sqrt(varCompVector) } sdParts <- SD[5] sdGauge <- SD[1] - }else{ + }else { if (options[["processVariationReference"]] == "historicalSd" && histSD >= sqrt(varCompTotalGauge)) { SD <- c(sqrt(c(varCompTotalGauge, varCompRepeat)), sqrt(histSD^2 - varCompTotalGauge), histSD) }else{ @@ -514,26 +534,26 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { RRtable2$addFootnote(gettextf("Number of distinct categories = %i", ifelse(SD[3] == 0, 1, nCategories))) } if (as.integer(studyVarMultiplier) == round(studyVarMultiplier, 2)){ - RRtable2$addFootnote(gettextf("Study Variation is calculated as Std. Deviation × %i", as.integer(studyVarMultiplier))) + RRtable2$addFootnote(gettextf("Study Variation is calculated as std. dev. × %i", as.integer(studyVarMultiplier))) }else{ - RRtable2$addFootnote(gettextf("Study Variation is calculated as Std. Deviation × %.2f", studyVarMultiplier)) + RRtable2$addFootnote(gettextf("Study Variation is calculated as std. dev. × %.2f", studyVarMultiplier)) } if(options[["processVariationReference"]] == "historicalSd"){ - RRtable2$addFootnote(gettextf("Historical standard deviation is used to calculate some values for Std. Deviation, Study Variation, and %%Study Variation.")) - RRtable2$addFootnote(gettextf("Values for %%Process Variation are not displayed because they are identical to values for %%Study Variation.")) + RRtable2$addFootnote(gettextf("Historical standard deviation is used to calculate some values for std. dev., study variation, and %%study variation.")) + RRtable2$addFootnote(gettextf("Values for %%process variation are not displayed because they are identical to values for %%study variation.")) } anovaTables[['RRtable2']] <- RRtable2 - }else{ + } else { - anovaTable2 <- createJaspTable(title = gettext("Two-way ANOVA Table without Interaction")) + anovaTable2 <- createJaspTable(title = gettext("Two-way ANOVA table without interaction")) anovaTable2$addColumnInfo(title = gettext("Source"), name = "source", type = "string" ) anovaTable2$addColumnInfo(title = gettext("df"), name = "Df", type = "integer") - anovaTable2$addColumnInfo(title = gettext("Sum of Squares"), name = "Sum Sq", type = "number") - anovaTable2$addColumnInfo(title = gettext("Mean Squares"), name = "Mean Sq", type = "number") + anovaTable2$addColumnInfo(title = gettext("Sum of squares"), name = "Sum Sq", type = "number") + anovaTable2$addColumnInfo(title = gettext("Mean squares"), name = "Mean Sq", type = "number") anovaTable2$addColumnInfo(title = gettext("F"), name = "F value", type = "number") anovaTable2$addColumnInfo(title = gettext("p-value"), name = "Pr(>F)", type = "pvalue") @@ -577,7 +597,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { varCompVector <- c(varCompTotalGauge, varCompRepeat, varCompReprod, varCompOperator, varCompPart, varCompTotalVar) varCompPercent <- varCompVector / varCompTotalVar * 100 - RRtable1$setData(list( "Source" = gettext(c("Total Gauge r&R", "Repeatability", "Reproducibility", operators, "Part-to-Part", "Total Variation")), + RRtable1$setData(list( "Source" = gettext(c("Total gauge r&R", "Repeatability", "Reproducibility", operators, "Part-to-part", "Total variation")), "Variation" = varCompVector, "Percent" = round(varCompPercent,2))) @@ -597,7 +617,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { SD <- ifelse(SD == "NaN", 0, SD) studyVar <- SD * studyVarMultiplier - RRtable2DataList <- list("source" = gettext(c("Total Gauge r&R", "Repeatability", "Reproducibility", operators, "Part-to-Part", "Total Variation")), + RRtable2DataList <- list("source" = gettext(c("Total gauge r&R", "Repeatability", "Reproducibility", operators, "Part-to-part", "Total variation")), "SD" = SD, "studyVar" = studyVar, "percentStudyVar" = c(round(studyVar/max(studyVar) * 100,2))) @@ -607,14 +627,14 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { nCategories <- .gaugeNumberDistinctCategories(SD[5], SD[1]) RRtable2$addFootnote(gettextf("Number of distinct categories = %i", ifelse(SD[3] == 0, 1, nCategories))) if (as.integer(studyVarMultiplier) == round(studyVarMultiplier, 2)){ - RRtable2$addFootnote(gettextf("Study Variation is calculated as Std. Deviation × %i", as.integer(studyVarMultiplier))) + RRtable2$addFootnote(gettextf("Study variation is calculated as std. dev. × %i", as.integer(studyVarMultiplier))) }else{ - RRtable2$addFootnote(gettextf("Study Variation is calculated as Std. Deviation × %.2f", studyVarMultiplier)) + RRtable2$addFootnote(gettextf("Study variation is calculated as std. dev. × %.2f", studyVarMultiplier)) } if(options[["processVariationReference"]] == "historicalSd"){ - RRtable2$addFootnote(gettextf("Historical standard deviation is used to calculate some values for Std. Deviation, Study Variation, and %%Study Variation.")) - RRtable2$addFootnote(gettextf("Values for %%Process Variation are not displayed because they are identical to values for %%Study Variation.")) + RRtable2$addFootnote(gettextf("Historical standard deviation is used to calculate some values for std. dev., study variation, and %%study variation.")) + RRtable2$addFootnote(gettextf("Values for %%process variation are not displayed because they are identical to values for %%study variation.")) } anovaTables[['RRtable2']] <- RRtable2 } @@ -632,6 +652,13 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { percentToleranceValues <- NA } + if (gaugeEvaluationDfOnly) { + gaugeEvalDf <- as.data.frame(RRtable2DataList) + gaugeEvalDf[,-1] <- round(gaugeEvalDf[,-1], .numDecimals) # Round everything while including the source column + names(gaugeEvalDf) <- if (ncol(gaugeEvalDf) == 5) c("Source", "Std. dev.", "Study variation", "%Study variation", "%Tolerance") else c("Source", "Std. dev.", "Study variation", "%Study variation") + return(list("gaugeEvalDf" = gaugeEvalDf, "nCategories" = nCategories)) + } + p <- .gaugeVarCompGraph(percentContributionValues, studyVariationValues, percentToleranceValues, Type3) if (returnPlotOnly) @@ -640,14 +667,14 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { return(list(study = c(round(studyVar/max(studyVar) * 100,2))[1], tol = c(round(studyVar / options[["toleranceValue"]] * 100,2))[1])) if (options[["varianceComponentsGraph"]]) { - plot <- createJaspPlot(title = gettext("Components of Variation"), width = 850, height = 500) + plot <- createJaspPlot(title = gettext("Components of variation"), width = 850, height = 500) plot$dependOn(c("varianceComponentsGraph", "report")) plot$plotObject <- p anovaTables[['VarCompGraph']] <- plot } - }else { + } else { - plot <- createJaspPlot(title = gettext("Components of Variation"), width = 850, height = 500) + plot <- createJaspPlot(title = gettext("Components of variation"), width = 850, height = 500) plot$dependOn(c("gaugeVarCompGraph", "report")) anovaTables[['anovaTable1']] <- anovaTable1 @@ -657,6 +684,14 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { if (length(measurements) >= 1 && !identical(operators, "") && !identical(parts, "") && ready) { + if (returnTrafficValues) + return(list(study = NA, tol = NA)) + if (returnPlotOnly) + return (ggplot2::ggplot() + + ggplot2::theme_void() + + ggplot2::annotate("text", x = 0.5, y = 0.5, label = gettextf("Number of observations is < 2 in %1$s after grouping on %2$s.", parts, operators))) # return an empty plot if not possible to calculate anything + if (gaugeEvaluationDfOnly) + return(list("gaugeEvalDf" = NA, "nCategories" = NA)) 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)) } @@ -665,7 +700,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { } .gaugeByPartGraph <- function(dataset, measurements, parts, operators, options) { - plot <- createJaspPlot(title = gettext("Measurements by Part"), width = 700, height = 300) + plot <- createJaspPlot(title = gettext("Measurements by part"), width = 700, height = 300) plot$dependOn(c("partMeasurementPlot", "gaugeRRmethod", "report")) p <- .gaugeByPartGraphPlotObject(dataset, measurements, parts, operators, displayAll = options[["partMeasurementPlotAllValues"]]) plot$plotObject <- p @@ -693,7 +728,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { .gaugeByOperatorGraph <- function(dataset, measurements, parts, operators, options, ready, Type3 = FALSE) { - plot <- createJaspPlot(title = gettext("Measurements by Operator"), width = 600, height = 600) + plot <- createJaspPlot(title = gettext("Measurements by operator"), width = 600, height = 600) plot$dependOn(c("operatorMeasurementPlot", "gaugeRRmethod", "report")) @@ -726,7 +761,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { if (ready) { plot <- .gaugeByInteractionGraphPlotFunction(dataset, measurements, parts, operators, options, Type3 = Type3) } else { - plot <- createJaspPlot(title = gettext("Part by Operator Interaction"), width = 700, height = 400) + plot <- createJaspPlot(title = gettext("Part by operator interaction"), width = 700, height = 400) plot$dependOn(c("partByOperatorMeasurementPlot", "gaugeRRmethod", "report")) } return(plot) @@ -734,7 +769,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { .gaugeByInteractionGraphPlotFunction <- function(dataset, measurements, parts, operators, options, Type3 = FALSE, ggPlot = FALSE) { - plot <- createJaspPlot(title = gettext("Part by Operator Interaction"), width = 700, height = 400) + plot <- createJaspPlot(title = gettext("Part by operator interaction"), width = 700, height = 400) plot$dependOn(c("partByOperatorMeasurementPlot", "gaugeRRmethod", "report")) byOperator <- split.data.frame(dataset, dataset[operators]) @@ -742,7 +777,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { for (name in names(byOperator)) { if (nrow(byOperator[[name]][measurements]) != length(partNames)) { - plot <- createJaspPlot(title = gettext("Part by Operator Interaction"), width = 700, height = 400) + plot <- createJaspPlot(title = gettext("Part by operator interaction"), width = 700, height = 400) plot$setError(gettext("Operators measured different number of parts.")) return(plot) } @@ -772,7 +807,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { .gaugeScatterPlotOperators <- function(jaspResults, dataset, measurements, parts, operators, options, ready) { - singleEmptyPlot <- createJaspPlot(title = gettext("Scatterplot of Operator vs Operator")) + singleEmptyPlot <- createJaspPlot(title = gettext("Scatterplot of operator vs operator")) singleEmptyPlot$dependOn(c("scatterPlot", "scatterPlotFitLine", "scatterPlotOriginLine", "gaugeRRmethod", "report")) if (!ready) @@ -785,7 +820,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { singleEmptyPlot$setError(gettext("Cannot plot scatterplot for less than 2 operators.")) return(singleEmptyPlot) }else{ - singlePlot <- createJaspPlot(title = gettextf("Scatterplot of Operator %1$s vs Operator %2$s", operatorVector[1], operatorVector[2])) + singlePlot <- createJaspPlot(title = gettextf("Scatterplot of operator %1$s vs operator %2$s", operatorVector[1], operatorVector[2])) singlePlot$dependOn(c("scatterPlot", "scatterPlotFitLine", "scatterPlotOriginLine", "gaugeRRmethod", "report")) operatorSplit <- split.data.frame(dataset, dataset[operators]) nparts <- length(unique(subset(dataset, dataset[operators] == operatorVector[1])[[parts]])) @@ -800,7 +835,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { data = operatorSplit, options = options, measurements = measurements) return(singlePlot) }else{ - matrixPlot <- createJaspPlot(title = gettext("Matrix Plot for Operators"), width = 700, height = 700) + matrixPlot <- createJaspPlot(title = gettext("Matrix plot for operators"), width = 700, height = 700) matrixPlot$dependOn(c("scatterPlot", "report")) plotMat <- matrix(list(), len, len) for (row in 1:len) { @@ -849,9 +884,9 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { } .gaugeVarCompGraph <- function(percentContributionValues, studyVariationValues, percentToleranceValues, Type3 = FALSE) { - sources <- gettext(c('Gauge r&R', 'Repeat', 'Reprod', 'Part-to-Part')) + sources <- gettext(c('Gauge r&R', 'Repeat', 'Reprod', 'Part-to-part')) if (!all(is.na(percentToleranceValues))) { - references <- gettextf(c('%% Contribution', '%% Study Variation', '%% Tolerance')) + references <- gettextf(c('%% Contribution', '%% Study variation', '%% Tolerance')) values <- c(percentContributionValues, studyVariationValues, percentToleranceValues) } else { references <- gettextf(c('%% Contribution', '%% Study Variation')) @@ -954,11 +989,14 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { interaction <- (msInteraction - msRep) / nReplicates part <- (msPart - msInteraction) / (nOperators * nReplicates) reprod <- operator + interaction - }else{ + } else { operator <- (msOperator - msRep) / (nParts * nReplicates) part <- (msPart - msRep) / (nOperators * nReplicates) reprod <- operator } + operator <- max(0, operator) + part <- max(0, part) + reprod <- max(0, reprod) totalGauge <- repeatability + reprod totalVar <- totalGauge + part varcompList <- list(repeatability = repeatability, @@ -1004,7 +1042,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { } return(TRUE) } -.trafficplot <- function(StudyVar = "", ToleranceUsed = FALSE, ToleranceVar = "", options, ready, Xlab.StudySD = "", Xlab.Tol = "", ggPlot = FALSE){ +.trafficplot <- function(StudyVar = "", ToleranceUsed = FALSE, ToleranceVar = "", options, ready, Xlab.StudySD = "", Xlab.Tol = "", ggPlot = FALSE) { if (!ready) return() @@ -1017,6 +1055,12 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) { fill = rep(c("G","R","Y"),2) ) + if (StudyVar == "" | ToleranceVar == "" | is.na(StudyVar) | is.na(ToleranceVar)) { + plotObject <- ggplot2::ggplot() + ggplot2::theme_void() + ggplot2::annotate("text", x = 0.5, y = 0.5, label = gettext("Error: Gauge study failed. Could not create traffic light chart.")) + Plot$plotObject <- plotObject + return(if (ggPlot) plotObject else Plot) + } + if (StudyVar >= 100) {StudyVar = 100} if (ToleranceVar >= 100) {ToleranceVar = 100} diff --git a/R/msaGaugeRRnonrep.R b/R/msaGaugeRRnonrep.R index 88ff5477..2dd298e0 100644 --- a/R/msaGaugeRRnonrep.R +++ b/R/msaGaugeRRnonrep.R @@ -43,7 +43,7 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { } .hasErrors(dataset, type = c('infinity', 'missingValues'), - all.target = measurements, + all.target = c(measurements, parts, operators), exitAnalysisIfErrors = TRUE) if (ready && !wideFormat){ @@ -69,7 +69,7 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { nElements <- sum(options[["reportVariationComponents"]], options[["reportRChartByOperator"]], options[["reportMeasurementsByOperatorPlot"]], options[["reportAverageChartByOperator"]], options[["reportMetaData"]]) plotHeight <- ceiling(nElements/2) * 500 - reportPlot <- createJaspPlot(title = gettext("Gauge r&R (Non-Replicable) Report"), width = 1250, height = plotHeight) + reportPlot <- createJaspPlot(title = gettext("Gauge r&R (non-replicable) report"), width = 1250, height = plotHeight) jaspResults[["report"]] <- reportPlot jaspResults[["report"]]$dependOn(c("measurementLongFormat", "operatorLongFormat", "partLongFormat", "measurementsWideFormat", "operatorWideFormat", "partWideFormat", "processVariationReference", "historicalSdValue", @@ -93,7 +93,7 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { # Plot meta data if (options[["reportTitle"]] ) { - title <- if (options[["reportTitleText"]] == "") gettext("Gauge r&R (Non-Replicable) Report") else options[["reportTitleText"]] + title <- if (options[["reportTitleText"]] == "") gettext("Gauge r&R (non-replicable) report") else options[["reportTitleText"]] } else { title <- "" } @@ -116,54 +116,84 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { plotIndexCounter <- 1 if (options[["reportVariationComponents"]]) { plots[[plotIndexCounter]] <- .gaugeRRNonRep(datasetLong, longMeasurementCols, parts = parts, operators = operators, - options = options, ready = TRUE, plotOnly = TRUE) #var. comp. plot + options = options, ready = TRUE, plotOnly = TRUE) #var. comp. plot plotIndexCounter <- plotIndexCounter + 1 } if (options[["reportRChartByOperator"]]) { plots[[plotIndexCounter]] <- .controlChart(dataset = datasetWide[c(wideMeasurementCols, operators)], - plotType = "R", stages = operators, - xAxisLabels = datasetWide[[parts]][order(datasetWide[[operators]])], - stagesSeparateCalculation = FALSE)$plotObject #R chart by operator + plotType = "R", stages = operators, + xAxisLabels = datasetWide[[parts]][order(datasetWide[[operators]])], + stagesSeparateCalculation = FALSE)$plotObject #R chart by operator plotIndexCounter <- plotIndexCounter + 1 } if (options[["reportMeasurementsByOperatorPlot"]]) { plots[[plotIndexCounter]] <- .gaugeByOperatorGraphPlotObject(datasetWide, wideMeasurementCols, parts, operators, options) #Measurements by operator plot plotIndexCounter <- plotIndexCounter + 1 - } + } if (options[["reportAverageChartByOperator"]]) { plots[[plotIndexCounter]] <- .controlChart(dataset = datasetWide[c(wideMeasurementCols, operators)], - plotType = "xBar", xBarSdType = "r", stages = operators, - xAxisLabels = datasetWide[[parts]][order(datasetWide[[operators]])], - stagesSeparateCalculation = FALSE)$plotObject #Average chart by operator + plotType = "xBar", xBarSdType = "r", stages = operators, + xAxisLabels = datasetWide[[parts]][order(datasetWide[[operators]])], + stagesSeparateCalculation = FALSE)$plotObject #Average chart by operator plotIndexCounter <- plotIndexCounter + 1 } - reportPlotObject <- .qcReport(text = text, plots = plots, textMaxRows = 8, - reportTitle = title) + + if (options[["reportTrafficLightChart"]]) { + traffPlotValues <- .gaugeRRNonRep(datasetLong, longMeasurementCols, parts, operators, options, ready, plotOnly = FALSE, trafficPlotValuesOnly = TRUE) + percentMSVar <- traffPlotValues[1] + percentMSTolerance <- traffPlotValues[2] + trafficPlots <- .trafficplot(StudyVar = percentMSVar, ToleranceUsed = options[["tolerance"]], + ToleranceVar = percentMSTolerance, options = options, ready = ready, ggPlot = TRUE) + if (options[["tolerance"]]) { + plots[[plotIndexCounter]] <- trafficPlots$p1 + plotIndexCounter <- plotIndexCounter + 1 + plots[[plotIndexCounter]] <- trafficPlots$p2 + } else { + plots[[plotIndexCounter]] <- trafficPlots + } + } + + # Gauge evaluation table + tables <- list() + tableTitles <- list() + if (options[["reportGaugeTable"]]) { + gaugeEvalOutput <- .gaugeRRNonRep(datasetLong, longMeasurementCols, parts, operators, options, ready, plotOnly = FALSE, + trafficPlotValuesOnly = FALSE, gaugeEvaluationDfOnly = TRUE) + gaugeEvalDf <- gaugeEvalOutput[["gaugeEvalDf"]] + nCategories <- gaugeEvalOutput[["nCategories"]] + nCategoriesDf <- data.frame("x1" = gettext("Number of distinct categories"), "x2" = nCategories) + names(nCategoriesDf) <- NULL + tables[[1]] <- list(gaugeEvalDf, nCategoriesDf) + tableTitles[[1]] <- list("Gauge evaluation", "") + } + + reportPlotObject <- .qcReport(text = text, plots = plots, tables = tables, textMaxRows = 8, + tableTitles = tableTitles, reportTitle = title, tableSize = 6) reportPlot$plotObject <- reportPlotObject - } else { + } else { # Gauge r&R non replicable if (options[["anova"]]) { if (is.null(jaspResults[["gaugeRRNonRep"]])) { - jaspResults[["gaugeRRNonRep"]] <- createJaspContainer(gettext("Gauge r&R Tables")) + jaspResults[["gaugeRRNonRep"]] <- createJaspContainer(gettext("Gauge r&R tables")) jaspResults[["gaugeRRNonRep"]]$position <- 1 } jaspResults[["gaugeRRNonRep"]] <- .gaugeRRNonRep(dataset = datasetLong, measurements = longMeasurementCols, parts = parts, operators = operators, options = options, ready = ready) jaspResults[["gaugeRRNonRep"]]$dependOn(c("processVariationReference", "historicalSdValue", "toleranceValue", "studyVarianceMultiplierType", - "studyVarianceMultiplierValue", "varianceComponentsGraph", "report")) + "studyVarianceMultiplierValue", "varianceComponentsGraph", "report", "anova")) } # R chart by operator if (options[["rChart"]] && is.null(jaspResults[["rChart"]])) { - jaspResults[["rChart"]] <- createJaspContainer(gettext("Range Chart by Operator")) + jaspResults[["rChart"]] <- createJaspContainer(gettext("Range chart by operator")) jaspResults[["rChart"]]$position <- 2 jaspResults[["rChart"]]$dependOn(c("rChart", "measurementLongFormat", "measurementsWideFormat", "report")) jaspResults[["rChart"]][["plot"]] <- createJaspPlot(title = gettext("Range chart by operator"), width = 1200, height = 500) if (ready) { rChart <- .controlChart(dataset = datasetWide[c(wideMeasurementCols, operators)], - plotType = "R", stages = operators, - xAxisLabels = datasetWide[[parts]][order(datasetWide[[operators]])], - stagesSeparateCalculation = FALSE) + plotType = "R", stages = operators, + xAxisLabels = datasetWide[[parts]][order(datasetWide[[operators]])], + stagesSeparateCalculation = FALSE) jaspResults[["rChart"]][["plot"]]$plotObject <- rChart$plotObject jaspResults[["rChart"]][["table"]] <- rChart$table } @@ -171,19 +201,19 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { # Xbar chart by operator if (options[["xBarChart"]] && is.null(jaspResults[["xBarChart"]])) { - jaspResults[["xBarChart"]] <- createJaspContainer(gettext("Xbar Chart by Operator")) - jaspResults[["xBarChart"]]$position <- 3 - jaspResults[["xBarChart"]]$dependOn(c("xBarChart", "measurementLongFormat", "measurementsWideFormat", "report")) - jaspResults[["xBarChart"]][["plot"]] <- createJaspPlot(title = gettext("Average chart by operator"), width = 1200, height = 500) - if (ready) { - xBarChart <- .controlChart(dataset = datasetWide[c(wideMeasurementCols, operators)], - plotType = "xBar", xBarSdType = "r", stages = operators, - xAxisLabels = datasetWide[[parts]][order(datasetWide[[operators]])], - stagesSeparateCalculation = FALSE) - jaspResults[["xBarChart"]][["plot"]]$plotObject <- xBarChart$plotObject - jaspResults[["xBarChart"]][["table"]] <- xBarChart$table + jaspResults[["xBarChart"]] <- createJaspContainer(gettext("Xbar chart by operator")) + jaspResults[["xBarChart"]]$position <- 3 + jaspResults[["xBarChart"]]$dependOn(c("xBarChart", "measurementLongFormat", "measurementsWideFormat", "report")) + jaspResults[["xBarChart"]][["plot"]] <- createJaspPlot(title = gettext("Average chart by operator"), width = 1200, height = 500) + if (ready) { + xBarChart <- .controlChart(dataset = datasetWide[c(wideMeasurementCols, operators)], + plotType = "xBar", xBarSdType = "r", stages = operators, + xAxisLabels = datasetWide[[parts]][order(datasetWide[[operators]])], + stagesSeparateCalculation = FALSE) + jaspResults[["xBarChart"]][["plot"]]$plotObject <- xBarChart$plotObject + jaspResults[["xBarChart"]][["table"]] <- xBarChart$table - } + } } #Measurement by part x operator plot @@ -199,41 +229,55 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { #Measurement by operator plot if (options[["operatorMeasurementPlot"]]) { if (is.null(jaspResults[["NRoperatorGraph"]])) { - jaspResults[["NRoperatorGraph"]] <- createJaspContainer(gettext("Gauge r&R Tables")) + jaspResults[["NRoperatorGraph"]] <- createJaspContainer(gettext("Gauge r&R tables")) jaspResults[["NRoperatorGraph"]]$position <- 5 } jaspResults[["NRoperatorGraph"]] <- .gaugeByOperatorGraph(dataset = datasetWide, measurements = wideMeasurementCols, parts = parts, operators = operators, options = options, ready = ready) jaspResults[["NRoperatorGraph"]]$dependOn(c("NRoperatorGraph", "report")) } - } - return() + if (options[["trafficLightChart"]]) { + if (is.null(jaspResults[["trafficLightChart"]])) { + jaspResults[["trafficLightChart"]] <- createJaspContainer(gettext("Gauge r&R tables")) + jaspResults[["trafficLightChart"]]$position <- 6 + } + traffPlotValues <- .gaugeRRNonRep(datasetLong, longMeasurementCols, parts, operators, options, ready, plotOnly = FALSE, + trafficPlotValuesOnly = TRUE) + percentMSVar <- traffPlotValues[1] + percentMSTolerance <- traffPlotValues[2] + jaspResults[["trafficLightChart"]] <- .trafficplot(StudyVar = percentMSVar, ToleranceUsed = options[["tolerance"]], + ToleranceVar = percentMSTolerance, options = options, + ready = ready) + jaspResults[["trafficLightChart"]]$dependOn(c("trafficLightChart", "report")) + } + } } -.gaugeRRNonRep <- function(dataset, measurements, parts, operators, options, ready, plotOnly = FALSE) { - gaugeRRNonRepTables <- createJaspContainer(gettext("Gauge r&R Tables")) +.gaugeRRNonRep <- function(dataset, measurements, parts, operators, options, ready, plotOnly = FALSE, trafficPlotValuesOnly = FALSE, + gaugeEvaluationDfOnly = FALSE) { + gaugeRRNonRepTables <- createJaspContainer(gettext("Gauge r&R study - nested ANOVA")) gaugeRRNonRepTables$position <- 1 - gaugeRRNonRepTable1 <- createJaspTable(title = gettext("Gauge r&R (Nested)")) + gaugeRRNonRepTable1 <- createJaspTable(title = gettext("Gauge r&R (nested)")) gaugeRRNonRepTable1$addColumnInfo(title = gettext("Source"), name = "sources", type = "string" ) gaugeRRNonRepTable1$addColumnInfo(title = gettext("df"), name = "DF", type = "integer") - gaugeRRNonRepTable1$addColumnInfo(title = gettext("Sum of Squares"), name = "SS", type = "number") - gaugeRRNonRepTable1$addColumnInfo(title = gettext("Mean Square"), name = "MS", type = "number") + gaugeRRNonRepTable1$addColumnInfo(title = gettext("Sum of squares"), name = "SS", type = "number") + gaugeRRNonRepTable1$addColumnInfo(title = gettext("Mean square"), name = "MS", type = "number") gaugeRRNonRepTable1$addColumnInfo(title = gettext("F"), name = "F.value", type = "number") gaugeRRNonRepTable1$addColumnInfo(title = gettext("p"), name = "p.value", type = "pvalue") - gaugeRRNonRepTable2 <- createJaspTable(title = gettext("Variance Components")) + gaugeRRNonRepTable2 <- createJaspTable(title = gettext("Variance components")) gaugeRRNonRepTable2$addColumnInfo(title = gettext("Source"), name = "sources", type = "string" ) gaugeRRNonRepTable2$addColumnInfo(title = gettext("Variation"), name = "Var", type = "number") gaugeRRNonRepTable2$addColumnInfo(title = gettextf("%% Contribution"), name = "percentVar", type = "number") - gaugeRRNonRepTable3 <- createJaspTable(title = gettext("Gauge Evaluation")) + gaugeRRNonRepTable3 <- createJaspTable(title = gettext("Gauge evaluation")) gaugeRRNonRepTable3$addColumnInfo(name = "source", title = gettext("Source"), type = "string") - gaugeRRNonRepTable3$addColumnInfo(name = "SD", title = gettext("Std. Deviation"), type = "number") - gaugeRRNonRepTable3$addColumnInfo(name = "studyVar", title = gettextf("Study Variation"), type = "number") - gaugeRRNonRepTable3$addColumnInfo(name = "percentStudyVar", title = gettextf("%% Study Variation"), type = "number") + gaugeRRNonRepTable3$addColumnInfo(name = "SD", title = gettext("Std. dev."), type = "number") + gaugeRRNonRepTable3$addColumnInfo(name = "studyVar", title = gettextf("Study variation"), type = "number") + gaugeRRNonRepTable3$addColumnInfo(name = "percentStudyVar", title = gettextf("%% Study variation"), type = "number") if(options[["tolerance"]]) gaugeRRNonRepTable3$addColumnInfo(name = "percentTolerance", title = gettextf("%% Tolerance"), type = "number") @@ -264,14 +308,18 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { "F.value" = f, "p.value" = p)) + histSD <- options[["historicalSdValue"]] varCompTable <- .gaugeNestedVarComponents(dataset, operators, parts, measurements, ms) - varSources <- gettext(c("Total Gauge r & R", "Repeatability", "Reproducibility", "Part-To-Part", "Total Variation")) + if (options[["processVariationReference"]] == "historicalSd") { + varCompTable$varPart <- histSD^2 - varCompTable$varGaugeTotal + varCompTable$varTotal <- histSD^2 + } + varSources <- gettext(c("Total gauge r&R", "Repeatability", "Reproducibility", "Part-To-part", "Total variation")) varComps <- c(varCompTable$varGaugeTotal, varCompTable$varRepeat, varCompTable$varReprod, varCompTable$varPart, varCompTable$varTotal) percentVarComps <- (varComps / varCompTable$varTotal) * 100 gaugeRRNonRepTable2$setData(list("sources" = varSources, "Var" = varComps, "percentVar" = percentVarComps)) - histSD <- options[["historicalSdValue"]] if (options[["processVariationReference"]] == "historicalSd" && histSD >= sqrt(varCompTable$varGaugeTotal)) { stdDevs <- c(sqrt(c(varCompTable$varGaugeTotal, varCompTable$varRepeat, varCompTable$varReprod)), sqrt(histSD^2 - varCompTable$varGaugeTotal), histSD) @@ -296,12 +344,20 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { gaugeRRNonRepTable3DataList <- append(gaugeRRNonRepTable3DataList, list("percentTolerance" = percentTolerance)) } gaugeRRNonRepTable3$setData(gaugeRRNonRepTable3DataList) + nCategories <- .gaugeNumberDistinctCategories(stdDevs[4], stdDevs[1]) + + if (gaugeEvaluationDfOnly) { + gaugeEvalDf <- as.data.frame(gaugeRRNonRepTable3DataList) + gaugeEvalDf[,-1] <- round(gaugeEvalDf[,-1], .numDecimals) # Round everything while including the source column + names(gaugeEvalDf) <- if (ncol(gaugeEvalDf) == 5) c("Source", "Std. dev.", "Study variation", "%Study variation", "%Tolerance") else c("Source", "Std. dev.", "Study variation", "%Study variation") + return(list("gaugeEvalDf" = gaugeEvalDf, "nCategories" = nCategories)) + } + if (as.integer(studyVarMultiplier) == round(studyVarMultiplier, 2)){ - gaugeRRNonRepTable3$addFootnote(gettextf("Study Variation is calculated as Std. Deviation * %i", as.integer(studyVarMultiplier))) + gaugeRRNonRepTable3$addFootnote(gettextf("Study variation is calculated as std. dev. * %i", as.integer(studyVarMultiplier))) } else { - gaugeRRNonRepTable3$addFootnote(gettextf("Study Variation is calculated as Std. Deviation * %.2f", studyVarMultiplier)) + gaugeRRNonRepTable3$addFootnote(gettextf("Study variation is calculated as std. dev. * %.2f", studyVarMultiplier)) } - nCategories <- .gaugeNumberDistinctCategories(stdDevs[4], stdDevs[1]) gaugeRRNonRepTable3$addFootnote(gettextf("Number of distinct categories = %i", nCategories)) } gaugeRRNonRepTables[["Table1"]] <- gaugeRRNonRepTable1 @@ -309,7 +365,7 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { gaugeRRNonRepTables[["Table3"]] <- gaugeRRNonRepTable3 if (options[["varianceComponentsGraph"]]) { - plot <- createJaspPlot(title = gettext("Components of Variation"), width = 850, height = 500) + plot <- createJaspPlot(title = gettext("Components of variation"), width = 850, height = 500) plot$dependOn(c("varianceComponentsGraph", "report")) if (ready){ if(options[["tolerance"]]){ @@ -324,6 +380,14 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { return(p) gaugeRRNonRepTables[["Plot"]] <- plot } + + # Traffic light chart values + if (trafficPlotValuesOnly) { + percentMSVar <- round((studyVar[1]/max(studyVar))*100, .numDecimals) + percentMSTolerance <- round((studyVar[1]/options[["toleranceValue"]])*100, .numDecimals) + return(c(percentMSVar, percentMSTolerance)) + } + return(gaugeRRNonRepTables) } @@ -408,11 +472,14 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { } .gaugeNestedANOVA <- function(dataset, operators, parts, measurements) { - - ss <- .ssGaugeNested(dataset, operators, parts, measurements) - df <- .dfGaugeNested(dataset, operators, parts, measurements) - ms <- .msGaugeNested(ss, df) - f <- .fGaugeNested(ms) + anovaFormula <- as.formula(paste0(measurements, " ~ ", operators, "/", parts)) + anovaOutput <- summary(aov(anovaFormula, data = dataset)) + anovaOutputDf <- as.data.frame(anovaOutput[[1]]) + + ss <- c(anovaOutputDf$`Sum Sq`, sum(anovaOutputDf$`Sum Sq`)) + df <- c(anovaOutputDf$Df, sum(anovaOutputDf$Df)) + ms <- c(anovaOutputDf$`Mean Sq`) + f <- c(ms[1]/ms[2], anovaOutputDf$`F value`[2]) p <- .pGaugeNested(f, df) sources <- c(operators, paste(parts, "(", operators, ")", sep = ""), "Repeatability", "Total") @@ -427,7 +494,7 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) { .gaugeNestedVarComponents <- function(dataset, operators, parts, measurements, ms) { nOperators <- length(unique(dataset[[operators]])) - nReplicates <- as.vector(table(dataset[parts])[1]) + nReplicates <- with(dataset, table(dataset[[operators]], dataset[[parts]]))[1] # assuming constant repetitions across parts and operators nParts <- as.vector(table(dataset[operators])[1] / nReplicates) msOperator <- ms[1] msOperatorPart <- ms[2] diff --git a/R/msaTestRetest.R b/R/msaTestRetest.R index b699fdb6..c45ff5f1 100644 --- a/R/msaTestRetest.R +++ b/R/msaTestRetest.R @@ -50,7 +50,7 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { exitAnalysisIfErrors = TRUE) if (!wideFormat && ready) { - dataset <- as.data.frame(tidyr::pivot_wider(dataset, values_from = measurements, names_from = operators)) + dataset <- as.data.frame(tidyr::pivot_wider(dataset, values_from = dplyr::all_of(measurements), names_from = dplyr::all_of(operators))) measurements <- names(dataset[-1]) } @@ -64,7 +64,7 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { # Scatter Plot Operators vs Parts if (options[["runChartPart"]]) { if (is.null(jaspResults[["ScatterOperatorParts"]])) { - jaspResults[["ScatterOperatorParts"]] <- createJaspContainer(gettext("Scatterplot Operators vs Parts")) + jaspResults[["ScatterOperatorParts"]] <- createJaspContainer(gettext("Scatterplot operators vs parts")) jaspResults[["ScatterOperatorParts"]]$position <- 2 } jaspResults[["ScatterOperatorParts"]] <- .ScatterPlotOperatorParts(dataset = dataset, measurements = measurements, parts = parts, operators = operators, options = options, ready = ready) @@ -72,7 +72,7 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { # Rchart Range method if (options[["rChart"]] && is.null(jaspResults[["rChart"]])) { - jaspResults[["rChart"]] <- createJaspContainer(gettext("Range Method R Chart")) + jaspResults[["rChart"]] <- createJaspContainer(gettext("Range method range chart")) jaspResults[["rChart"]]$position <- 3 jaspResults[["rChart"]]$dependOn(c("rChart", "measurements", "measurementsLong", "parts")) jaspResults[["rChart"]][["plot"]] <- createJaspPlot(title = gettext("Range chart by part"), width = 800, height = 400) @@ -86,7 +86,7 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { # Scatter Plot Operators if (options[["scatterPlotMeasurement"]]) { if (is.null(jaspResults[["ScatterOperators"]])) { - jaspResults[["ScatterOperators"]] <- createJaspContainer(gettext("Scatterplot Operators")) + jaspResults[["ScatterOperators"]] <- createJaspContainer(gettext("Scatterplot operators")) jaspResults[["ScatterOperators"]]$position <- 2 } jaspResults[["ScatterOperators"]] <- .ScatterPlotOperators(dataset = dataset, measurements = measurements, parts = parts, operators = operators, options = options, ready = ready) @@ -116,16 +116,13 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { plot$dependOn(c("runChartPart")) if (ready) { - partIndex <- 1:length(dataset[[measurements[1]]]) - dataset <- cbind(dataset, Parts = factor(partIndex, partIndex)) - allMeasurements <- as.vector(unlist(dataset[measurements])) - yBreaks <- jaspGraphs::getPrettyAxisBreaks(allMeasurements) + yBreaks <- jaspGraphs::getPrettyAxisBreaks(unlist(dataset[measurements])) yLimits <- range(yBreaks) p <- ggplot2::ggplot() + - jaspGraphs::geom_point(data = dataset, ggplot2::aes_string(x = "Parts", y = measurements[1], group = 1), fill = "red", size = 4) + - jaspGraphs::geom_point(data = dataset, ggplot2::aes_string(x = "Parts", y = measurements[2], group = 2),fill = "green", shape = 22, size = 4) + + jaspGraphs::geom_point(data = dataset, ggplot2::aes(x = .data[[parts]], y = .data[[measurements[1]]], group = 1), fill = "red", size = 4) + + jaspGraphs::geom_point(data = dataset, ggplot2::aes(x = .data[[parts]], y = .data[[measurements[2]]], group = 2),fill = "green", shape = 22, size = 4) + ggplot2::scale_y_continuous(name = "Measurements", limits = yLimits, breaks = yBreaks) + jaspGraphs::geom_rangeframe() + jaspGraphs::themeJaspRaw() + @@ -159,11 +156,11 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { table$addColumnInfo(name = "n", title = gettext("Sample size (n)"), type = "integer") table$addColumnInfo(name = "Rbar", title = gettext("R-bar"), type = "number") table$addColumnInfo(name = "d2", title = gettext("d2"), type = "number") - table$addColumnInfo(name = "PSD", title = gettext("Process Std. Dev."), type = "number") + table$addColumnInfo(name = "PSD", title = gettext("Process std. dev."), type = "number") table$addColumnInfo(name = "tolerance", title = gettext("Tolerance"), type = "number") table$addColumnInfo(name = "GRR", title = gettext("GRR"), type = "number") - table$addColumnInfo(name = "GRRpercent.PSD", title = gettextf("%%GRR of Process Std. Dev."), type = "number") - table$addColumnInfo(name = "GRRpercent.Tol", title = gettextf("%%GRR of Tolerance"), type = "number") + table$addColumnInfo(name = "GRRpercent.PSD", title = gettextf("%%GRR of process std. dev."), type = "number") + table$addColumnInfo(name = "GRRpercent.Tol", title = gettextf("%%GRR of tolerance"), type = "number") rows <- list() rows[["n"]] = n @@ -194,21 +191,21 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) { if (ready) { - p <- ggplot2::ggplot(data = dataset, ggplot2::aes_string(x = measurements[1], y = measurements[2])) + - jaspGraphs::geom_point() + ggplot2::scale_x_continuous(limits = c(min(dataset[measurements])*0.9,max(dataset[measurements])*1.1)) + + p <- ggplot2::ggplot() + + jaspGraphs::geom_point(data = dataset, ggplot2::aes(x = .data[[measurements[1]]], y = .data[[measurements[2]]])) + + ggplot2::scale_x_continuous(limits = c(min(dataset[measurements])*0.9,max(dataset[measurements])*1.1)) + ggplot2::scale_y_continuous(limits = c(min(dataset[measurements])*0.9,max(dataset[measurements])*1.1)) + ggplot2::geom_abline(col = "gray", linetype = "dashed") + jaspGraphs::geom_rangeframe() + jaspGraphs::themeJaspRaw() if (options[["scatterPlotMeasurementFitLine"]]) - p <- p + ggplot2::geom_smooth(method = "lm", se = FALSE) + p <- p + ggplot2::geom_smooth(method = "lm", se = FALSE, data = dataset, ggplot2::aes(x = .data[[measurements[1]]], y = .data[[measurements[2]]])) if (options[["scatterPlotMeasurementAllValues"]]) - p <- p + ggplot2::geom_jitter(size = 2) + p <- p + ggplot2::geom_jitter(size = 2, data = dataset, ggplot2::aes(x = .data[[measurements[1]]], y = .data[[measurements[2]]])) plot$plotObject <- p - } return(plot) diff --git a/R/msaType1Gauge.R b/R/msaType1Gauge.R index c535700f..b01604bd 100644 --- a/R/msaType1Gauge.R +++ b/R/msaType1Gauge.R @@ -30,7 +30,7 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { # Bias Run Chart if (options[["runChart"]]) { if (is.null(jaspResults[["biasRun"]])) { - jaspResults[["biasRun"]] <- createJaspContainer(gettext("Run Chart")) + jaspResults[["biasRun"]] <- createJaspContainer(gettext("Run chart")) } jaspResults[["biasRun"]] <- .biasRunChart(dataset = dataset, measurements = measurements, options = options, ready = ready) @@ -40,7 +40,7 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { # Determine Bias Table if (options[["biasTable"]]) { if (is.null(jaspResults[["biasTable"]])) { - jaspResults[["biasTable"]] <- createJaspContainer(gettext("Bias Table")) + jaspResults[["biasTable"]] <- createJaspContainer(gettext("Bias table")) } jaspResults[["biasTable"]] <- .biasTable(dataset = dataset, measurements = measurements, options = options, ready = ready) jaspResults[["biasTable"]]$position <- 2 @@ -49,7 +49,7 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { # Determine Bias t-Test if (options[["tTest"]]) { if (is.null(jaspResults[["biasTtest"]])) { - jaspResults[["biasTtest"]] <- createJaspContainer(gettext("t-Test Bias")) + jaspResults[["biasTtest"]] <- createJaspContainer(gettext("t-test bias")) } jaspResults[["biasTtest"]] <- .biasTtest(dataset = dataset, measurements = measurements, options = options, ready = ready) jaspResults[["biasTtest"]]$position <- 3 @@ -58,7 +58,7 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { # Determine Bias Histogram if (options[["histogram"]]) { if (is.null(jaspResults[["biasHistogram"]])) { - jaspResults[["biasHistogram"]] <- createJaspContainer(gettext("Histogram Bias")) + jaspResults[["biasHistogram"]] <- createJaspContainer(gettext("Histogram bias")) } jaspResults[["biasHistogram"]] <- .biasHistogram(dataset = dataset, measurements = measurements, options = options, ready = ready) jaspResults[["biasHistogram"]]$position <- 4 @@ -69,7 +69,7 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { .biasTable <- function(dataset, measurements, options, ready) { - biasTables <- createJaspContainer(gettext("Bias and Instrument Capability Table")) + biasTables <- createJaspContainer(gettext("Bias and instrument capability table")) data <- dataset @@ -78,18 +78,20 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { studyVarMultiplier <- as.numeric(options[["studyVarianceMultiplier"]]) - table1 <- createJaspTable(title = gettext("Basic Statistics")) + table1 <- createJaspTable(title = gettext("Basic statistics")) table1$dependOn(c("referenceValue", "biasTable", "toleranceRange")) table1$addColumnInfo(name = "referenceValue", title = gettext("Reference value"), type = "number") table1$addColumnInfo(name = "observedMean", title = gettext("Mean"), type = "number") table1$addColumnInfo(name = "bias", title = gettext("Bias"), type = "number") - table1$addColumnInfo(name = "sd", title = gettext("Std. Deviation (s)"), type = "number") - table1$addColumnInfo(name = "SV", title = gettext("Study variation"), type = "number") + table1$addColumnInfo(name = "sd", title = gettext("Std. dev. (s)"), type = "number") + table1$addColumnInfo(name = "SV", title = gettext("Instrument variation"), type = "number") table1$addColumnInfo(name = "tolerance", title = gettext("Tolerance"), type = "number") + table1$addColumnInfo(name = "toleranceLB", title = gettext("Lower"), overtitle = gettext("Tolerance bounds"), type = "number") + table1$addColumnInfo(name = "toleranceUB", title = gettext("Upper"), overtitle = gettext("Tolerance bounds"), type = "number") table1$addColumnInfo(name = "biasPercent", title = gettextf("%% Bias"), type = "number") - table1$addFootnote(gettextf("The study variation is calculated as %i * s.", studyVarMultiplier)) + table1$addFootnote(gettextf("The instrument variation is calculated as %i * s.", studyVarMultiplier)) table2 <- createJaspTable(title = gettext("Capability")) table2$dependOn(c("referenceValue", "biastable", "toleranceRange")) @@ -97,8 +99,8 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { table2$addColumnInfo(name = "Cg", title = gettext("Cg"), type = "string") table2$addColumnInfo(name = "Cgk", title = gettext("Cgk"), type = "string") - table2$addColumnInfo(name = "percentRep", title = gettextf("%% Var(Repeatability)"), type = "integer") - table2$addColumnInfo(name = "percentRepBias", title = gettextf("%% Var(Repeatability and bias)"), type = "integer") + table2$addColumnInfo(name = "percentRep", title = gettextf("%% Var(repeatability)"), type = "integer") + table2$addColumnInfo(name = "percentRepBias", title = gettextf("%% Var(repeatability and bias)"), type = "integer") table1$setData(list( "referenceValue" = reference, "tolerance" = tolerance)) @@ -110,6 +112,7 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { biasPercent <- abs(bias) / tolerance * 100 sd <- sd(unlist(data)) sv <- sd * studyVarMultiplier + k <- options[["percentToleranceForCg"]] table1$setData(list( "referenceValue" = reference, "observedMean" = observedAverage, @@ -117,9 +120,10 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { "sd" = sd, "SV" = sv, "tolerance" = tolerance, + "toleranceLB" = reference - (k/200)*tolerance, + "toleranceUB" = reference + (k/200)*tolerance, "biasPercent" = biasPercent)) - k <- options[["percentToleranceForCg"]] cg <- ((k / 100) * tolerance) / sv cgk <- (((k / 200) * tolerance) - abs(observedAverage - reference)) / (sv / 2) percentRep <- k/cg @@ -146,15 +150,15 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { data <- dataset - table <- createJaspTable(title = gettext("T-Test of Observed Bias Against 0")) + table <- createJaspTable(title = gettext("t-test of observed bias against 0")) table$dependOn(c("referenceValue", "tTest", "toleranceRange")) ciLevel <- options[["tTestCiLevel"]] ciLevelPercent <- ciLevel * 100 table$addColumnInfo(name = "df", title = gettext("df"), type = "integer") table$addColumnInfo(name = "bias", title = gettext("Bias"), type = "number") - table$addColumnInfo(name = "lci", title = gettext("Lower"), type = "number", overtitle = gettextf("%s CI for Bias", paste(ciLevelPercent, "%"))) - table$addColumnInfo(name = "uci", title = gettext("Upper"), type = "number", overtitle = gettextf("%s CI for Bias", paste(ciLevelPercent, "%"))) + table$addColumnInfo(name = "lci", title = gettext("Lower"), type = "number", overtitle = gettextf("%s CI for bias", paste(ciLevelPercent, "%"))) + table$addColumnInfo(name = "uci", title = gettext("Upper"), type = "number", overtitle = gettextf("%s CI for bias", paste(ciLevelPercent, "%"))) table$addColumnInfo(name = "t", title = gettext("t"), type = "number") table$addColumnInfo(name = "p", title = gettext("p-value"), type = "pvalue") @@ -162,7 +166,7 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { if (ready) { if (nrow(dataset[measurements]) < 2){ - table$setError(gettextf("T-Test requires more than 1 measurement. %1$i valid measurement(s) detected in %2$s.", nrow(dataset[measurements]), measurements)) + table$setError(gettextf("t-test requires more than 1 measurement. %1$i valid measurement(s) detected in %2$s.", nrow(dataset[measurements]), measurements)) return(table) } @@ -184,41 +188,77 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { if (ready) { + plot <- createJaspPlot(title = gettext("Bias histogram"), width = 700, height = 400) + + if (nrow(dataset[measurements]) < 2) { + plot$setError(gettextf("Histogram requires more than 1 measurement. %1$i valid measurement(s) detected in %2$s.", nrow(dataset[measurements]), measurements)) + return(plot) + } + data <- dataset[[measurements]] - plot <- createJaspPlot(title = gettext("Bias Histogram"), width = 700, height = 400) dataForBreaks <- c(data) if (options[["histogramBinWidthType"]] == "freedmanDiaconis") { binWidthType <- "fd" + } else if (options[["histogramBinWidthType"]] == "manual") { + binWidthType <- options[["histogramManualNumberOfBins"]] } else { binWidthType <- options[["histogramBinWidthType"]] } - p <- jaspDescriptives:::.plotMarginal(column = data, variableName = measurements, binWidthType = binWidthType, numberOfBins = options[["histogramManualNumberOfBins"]]) + + h <- hist(data, plot = FALSE, breaks = binWidthType) + binWidth <- (h$breaks[2] - h$breaks[1]) + plotData <- data.frame("x" = c(data)) + p <- ggplot2::ggplot(data = plotData, mapping = ggplot2::aes(x = x)) + + ggplot2::geom_histogram(fill = "grey", col = "black", linewidth = .7, binwidth = binWidth, + closed = options[["histogramBinBoundaryDirection"]], center = binWidth/2, na.rm = TRUE) + + ggplot2::ylab(gettext("Count")) + + jaspGraphs::geom_rangeframe() + + jaspGraphs::themeJaspRaw() if (options[["histogramMeanLine"]]) { mean <- mean(data) + observedsd <- sd(data, na.rm = TRUE) + nSigma <- as.numeric(options[["studyVarianceMultiplier"]])/2 p <- p + ggplot2::geom_vline(ggplot2::aes(xintercept = mean, color = "Mean"), lwd = 1.5) + - ggplot2::scale_color_manual(name = "", values = c("Mean" = "red")) + ggplot2::geom_vline(ggplot2::aes(xintercept = mean - nSigma*observedsd, color = "MeanMinusSigma"), lwd = 1.5, linetype = "dotted") + + ggplot2::geom_vline(ggplot2::aes(xintercept = mean + nSigma*observedsd, color = "MeanPlusSigma"), lwd = 1.5, linetype = "dotted") + + ggplot2::scale_color_manual(name = "", values = c("Mean" = "dodgerblue", "MeanMinusSigma" = "red", "MeanPlusSigma" = "red"), + labels = c(gettext("Mean"), gettextf("Mean - %is", nSigma), gettextf("Mean + %is", nSigma))) dataForBreaks <- c(dataForBreaks, mean) if (options[["histogramMeanCi"]]) { CI <- t.test(data, mu = 0, conf.level = options[["histogramMeanCiLevel"]])$conf.int - p <- p + ggplot2::geom_errorbarh(ggplot2::aes(y = .5, x = mean, xmin = CI[1], xmax = CI[2]), lwd = 1, color = "red") + p <- p + ggplot2::geom_errorbarh(ggplot2::aes(y = .5, xmin = CI[1], xmax = CI[2]), lwd = 1, color = "dodgerblue") dataForBreaks <- c(dataForBreaks, CI) } } if (options[["histogramReferenceValueLine"]]) { reference <- options[["referenceValue"]] + percentTolerance <- options[["percentToleranceForCg"]]/100 + percentToleranceOneSided <- percentTolerance/2 p <- p + ggplot2::geom_vline(ggplot2::aes(xintercept = reference, color = "Reference"), lwd = 1.5) + - ggplot2::scale_color_manual(name = "", values = c("Reference" = "blue")) + ggplot2::geom_vline(ggplot2::aes(xintercept = reference - options[["toleranceRange"]] * percentToleranceOneSided, + color = "RefMinusTol"), lwd = 1.5, linetype = "dashed") + + ggplot2::geom_vline(ggplot2::aes(xintercept = reference + options[["toleranceRange"]] * percentToleranceOneSided, + color = "RefPlusTol"), lwd = 1.5, linetype = "dashed") + + ggplot2::scale_color_manual(name = "", values = c("Reference" = "darkgreen", "RefMinusTol" = "darkred", "RefPlusTol" = "darkred"), + labels = c(gettext("Reference"), gettextf("Ref. - %.2f * tol.", percentToleranceOneSided), + gettextf("Ref. + %.2f * tol.", percentToleranceOneSided))) dataForBreaks <- c(dataForBreaks, reference) } if (options[["histogramReferenceValueLine"]] && options[["histogramMeanLine"]]) - p <- p + ggplot2::scale_color_manual(name = "", values = c("Mean" = "red", "Reference" = "blue")) + p <- p + ggplot2::scale_color_manual(name = "", values = c("Mean" = "dodgerblue", "MeanMinusSigma" = "red", "MeanPlusSigma" = "red", + "Reference" = "darkgreen", "RefMinusTol" = "darkred", "RefPlusTol" = "darkred"), + labels = c(gettext("Mean"), gettextf("Mean - %is", nSigma), gettextf("Mean + %is", nSigma), + gettext("Reference"), + gettextf("Ref. - %.2f * tol.", percentToleranceOneSided), + gettextf("Ref. + %.2f * tol.", percentToleranceOneSided))) + xBreaks <- jaspGraphs::getPrettyAxisBreaks(dataForBreaks) - p <- p + ggplot2::theme(legend.position = "right") + ggplot2::scale_x_continuous(breaks = xBreaks) + p <- p + ggplot2::theme(legend.position = "right") + ggplot2::scale_x_continuous(breaks = xBreaks, name = measurements) - plot$dependOn(c("histogram")) + plot$dependOn(c("histogram", "histogramBinWidthType", "histogramBinBoundaryDirection")) plot$plotObject <- p @@ -231,7 +271,7 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { if (ready) { - plot <- createJaspPlot(title = gettextf("Run Chart of %s", measurements), width = 700, height = 300) + plot <- createJaspPlot(title = gettextf("Run chart of %s", measurements), width = 700, height = 400) dataset <- tidyr::gather(dataset, Repetition, Measurement, measurements[1]:measurements[length(measurements)], factor_key=TRUE) @@ -248,15 +288,15 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { datayBreaks <- c(dataset[["Measurement"]], options[["referenceValue"]]) p <- ggplot2::ggplot() if (options[["runChartToleranceLimitLines"]]) { - toleranceLines <- c(options[["referenceValue"]] + 0.1 * options[["toleranceRange"]], options[["referenceValue"]] - 0.1 * options[["toleranceRange"]]) + percentTolerance <- options[["percentToleranceForCg"]]/100 + percentToleranceOneSided <- percentTolerance/2 + toleranceLines <- c(options[["referenceValue"]] + percentToleranceOneSided * options[["toleranceRange"]], options[["referenceValue"]] - percentToleranceOneSided * options[["toleranceRange"]]) datayBreaks <- c(datayBreaks, toleranceLines) - p <- p + ggplot2::geom_hline(yintercept = toleranceLines[1], data = dataset, - mapping = ggplot2::aes(x = Observation, y = Measurement), color = "darkred") + - ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.2 , y = toleranceLines[1], l = "Ref + 0.1 * Tol"), + p <- p + ggplot2::geom_hline(yintercept = toleranceLines[1], color = "darkred", linetype = "dashed") + + ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.15 , y = toleranceLines[1], l = gettextf("Ref. + %.2f * tol.", percentToleranceOneSided)), ggplot2::aes(x = x, y = y, label = l), vjust="top",hjust="inward", color = "darkred", size = 5) + - ggplot2::geom_hline(yintercept = toleranceLines[2], data = dataset, - mapping = ggplot2::aes(x = Observation, y = Measurement), color = "darkred") + - ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.2, y = toleranceLines[2], l = "Ref - 0.1 * Tol"), + ggplot2::geom_hline(yintercept = toleranceLines[2], color = "darkred", linetype = "dashed") + + ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.15, y = toleranceLines[2], l = gettextf("Ref. - %.2f * tol.", percentToleranceOneSided)), ggplot2::aes(x = x, y = y, label = l), vjust="bottom",hjust="inward", color = "darkred", size = 5) } yBreaks <- jaspGraphs::getPrettyAxisBreaks(datayBreaks) @@ -267,11 +307,23 @@ msaType1Gauge <- function(jaspResults, dataset, options, ...) { } xBreaks <- jaspGraphs::getPrettyAxisBreaks(x = Observation, n = nxBreaks) xBreaks[1] <- 1 + observedMean <- mean(dataset[["Measurement"]], na.rm = TRUE) + observedsd <- sd(dataset[["Measurement"]], na.rm = TRUE) + nSigma <- as.numeric(options[["studyVarianceMultiplier"]])/2 + p <- p + jaspGraphs::geom_line(data = dataset, mapping = ggplot2::aes(x = Observation, y = Measurement, group = 1)) + - ggplot2::geom_hline(yintercept = options[["referenceValue"]], data = dataset, - mapping = ggplot2::aes(x = Observation, y = Measurement), color = "darkgreen") + - ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.1, y = options[["referenceValue"]], l = "Ref"), + ggplot2::geom_hline(yintercept = observedMean + nSigma*observedsd, color = "red", linetype = "dotted") + + ggplot2::geom_hline(yintercept = observedMean - nSigma*observedsd, color = "red", linetype = "dotted") + + ggplot2::geom_hline(yintercept = options[["referenceValue"]], color = "darkgreen") + + ggplot2::geom_hline(yintercept = observedMean, color = "dodgerblue") + + ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.15, y = observedMean + nSigma*observedsd, l = gettextf("Mean + %is", nSigma)), + ggplot2::aes(x = x, y = y, label = l), hjust="inward", color = "red", size = 5) + + ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.15, y = observedMean - nSigma*observedsd, l = gettextf("Mean - %is", nSigma)), + ggplot2::aes(x = x, y = y, label = l), hjust="inward", color = "red", size = 5) + + ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.15, y = options[["referenceValue"]], l = gettext("Ref.")), ggplot2::aes(x = x, y = y, label = l), hjust="inward", color = "darkgreen", size = 5) + + ggrepel::geom_label_repel(data = data.frame(x = max(Observation) * 1.05, y = observedMean, l = gettext("Mean")), + ggplot2::aes(x = x, y = y, label = l), hjust="inward", color = "dodgerblue", size = 5) + ggplot2::scale_x_continuous(name = "Observation", breaks = xBreaks, limits = c(min(xBreaks), max(xBreaks) * 1.2)) + ggplot2::scale_y_continuous(name = measurements, breaks = yBreaks, limits = range(yBreaks)) + jaspGraphs::geom_rangeframe() + diff --git a/inst/help/msaGaugeRRnonrep.md b/inst/help/msaGaugeRRnonrep.md index b6eb6bcb..8e9bf330 100644 --- a/inst/help/msaGaugeRRnonrep.md +++ b/inst/help/msaGaugeRRnonrep.md @@ -1,23 +1,21 @@ -Gauge r&R (Non-Replicable Measurements) +Gauge r&R (Non-replicable Measurements) ========================== -Gauge Repeatability and Reproducibility (Gauge R & R) is an analysis aimed at defining the amount of variation in measurements given a measurement system. This is the version -of the analysis for non-replicable measurements. -
-Both attribute and variable measurement data can be used in the analysis. +Gauge repeatability and Reproducibility (Gauge r&R) is an analysis method aimed at defining the amount of variation in measurements given a measurement system. The variation detected in the measurement is sourced in two factors, repeatability (equipment variation) and Reproducibility (operator variation). This is the version of the analysis for non-replicable measurements. ## Input -### Data Format +### Data format ------- -Data can be in the form of all observations in one column ("Single column") or across rows with a subgroup index ("Across rows"). +Data can be in the form of all observations in one column ("Single column") or across rows with a part identification ("Across rows"). -### Assignment Box -- Operators: the operators in the measurement system. -- Parts: the parts of the measurement system. -- Measurements: the observations/data collected from a process. +### Assignment box +- Operators: the appraisers using the measurement system. +- Parts: the parts selected from the process and representing its entire operating range. +- Measurements: the repeated measurements of each part. -### Gauge r&R Options +### Gauge r&R analysis + #### Analysis options - Std.Deviation reference: either a historically known standard deviation (Historical process std.Deviation) or estimated from the data (Study std.Deviation). - Tolerance: include a value for tolerance. @@ -27,17 +25,32 @@ Data can be in the form of all observations in one column ("Single column") or a - Graph variation components: display the components of variation (contribution, study variation, and tolerance) plot. #### Plots -- R chart by operator: display a plot of the range chart across operators by parts. -- X-bar chart by operator: display a plot of the average chart across operators by parts. -- Measurement by part plot: display a plot of the measurement's means across parts. - - Display all measurements: display all measurement values across parts. -- Measurement by operators plot: display a box plot of the measurement's values across operators. +- Range chart by operator: displays the variation in the measurements made by each operator, allowing you to compare operators to each other. +- Average chart by operator: displays the measurements in relation to the overall average for each operator, allowing you to compare operators to each other, and to the average. +- Scatter plots operators: displays a matrix plot of the relationship between the operators. + - Fit line: fits a linear line to the data points. + - Show origin line: displays the origin line of the data points. +- Measurement by part displays the main effect for the parts, so you can compare the average measurement for each part. + - Display all measurements: displays all measurement values across parts. +- Measurement by operators: displays the main effect for the operators, so you can compare average measurement for each operator. If you have many replicates, boxplots are displayed on the By Operator graph. + ## Output ------- - Gauge r&R (Nested): Nested ANOVA table for the input variables, repeatability, and total Gauge r&R. - Gauge r&R Variance Components: variance and contribution in percentage of the input variables, repeatability, reproducibility, and total Gauge r&R. -- Gauge Evaluation: the standard deviations, study variations, and percent of study variation and tolerance for input variables, repeatability, reproducibility, and total Gauge r&R. +- Gauge Evaluation: the standard deviations, study variations, and percent of study variation and tolerance for input variables, repeatability, reproducibility, and total Gauge r&R. + +## General guideline for acceptance of measurement systems +If the total gauge r&R contribution in the %Study Var. column (%Tolerance, %Process) is: +- %r&R ≤ 10%: measurement system is generally considered to be acceptable +- 10% < %r&R ≤ 30%: may be acceptable for some applications +- %r&R > 30%: measurement system is considered to be unacceptable. + +If you are looking at the %Contribution column, the corresponding standards are: +- Less than 1%: the measurement system is acceptable +- Between 1% and 9%: the measurement system is acceptable depending on the application, the cost of the measuring device, cost of repair, or other factors +- Greater than 9%: the measurement system is unacceptable and should be improved. ## References ------- diff --git a/inst/qml/msaAttribute.qml b/inst/qml/msaAttribute.qml index c9252b82..a7315cca 100644 --- a/inst/qml/msaAttribute.qml +++ b/inst/qml/msaAttribute.qml @@ -125,7 +125,7 @@ Form Section { - title: qsTr("Kappa Study") + title: qsTr("Kappa study") Group { @@ -162,7 +162,7 @@ Form Section { - title: qsTr("Tau Study") + title: qsTr("Tau study") CheckBox { diff --git a/inst/qml/msaGaugeLinearity.qml b/inst/qml/msaGaugeLinearity.qml index 10cb8e91..6c5afc99 100644 --- a/inst/qml/msaGaugeLinearity.qml +++ b/inst/qml/msaGaugeLinearity.qml @@ -106,9 +106,9 @@ Form DoubleField { name: "manualProcessVariationValue" - defaultValue: 6 + defaultValue: 1 negativeValues: false - decimals: 5 + decimals: 7 fieldWidth: 50 } } diff --git a/inst/qml/msaGaugeRR.qml b/inst/qml/msaGaugeRR.qml index d52fb3ea..e82cbbc1 100644 --- a/inst/qml/msaGaugeRR.qml +++ b/inst/qml/msaGaugeRR.qml @@ -129,7 +129,7 @@ Form Group { - title: qsTr("ANOVA Method Options") + title: qsTr("Analysis options") columns: 2 Group @@ -177,7 +177,7 @@ Form CheckBox { name: "anova" - label: qsTr("r&R table ANOVA method") + label: qsTr("r&R ANOVA table") checked: true DropDown @@ -206,7 +206,7 @@ Form DropDown { name: "studyVarianceMultiplierType" - label: qsTr("Study Var. multiplier type") + label: qsTr("Study var. multiplier type") id: studyVarianceMultiplierType indexDefaultValue: 0 values: @@ -219,7 +219,7 @@ Form DoubleField { name: "studyVarianceMultiplierValue" - label: qsTr("Study variation multiplier") + label: qsTr("Study var. multiplier value") fieldWidth: 60 defaultValue: 6 min: 0.001 @@ -243,14 +243,14 @@ Form CheckBox { name: "rChart" - label: qsTr("R charts by operator") + label: qsTr("Range charts by operator") enabled: !type3.checked } CheckBox { name: "xBarChart" - label: qsTr("Average charts by operator") + label: qsTr("Average chart bys operator") enabled: !type3.checked } @@ -309,7 +309,7 @@ Form Section { - title: qsTr("ANOVA Method Report") + title: qsTr("Report options") CheckBox { @@ -474,6 +474,13 @@ Form Group { title: qsTr("Select Report Components") + + CheckBox + { + name: "reportGaugeTable" + label: qsTr("Show gauge evaluation table") + checked: true + } CheckBox { @@ -492,7 +499,7 @@ Form CheckBox { name: "reportRChartByOperator" - label: qsTr("Show R chart by operator") + label: qsTr("Show range charts by operator") checked: true } @@ -506,7 +513,7 @@ Form CheckBox { name: "reportAverageChartByOperator" - label: qsTr("Show average chart by operator") + label: qsTr("Show average charts by operator") checked: true } @@ -519,7 +526,7 @@ Form CheckBox { - name: "reportTrafficLightCHart" + name: "reportTrafficLightChart" label: qsTr("Show traffic light chart") checked: true } diff --git a/inst/qml/msaGaugeRRnonrep.qml b/inst/qml/msaGaugeRRnonrep.qml index c7fbdeec..96ad0609 100644 --- a/inst/qml/msaGaugeRRnonrep.qml +++ b/inst/qml/msaGaugeRRnonrep.qml @@ -105,127 +105,129 @@ Form } } - Section + Group { - title: qsTr("Gauge r&R Options") + title: qsTr("Analysis options") - Group + DropDown { - title: qsTr("Analysis Options") + name: "processVariationReference" + label: qsTr("Std. dev. reference") + id: variationReference + indexDefaultValue: 0 + values: [ + { label: qsTr("Study std. dev."), value: "studySd"}, + { label: qsTr("Historical process std. dev."), value: "historicalSd"} + ] + } - DropDown - { - name: "processVariationReference" - label: qsTr("Std. Deviation reference") - id: variationReference - indexDefaultValue: 0 - values: [ - { label: qsTr("Study Std. Deviation"), value: "studySd"}, - { label: qsTr("Historical process Std. Deviation"), value: "historicalSd"} - ] - } + DoubleField + { + name: "historicalSdValue" + label: qsTr("Std. dev. value") + defaultValue: 3 + enabled: variationReference.currentValue == "historicalSd" + } + + CheckBox + { + name: "tolerance" + label: qsTr("Tolerance width") + childrenOnSameRow: true DoubleField { - name: "historicalSdValue" - label: qsTr("Std. Deviation value") - defaultValue: 3 - enabled: variationReference.currentValue == "historicalSd" + name: "toleranceValue" + defaultValue: 1 + min: 0 + inclusive: JASP.MaxOnly + decimals: 9 } + } - CheckBox - { - name: "tolerance" - label: qsTr("Tolerance") - childrenOnSameRow: true + CheckBox + { + name: "anova" + label: qsTr("r&R ANOVA table") + checked: true - DoubleField - { - name: "toleranceValue" - defaultValue: 1 - min: 0.000000001 - decimals: 9 - } + DropDown + { + name: "studyVarianceMultiplierType" + label: qsTr("Study var. multiplier type") + id: studyVarMultiplierType + indexDefaultValue: 0 + values: + [ + { label: qsTr("Std. dev."), value: "sd"}, + { label: qsTr("Percent"), value: "percent"} + ] } - CheckBox + DoubleField { - name: "anova" - label: qsTr("r&R table ANOVA method") - checked: true + name: "studyVarianceMultiplierValue" + label: qsTr("Study var. multiplier value") + fieldWidth: 60 + defaultValue: 6 + min: 0.001 + max: 99.999 + decimals: 3 + } + } + } - DropDown - { - name: "studyVarianceMultiplierType" - label: qsTr("Study Var. multiplier type") - id: studyVarMultiplierType - indexDefaultValue: 0 - values: - [ - { label: qsTr("Std. Deviation"), value: "sd"}, - { label: qsTr("Percent"), value: "percent"} - ] - } + Group + { + title: qsTr("Plots") - DoubleField - { - name: "studyVarianceMultiplierValue" - label: qsTr("Study Var. multiplier value") - fieldWidth: 60 - defaultValue: 6 - min: 0.001 - max: 99.999 - decimals: 3 - } - } + CheckBox + { + name: "varianceComponentsGraph" + label: qsTr("Graph variation components") + checked: true } - Group + CheckBox { - title: qsTr("Plots") + name: "rChart" + label: qsTr("Range charts by operator") + } - CheckBox - { - name: "varianceComponentsGraph" - label: qsTr("Graph variation components") - checked: true - } + CheckBox + { + name: "xBarChart" + label: qsTr("Average charts by operator") + } - CheckBox - { - name: "rChart" - label: qsTr("R charts by operator") - } + CheckBox + { + name: "partMeasurementPlot" + label: qsTr("Measurements by part plot") CheckBox { - name: "xBarChart" - label: qsTr("Average charts by operator") + name: "partMeasurementPlotAllValues" + label: qsTr("Display all measurements") } + } - CheckBox - { - name: "partMeasurementPlot" - label: qsTr("Measurements by part plot") - - CheckBox - { - name: "partMeasurementPlotAllValues" - label: qsTr("Display all measurements") - } - } + CheckBox + { + name: "operatorMeasurementPlot" + label: qsTr("Measurements by operator plot") + } - CheckBox - { - name: "operatorMeasurementPlot" - label: qsTr("Measurements by operator plot") - } + CheckBox + { + name: "trafficLightChart" + label: qsTr("Traffic light chart") } } Section { - title: qsTr("Gauge r&R Report") + title: qsTr("Report options") CheckBox { @@ -253,7 +255,7 @@ Form name: "reportTitleText" label: qsTr("Title") id: reportTitleText - placeholderText: qsTr("Gauge r&R Report") + placeholderText: qsTr("Gauge r&R report") fieldWidth: 100 } } @@ -392,6 +394,13 @@ Form { title: qsTr("Select Report Components") + CheckBox + { + name: "reportGaugeTable" + label: qsTr("Show gauge evaluation table") + checked: true + } + CheckBox { name: "reportVariationComponents" @@ -402,7 +411,7 @@ Form CheckBox { name: "reportRChartByOperator" - label: qsTr("Show R chart by operator") + label: qsTr("Show range chart by operator") checked: true } @@ -419,6 +428,13 @@ Form label: qsTr("Show average chart by operator") checked: true } + + CheckBox + { + name: "reportTrafficLightChart" + label: qsTr("Show traffic light chart") + checked: true + } } } } diff --git a/inst/qml/msaTestRetest.qml b/inst/qml/msaTestRetest.qml index a600b410..f7fd03cf 100644 --- a/inst/qml/msaTestRetest.qml +++ b/inst/qml/msaTestRetest.qml @@ -69,7 +69,7 @@ Form AssignedVariablesList { name: "operator" - title: qsTr("Operator / Repetition") + title: qsTr("Operator/Repetition") singleVariable: true allowedColumns: ["nominal"] } @@ -105,88 +105,84 @@ Form } - - Section + Group { - title: qsTr("Range Method Options") + title: qsTr("Analysis options") - Group + CheckBox { - title: qsTr("Analysis Options") + name: "manualProcessSd" + label: qsTr("Process std. dev.") + childrenOnSameRow: true - CheckBox + DoubleField { - name: "manualProcessSd" - label: qsTr("Process Std. Deviation") - childrenOnSameRow: true - - DoubleField - { - name: "manualProcessSdValue" - } + name: "manualProcessSdValue" + defaultValue: 1 } + } - CheckBox - { - name: "tolerance" - label: qsTr("Tolerance") - childrenOnSameRow: true - - DoubleField - { - name: "toleranceValue" - } - } + CheckBox + { + name: "tolerance" + label: qsTr("Tolerance") + childrenOnSameRow: true - CheckBox + DoubleField { - name: "repeatabilityAndReproducibilityTable" - label: qsTr("r&R table") - checked: true + name: "toleranceValue" + defaultValue: 1 } } - Group + CheckBox { - title: qsTr("Plots") + name: "repeatabilityAndReproducibilityTable" + label: qsTr("r&R table") + checked: true + } + } - CheckBox - { - name: "runChartPart" - label: qsTr("Run chart of parts") - } + Group + { + title: qsTr("Plots") - CheckBox - { - name: "scatterPlotMeasurement" - label: qsTr("Scatter plot measurement") - checked: true - - CheckBox - { - name: "scatterPlotMeasurementFitLine" - label: qsTr("Fit line") - checked: true - } - - CheckBox - { - name: "scatterPlotMeasurementAllValues" - label: qsTr("Display all measurements") - } - } + CheckBox + { + name: "runChartPart" + label: qsTr("Run chart of parts") + } + + CheckBox + { + name: "scatterPlotMeasurement" + label: qsTr("Scatter plot measurement") + checked: true CheckBox { - name: "rChart" - label: qsTr("Range chart") + name: "scatterPlotMeasurementFitLine" + label: qsTr("Fit line") + checked: true } CheckBox { - name: "trafficLightChart" - label: qsTr("Traffic light chart") + name: "scatterPlotMeasurementAllValues" + label: qsTr("Display all measurements") } } + + CheckBox + { + name: "rChart" + label: qsTr("Range chart") + } + + CheckBox + { + name: "trafficLightChart" + label: qsTr("Traffic light chart") + } } } diff --git a/inst/qml/msaType1Gauge.qml b/inst/qml/msaType1Gauge.qml index 9abf9ad9..ac786aa6 100644 --- a/inst/qml/msaType1Gauge.qml +++ b/inst/qml/msaType1Gauge.qml @@ -47,7 +47,7 @@ Form DoubleField { name: "referenceValue" - label: qsTr("Reference value") + label: qsTr("Reference/master value") defaultValue: 0 negativeValues: true decimals: 9 @@ -71,13 +71,13 @@ Form defaultValue: 20 negativeValues: false min: 0.001 - max: 99.999 + max: 100 } DropDown { name: "studyVarianceMultiplier" - label: qsTr("Study var. (number of std. deviations)") + label: qsTr("Number of std. dev. for instrument variation") id: studyVarMultiplier indexDefaultValue: 0 values: @@ -86,6 +86,12 @@ Form { label: qsTr("4"), value: 4} ] } + } + + Group + { + title: qsTr("Bias study options") + CheckBox { @@ -97,7 +103,7 @@ Form CheckBox { name: "tTest" - label: qsTr("One sample T-test") + label: qsTr("One sample t-test") checked: true CIField @@ -128,7 +134,7 @@ Form CheckBox { name: "runChartToleranceLimitLines" - label: qsTr("Display tolerance limits") + label: qsTr("Display boundaries of the reference interval") checked: true } } @@ -138,6 +144,19 @@ Form name: "histogram" label: qsTr("Histogram") + DropDown + { + name: "histogramBinBoundaryDirection" + id: histogramBinBoundaryDirection + label: qsTr("Histogram bin boundaries") + values: + [ + { label: qsTr("Left open"), value: "left"}, + { label: qsTr("Right open"), value: "right"} + + ] + } + DropDown { name: "histogramBinWidthType" diff --git a/inst/qml/timeWeightedCharts.qml b/inst/qml/timeWeightedCharts.qml index 960b9e09..aac05c85 100644 --- a/inst/qml/timeWeightedCharts.qml +++ b/inst/qml/timeWeightedCharts.qml @@ -33,7 +33,6 @@ Form name: "cumulativeSumChart" label: qsTr("Cumulative sum chart") checked: true - debug: true DoubleField { diff --git a/tests/testthat/AAALong.csv b/tests/testthat/AAALong.csv deleted file mode 100644 index b7e0b363..00000000 --- a/tests/testthat/AAALong.csv +++ /dev/null @@ -1,136 +0,0 @@ -"","Part","Operator","Results","Repeat","Reference","Appraiser","X","X.1" -"1",1,"EG","Yes",1,"Yes","A",NA,"Visual inspection of black spots" -"2",1,"EG","Yes",2,"Yes","A",NA,"Bore of inner ring of plain bearings" -"3",1,"EG","Yes",3,"Yes","A",NA,"Black spots do exist or do not exist" -"4",2,"EG","No",1,"No","A",NA,"" -"5",2,"EG","No",2,"No","A",NA,"Three appraisers" -"6",2,"EG","No",3,"No","A",NA,"The subject matter expert was involved to determine the standard" -"7",3,"EG","Yes",1,"Yes","A",NA,"" -"8",3,"EG","Yes",2,"Yes","A",NA,"" -"9",3,"EG","Yes",3,"Yes","A",NA,"" -"10",4,"EG","Yes",1,"Yes","A",NA,"" -"11",4,"EG","No",2,"Yes","A",NA,"" -"12",4,"EG","No",3,"Yes","A",NA,"" -"13",5,"EG","Yes",1,"Yes","A",NA,"" -"14",5,"EG","Yes",2,"Yes","A",NA,"" -"15",5,"EG","Yes",3,"Yes","A",NA,"" -"16",6,"EG","Yes",1,"No","A",NA,"" -"17",6,"EG","Yes",2,"No","A",NA,"" -"18",6,"EG","Yes",3,"No","A",NA,"" -"19",7,"EG","Yes",1,"Yes","A",NA,"" -"20",7,"EG","Yes",2,"Yes","A",NA,"" -"21",7,"EG","Yes",3,"Yes","A",NA,"" -"22",8,"EG","No",1,"No","A",NA,"" -"23",8,"EG","No",2,"No","A",NA,"" -"24",8,"EG","No",3,"No","A",NA,"" -"25",9,"EG","No",1,"No","A",NA,"" -"26",9,"EG","No",2,"No","A",NA,"" -"27",9,"EG","No",3,"No","A",NA,"" -"28",10,"EG","Yes",1,"Yes","A",NA,"" -"29",10,"EG","Yes",2,"Yes","A",NA,"" -"30",10,"EG","Yes",3,"Yes","A",NA,"" -"31",11,"EG","No",1,"No","A",NA,"" -"32",11,"EG","No",2,"No","A",NA,"" -"33",11,"EG","No",3,"No","A",NA,"" -"34",12,"EG","Yes",1,"Yes","A",NA,"" -"35",12,"EG","Yes",2,"Yes","A",NA,"" -"36",12,"EG","Yes",3,"Yes","A",NA,"" -"37",13,"EG","Yes",1,"Yes","A",NA,"" -"38",13,"EG","Yes",2,"Yes","A",NA,"" -"39",13,"EG","Yes",3,"Yes","A",NA,"" -"40",14,"EG","No",1,"Yes","A",NA,"" -"41",14,"EG","No",2,"Yes","A",NA,"" -"42",14,"EG","No",3,"Yes","A",NA,"" -"43",15,"EG","Yes",1,"Yes","A",NA,"" -"44",15,"EG","Yes",2,"Yes","A",NA,"" -"45",15,"EG","Yes",3,"Yes","A",NA,"" -"46",1,"BL","Yes",1,"Yes","B",NA,"" -"47",1,"BL","Yes",2,"Yes","B",NA,"" -"48",1,"BL","Yes",3,"Yes","B",NA,"" -"49",2,"BL","No",1,"No","B",NA,"" -"50",2,"BL","No",2,"No","B",NA,"" -"51",2,"BL","No",3,"No","B",NA,"" -"52",3,"BL","Yes",1,"Yes","B",NA,"" -"53",3,"BL","Yes",2,"Yes","B",NA,"" -"54",3,"BL","Yes",3,"Yes","B",NA,"" -"55",4,"BL","Yes",1,"Yes","B",NA,"" -"56",4,"BL","No",2,"Yes","B",NA,"" -"57",4,"BL","No",3,"Yes","B",NA,"" -"58",5,"BL","Yes",1,"Yes","B",NA,"" -"59",5,"BL","Yes",2,"Yes","B",NA,"" -"60",5,"BL","Yes",3,"Yes","B",NA,"" -"61",6,"BL","Yes",1,"No","B",NA,"" -"62",6,"BL","Yes",2,"No","B",NA,"" -"63",6,"BL","Yes",3,"No","B",NA,"" -"64",7,"BL","No",1,"Yes","B",NA,"" -"65",7,"BL","No",2,"Yes","B",NA,"" -"66",7,"BL","No",3,"Yes","B",NA,"" -"67",8,"BL","No",1,"No","B",NA,"" -"68",8,"BL","No",2,"No","B",NA,"" -"69",8,"BL","No",3,"No","B",NA,"" -"70",9,"BL","No",1,"No","B",NA,"" -"71",9,"BL","No",2,"No","B",NA,"" -"72",9,"BL","No",3,"No","B",NA,"" -"73",10,"BL","Yes",1,"Yes","B",NA,"" -"74",10,"BL","Yes",2,"Yes","B",NA,"" -"75",10,"BL","Yes",3,"Yes","B",NA,"" -"76",11,"BL","No",1,"No","B",NA,"" -"77",11,"BL","No",2,"No","B",NA,"" -"78",11,"BL","No",3,"No","B",NA,"" -"79",12,"BL","Yes",1,"Yes","B",NA,"" -"80",12,"BL","Yes",2,"Yes","B",NA,"" -"81",12,"BL","Yes",3,"Yes","B",NA,"" -"82",13,"BL","Yes",1,"Yes","B",NA,"" -"83",13,"BL","Yes",2,"Yes","B",NA,"" -"84",13,"BL","Yes",3,"Yes","B",NA,"" -"85",14,"BL","No",1,"Yes","B",NA,"" -"86",14,"BL","No",2,"Yes","B",NA,"" -"87",14,"BL","No",3,"Yes","B",NA,"" -"88",15,"BL","Yes",1,"Yes","B",NA,"" -"89",15,"BL","Yes",2,"Yes","B",NA,"" -"90",15,"BL","Yes",3,"Yes","B",NA,"" -"91",1,"MH","Yes",1,"Yes","C",NA,"" -"92",1,"MH","Yes",2,"Yes","C",NA,"" -"93",1,"MH","Yes",3,"Yes","C",NA,"" -"94",2,"MH","Yes",1,"No","C",NA,"" -"95",2,"MH","Yes",2,"No","C",NA,"" -"96",2,"MH","Yes",3,"No","C",NA,"" -"97",3,"MH","Yes",1,"Yes","C",NA,"" -"98",3,"MH","Yes",2,"Yes","C",NA,"" -"99",3,"MH","Yes",3,"Yes","C",NA,"" -"100",4,"MH","Yes",1,"Yes","C",NA,"" -"101",4,"MH","Yes",2,"Yes","C",NA,"" -"102",4,"MH","Yes",3,"Yes","C",NA,"" -"103",5,"MH","Yes",1,"Yes","C",NA,"" -"104",5,"MH","Yes",2,"Yes","C",NA,"" -"105",5,"MH","Yes",3,"Yes","C",NA,"" -"106",6,"MH","Yes",1,"No","C",NA,"" -"107",6,"MH","Yes",2,"No","C",NA,"" -"108",6,"MH","Yes",3,"No","C",NA,"" -"109",7,"MH","Yes",1,"Yes","C",NA,"" -"110",7,"MH","Yes",2,"Yes","C",NA,"" -"111",7,"MH","Yes",3,"Yes","C",NA,"" -"112",8,"MH","No",1,"No","C",NA,"" -"113",8,"MH","No",2,"No","C",NA,"" -"114",8,"MH","Yes",3,"No","C",NA,"" -"115",9,"MH","Yes",1,"No","C",NA,"" -"116",9,"MH","No",2,"No","C",NA,"" -"117",9,"MH","No",3,"No","C",NA,"" -"118",10,"MH","Yes",1,"Yes","C",NA,"" -"119",10,"MH","Yes",2,"Yes","C",NA,"" -"120",10,"MH","Yes",3,"Yes","C",NA,"" -"121",11,"MH","Yes",1,"No","C",NA,"" -"122",11,"MH","No",2,"No","C",NA,"" -"123",11,"MH","Yes",3,"No","C",NA,"" -"124",12,"MH","Yes",1,"Yes","C",NA,"" -"125",12,"MH","Yes",2,"Yes","C",NA,"" -"126",12,"MH","Yes",3,"Yes","C",NA,"" -"127",13,"MH","Yes",1,"Yes","C",NA,"" -"128",13,"MH","Yes",2,"Yes","C",NA,"" -"129",13,"MH","Yes",3,"Yes","C",NA,"" -"130",14,"MH","No",1,"Yes","C",NA,"" -"131",14,"MH","No",2,"Yes","C",NA,"" -"132",14,"MH","No",3,"Yes","C",NA,"" -"133",15,"MH","Yes",1,"Yes","C",NA,"" -"134",15,"MH","Yes",2,"Yes","C",NA,"" -"135",15,"MH","Yes",3,"Yes","C",NA,"" diff --git a/tests/testthat/AAARow.csv b/tests/testthat/AAARow.csv deleted file mode 100644 index d2869e22..00000000 --- a/tests/testthat/AAARow.csv +++ /dev/null @@ -1,46 +0,0 @@ -"","Operator","Part","Repeat.1","Repeat.2","Repeat.3","Reference","X","X.1" -"1","EG",1,"Yes","Yes","Yes","Yes",NA,"Visual inspection of black spots" -"2","EG",2,"No","No","No","No",NA,"Bore of inner ring of plain bearings" -"3","EG",3,"Yes","Yes","Yes","Yes",NA,"Black spots do exist or do not exist" -"4","EG",4,"Yes","No","No","Yes",NA,"" -"5","EG",5,"Yes","Yes","Yes","Yes",NA,"Three appraisers" -"6","EG",6,"Yes","Yes","Yes","No",NA,"The subject matter expert was involved to determine the standard" -"7","EG",7,"Yes","Yes","Yes","Yes",NA,"" -"8","EG",8,"No","No","No","No",NA,"Location: Airasca" -"9","EG",9,"No","No","No","No",NA,"Product: Plain bearings" -"10","EG",10,"Yes","Yes","Yes","Yes",NA,"" -"11","EG",11,"No","No","No","No",NA,"" -"12","EG",12,"Yes","Yes","Yes","Yes",NA,"" -"13","EG",13,"Yes","Yes","Yes","Yes",NA,"" -"14","EG",14,"No","No","No","Yes",NA,"" -"15","EG",15,"Yes","Yes","Yes","Yes",NA,"" -"16","BL",1,"Yes","Yes","Yes","Yes",NA,"" -"17","BL",2,"No","No","No","No",NA,"" -"18","BL",3,"Yes","Yes","Yes","Yes",NA,"" -"19","BL",4,"Yes","No","No","Yes",NA,"" -"20","BL",5,"Yes","Yes","Yes","Yes",NA,"" -"21","BL",6,"Yes","Yes","Yes","No",NA,"" -"22","BL",7,"No","No","No","Yes",NA,"" -"23","BL",8,"No","No","No","No",NA,"" -"24","BL",9,"No","No","No","No",NA,"" -"25","BL",10,"Yes","Yes","Yes","Yes",NA,"" -"26","BL",11,"No","No","No","No",NA,"" -"27","BL",12,"Yes","Yes","Yes","Yes",NA,"" -"28","BL",13,"Yes","Yes","Yes","Yes",NA,"" -"29","BL",14,"No","No","No","Yes",NA,"" -"30","BL",15,"Yes","Yes","Yes","Yes",NA,"" -"31","MH",1,"Yes","Yes","Yes","Yes",NA,"" -"32","MH",2,"Yes","Yes","Yes","No",NA,"" -"33","MH",3,"Yes","Yes","Yes","Yes",NA,"" -"34","MH",4,"Yes","Yes","Yes","Yes",NA,"" -"35","MH",5,"Yes","Yes","Yes","Yes",NA,"" -"36","MH",6,"Yes","Yes","Yes","No",NA,"" -"37","MH",7,"Yes","Yes","Yes","Yes",NA,"" -"38","MH",8,"No","No","Yes","No",NA,"" -"39","MH",9,"Yes","No","No","No",NA,"" -"40","MH",10,"Yes","Yes","Yes","Yes",NA,"" -"41","MH",11,"Yes","No","Yes","No",NA,"" -"42","MH",12,"Yes","Yes","Yes","Yes",NA,"" -"43","MH",13,"Yes","Yes","Yes","Yes",NA,"" -"44","MH",14,"No","No","No","Yes",NA,"" -"45","MH",15,"Yes","Yes","Yes","Yes",NA,"" diff --git a/tests/testthat/DoEFactorialAnalysis.csv b/tests/testthat/DoEFactorialAnalysis.csv deleted file mode 100644 index ac8e9826..00000000 --- a/tests/testthat/DoEFactorialAnalysis.csv +++ /dev/null @@ -1,17 +0,0 @@ -StdOrder,RunOrder,CenterPt,Blocks,Aperture_setting,Exposure_time,Develop_time,Mask_dimension,Etch time,Yield,, -1,2,1,1,small,below,30,small,15.5,8,,Douglas C. Montgomery -2,9,1,1,large,below,30,small,14.5,9,,Design and Analysis of Experiments -3,12,1,1,small,above,30,small,14.5,34,,5th Edition -4,3,1,1,large,above,30,small,15.5,52,,Page 310 -5,11,1,1,small,below,45,small,14.5,16,, -6,6,1,1,large,below,45,small,15.5,22,,Example 8-2 -7,13,1,1,small,above,45,small,15.5,45,,Five factors in a maufacturing process for an integrated circuit -8,16,1,1,large,above,45,small,14.5,60,,were investigated in a 2^(5-1) design with the objective of -9,15,1,1,small,below,30,large,14.5,6,,improving the process yield. -10,10,1,1,large,below,30,large,15.5,10,,E = ABCD -11,7,1,1,small,above,30,large,15.5,30,, -12,8,1,1,large,above,30,large,14.5,50,, -13,4,1,1,small,below,45,large,15.5,15,, -14,1,1,1,large,below,45,large,14.5,21,, -15,14,1,1,small,above,45,large,14.5,44,, -16,5,1,1,large,above,45,large,15.5,63,, diff --git a/tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard2.svg b/tests/testthat/_snaps/msaAttribute/lf1-each-appraiser-vs-standard.svg similarity index 98% rename from tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard2.svg rename to tests/testthat/_snaps/msaAttribute/lf1-each-appraiser-vs-standard.svg index b8211238..e2bf0c5a 100644 --- a/tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard2.svg +++ b/tests/testthat/_snaps/msaAttribute/lf1-each-appraiser-vs-standard.svg @@ -27,15 +27,15 @@ - + - - - + + + @@ -76,6 +76,6 @@ MH Appraiser Percent -each-appraiser-vs-standard2 +LF1_each-appraiser-vs-standard diff --git a/tests/testthat/_snaps/msaAttribute/within-appraisers2.svg b/tests/testthat/_snaps/msaAttribute/lf1-within-appraisers.svg similarity index 98% rename from tests/testthat/_snaps/msaAttribute/within-appraisers2.svg rename to tests/testthat/_snaps/msaAttribute/lf1-within-appraisers.svg index 2a321a6c..c97e4fdc 100644 --- a/tests/testthat/_snaps/msaAttribute/within-appraisers2.svg +++ b/tests/testthat/_snaps/msaAttribute/lf1-within-appraisers.svg @@ -27,15 +27,15 @@ - + - - - + + + @@ -76,6 +76,6 @@ MH Appraiser Percent -within-appraisers2 +LF1_within-appraisers diff --git a/tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard3.svg b/tests/testthat/_snaps/msaAttribute/lf2-each-appraiser-vs-standard.svg similarity index 98% rename from tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard3.svg rename to tests/testthat/_snaps/msaAttribute/lf2-each-appraiser-vs-standard.svg index f0cd2a9a..359b2719 100644 --- a/tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard3.svg +++ b/tests/testthat/_snaps/msaAttribute/lf2-each-appraiser-vs-standard.svg @@ -82,6 +82,6 @@ D Appraiser Percent -each-appraiser-vs-standard3 +LF2_each-appraiser-vs-standard diff --git a/tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard.svg b/tests/testthat/_snaps/msaAttribute/wf1-each-appraiser-vs-standard.svg similarity index 98% rename from tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard.svg rename to tests/testthat/_snaps/msaAttribute/wf1-each-appraiser-vs-standard.svg index 3127afed..112d14bd 100644 --- a/tests/testthat/_snaps/msaAttribute/each-appraiser-vs-standard.svg +++ b/tests/testthat/_snaps/msaAttribute/wf1-each-appraiser-vs-standard.svg @@ -27,15 +27,15 @@ - + - - - + + + @@ -76,6 +76,6 @@ MH Appraiser Percent -each-appraiser-vs-standard +WF1_each-appraiser-vs-standard diff --git a/tests/testthat/_snaps/msaAttribute/within-appraisers.svg b/tests/testthat/_snaps/msaAttribute/wf1-within-appraisers.svg similarity index 98% rename from tests/testthat/_snaps/msaAttribute/within-appraisers.svg rename to tests/testthat/_snaps/msaAttribute/wf1-within-appraisers.svg index 6e242fdc..573c0f60 100644 --- a/tests/testthat/_snaps/msaAttribute/within-appraisers.svg +++ b/tests/testthat/_snaps/msaAttribute/wf1-within-appraisers.svg @@ -27,15 +27,15 @@ - + - - - + + + @@ -76,6 +76,6 @@ MH Appraiser Percent -within-appraisers +WF1_within-appraisers diff --git a/tests/testthat/_snaps/msaGaugeLinearity/bias-and-linearity.svg b/tests/testthat/_snaps/msaGaugeLinearity/1-bias-and-linearity.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeLinearity/bias-and-linearity.svg rename to tests/testthat/_snaps/msaGaugeLinearity/1-bias-and-linearity.svg index 1a2347db..33e06f5f 100644 --- a/tests/testthat/_snaps/msaGaugeLinearity/bias-and-linearity.svg +++ b/tests/testthat/_snaps/msaGaugeLinearity/1-bias-and-linearity.svg @@ -97,7 +97,6 @@ -y = 0.74 - 0.13x @@ -125,6 +124,6 @@ 10 Reference Bias -bias-and-linearity +1_bias-and-linearity diff --git a/tests/testthat/_snaps/msaGaugeLinearity/percentage-process-variation-graph.svg b/tests/testthat/_snaps/msaGaugeLinearity/1-percentage-process-variation-graph.svg similarity index 91% rename from tests/testthat/_snaps/msaGaugeLinearity/percentage-process-variation-graph.svg rename to tests/testthat/_snaps/msaGaugeLinearity/1-percentage-process-variation-graph.svg index ba85145a..572cfbfb 100644 --- a/tests/testthat/_snaps/msaGaugeLinearity/percentage-process-variation-graph.svg +++ b/tests/testthat/_snaps/msaGaugeLinearity/1-percentage-process-variation-graph.svg @@ -27,8 +27,8 @@ - - + + @@ -54,9 +54,9 @@ -Bias -Linearity +Linearity +Bias Percent -percentage-process-variation-graph +1_percentage-process-variation-graph diff --git a/tests/testthat/_snaps/msaGaugeLinearity/2-bias-and-linearity.svg b/tests/testthat/_snaps/msaGaugeLinearity/2-bias-and-linearity.svg new file mode 100644 index 00000000..3d1df457 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeLinearity/2-bias-and-linearity.svg @@ -0,0 +1,115 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X + + + + + + + + + + + +-1 +0 +1 +2 + + + + + + + + + + +2 +4 +6 +8 +10 +Reference +Bias +2_bias-and-linearity + + diff --git a/tests/testthat/_snaps/msaGaugeLinearity/2-percentage-process-variation-graph.svg b/tests/testthat/_snaps/msaGaugeLinearity/2-percentage-process-variation-graph.svg new file mode 100644 index 00000000..05ed6d36 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeLinearity/2-percentage-process-variation-graph.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +2 +4 +6 +8 +10 +12 +14 + + + + + + + + + + + +Linearity +Bias +Percent +2_percentage-process-variation-graph + + diff --git a/tests/testthat/_snaps/msaGaugeRR/average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/1-average-chart-by-operator.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRR/average-chart-by-operator.svg rename to tests/testthat/_snaps/msaGaugeRR/1-average-chart-by-operator.svg index 3f07197b..dba4ed09 100644 --- a/tests/testthat/_snaps/msaGaugeRR/average-chart-by-operator.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-average-chart-by-operator.svg @@ -117,6 +117,6 @@ 10 Sample Sample average -average-chart-by-operator +1_average-chart-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRR/1-components-of-variation.svg b/tests/testthat/_snaps/msaGaugeRR/1-components-of-variation.svg new file mode 100644 index 00000000..29270d5a --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/1-components-of-variation.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 +200 + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +1_components-of-variation + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-1.svg similarity index 93% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-1.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-1.svg index b096665c..e3897277 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-1.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-1.svg @@ -29,6 +29,6 @@ Operator A -matrix-plot-for-operators-subplot-1 +1_matrix-plot-for-operators-subplot-1 diff --git a/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-10.svg new file mode 100644 index 00000000..eb96a2ee --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-10.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +1_matrix-plot-for-operators-subplot-10 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-11.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-11.svg new file mode 100644 index 00000000..b7eb358a --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-11.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +1_matrix-plot-for-operators-subplot-11 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-12.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-12.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-12.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-12.svg index ffebc106..9377b4ef 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-12.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-12.svg @@ -29,6 +29,6 @@ Operator C -matrix-plot-for-operators-subplot-12 +1_matrix-plot-for-operators-subplot-12 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-13.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-13.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-13.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-13.svg index 1efe9902..891c54af 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-13.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-13.svg @@ -74,6 +74,6 @@ -4 -2 0 -matrix-plot-for-operators-subplot-13 +1_matrix-plot-for-operators-subplot-13 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-14.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-14.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-14.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-14.svg index e5215fc9..9aaf881c 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-14.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-14.svg @@ -74,6 +74,6 @@ -4 -2 0 -matrix-plot-for-operators-subplot-14 +1_matrix-plot-for-operators-subplot-14 diff --git a/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-15.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-15.svg new file mode 100644 index 00000000..3471bc15 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-15.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +1_matrix-plot-for-operators-subplot-15 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-2.svg similarity index 93% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-2.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-2.svg index d42fe227..eb2b4212 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-2.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-2.svg @@ -29,6 +29,6 @@ Operator B -matrix-plot-for-operators-subplot-2 +1_matrix-plot-for-operators-subplot-2 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-3.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-3.svg similarity index 93% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-3.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-3.svg index 9dbad6e5..92c8dfeb 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-3.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-3.svg @@ -29,6 +29,6 @@ Operator C -matrix-plot-for-operators-subplot-3 +1_matrix-plot-for-operators-subplot-3 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-4.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-4.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-4.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-4.svg index 514424a6..f332d185 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-4.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-4.svg @@ -29,6 +29,6 @@ Operator A -matrix-plot-for-operators-subplot-4 +1_matrix-plot-for-operators-subplot-4 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-15.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-5.svg similarity index 91% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-15.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-5.svg index 732a8500..45d953d0 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-15.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-5.svg @@ -27,6 +27,6 @@ -matrix-plot-for-operators-subplot-15 +1_matrix-plot-for-operators-subplot-5 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-6.svg similarity index 91% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-10.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-6.svg index 5196709a..8bf118db 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-10.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-6.svg @@ -27,6 +27,6 @@ -matrix-plot-for-operators-subplot-10 +1_matrix-plot-for-operators-subplot-6 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-11.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-7.svg similarity index 91% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-11.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-7.svg index d9087668..7224267c 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-11.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-7.svg @@ -27,6 +27,6 @@ -matrix-plot-for-operators-subplot-11 +1_matrix-plot-for-operators-subplot-7 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-8.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-8.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-8.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-8.svg index aa88bb1c..9a2d6b7c 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-8.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-8.svg @@ -29,6 +29,6 @@ Operator B -matrix-plot-for-operators-subplot-8 +1_matrix-plot-for-operators-subplot-8 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-9.svg b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-9.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-9.svg rename to tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-9.svg index f5f9d065..90f3a9be 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-9.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-matrix-plot-for-operators-subplot-9.svg @@ -74,6 +74,6 @@ -4 -2 0 -matrix-plot-for-operators-subplot-9 +1_matrix-plot-for-operators-subplot-9 diff --git a/tests/testthat/_snaps/msaGaugeRR/measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/1-measurements-by-operator.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRR/measurements-by-operator.svg rename to tests/testthat/_snaps/msaGaugeRR/1-measurements-by-operator.svg index c5598da2..59b2cb1d 100644 --- a/tests/testthat/_snaps/msaGaugeRR/measurements-by-operator.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-measurements-by-operator.svg @@ -62,6 +62,6 @@ Operator C Operators Measurement -measurements-by-operator +1_measurements-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRR/measurements-by-part.svg b/tests/testthat/_snaps/msaGaugeRR/1-measurements-by-part.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRR/measurements-by-part.svg rename to tests/testthat/_snaps/msaGaugeRR/1-measurements-by-part.svg index 021e0098..fed11407 100644 --- a/tests/testthat/_snaps/msaGaugeRR/measurements-by-part.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-measurements-by-part.svg @@ -170,6 +170,6 @@ 10 Parts Measurement -measurements-by-part +1_measurements-by-part diff --git a/tests/testthat/_snaps/msaGaugeRR/part-by-operator-interaction.svg b/tests/testthat/_snaps/msaGaugeRR/1-part-by-operator-interaction.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRR/part-by-operator-interaction.svg rename to tests/testthat/_snaps/msaGaugeRR/1-part-by-operator-interaction.svg index fa71272b..c53aa8e0 100644 --- a/tests/testthat/_snaps/msaGaugeRR/part-by-operator-interaction.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-part-by-operator-interaction.svg @@ -118,6 +118,6 @@ Operator A Operator B Operator C -part-by-operator-interaction +1_part-by-operator-interaction diff --git a/tests/testthat/_snaps/msaGaugeRR/range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/1-range-chart-by-operator.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRR/range-chart-by-operator.svg rename to tests/testthat/_snaps/msaGaugeRR/1-range-chart-by-operator.svg index f1b58de3..39b79054 100644 --- a/tests/testthat/_snaps/msaGaugeRR/range-chart-by-operator.svg +++ b/tests/testthat/_snaps/msaGaugeRR/1-range-chart-by-operator.svg @@ -117,6 +117,6 @@ 10 Sample Sample range -range-chart-by-operator +1_range-chart-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRR/1-traffic-plot-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/1-traffic-plot-subplot-1.svg new file mode 100644 index 00000000..cf12ae0c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/1-traffic-plot-subplot-1.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +11.97% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +1_traffic-plot-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/1-traffic-plot-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/1-traffic-plot-subplot-2.svg new file mode 100644 index 00000000..fda8aae9 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/1-traffic-plot-subplot-2.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +23.84% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +1_traffic-plot-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/2-average-chart-by-operator.svg new file mode 100644 index 00000000..e5ca5031 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-average-chart-by-operator.svg @@ -0,0 +1,122 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Operator A +Operator B +Operator C + +CL = -4.56 + +LCL = -5.02 + +UCL = -4.1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + +1 +5 +10 +5 +10 +5 +10 +Sample +Sample average +2_average-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-components-of-variation.svg b/tests/testthat/_snaps/msaGaugeRR/2-components-of-variation.svg new file mode 100644 index 00000000..f3db7f31 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-components-of-variation.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 +200 + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +2_components-of-variation + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-1.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-1.svg rename to tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-1.svg index f95f0ec1..19f8d619 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-1.svg +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-1.svg @@ -29,6 +29,6 @@ Operator A -matrix-plot-for-operators-Wide-subplot-1 +2_matrix-plot-for-operators-subplot-1 diff --git a/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-10.svg new file mode 100644 index 00000000..3405490c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-10.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +2_matrix-plot-for-operators-subplot-10 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-11.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-11.svg new file mode 100644 index 00000000..054a1430 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-11.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +2_matrix-plot-for-operators-subplot-11 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-12.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-12.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-12.svg rename to tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-12.svg index 301e7fa5..864d92f2 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-12.svg +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-12.svg @@ -29,6 +29,6 @@ Operator C -matrix-plot-for-operators-Wide-subplot-12 +2_matrix-plot-for-operators-subplot-12 diff --git a/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-13.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-13.svg new file mode 100644 index 00000000..ce2cff6b --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-13.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 +2_matrix-plot-for-operators-subplot-13 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-14.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-14.svg new file mode 100644 index 00000000..d96bca4e --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-14.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 +2_matrix-plot-for-operators-subplot-14 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-15.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-15.svg new file mode 100644 index 00000000..dc070fc4 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-15.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +2_matrix-plot-for-operators-subplot-15 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-2.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-2.svg rename to tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-2.svg index b931abe9..05a5228b 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-2.svg +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-2.svg @@ -29,6 +29,6 @@ Operator B -matrix-plot-for-operators-Wide-subplot-2 +2_matrix-plot-for-operators-subplot-2 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-3.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-3.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-3.svg rename to tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-3.svg index a6e59b41..641b6141 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-3.svg +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-3.svg @@ -29,6 +29,6 @@ Operator C -matrix-plot-for-operators-Wide-subplot-3 +2_matrix-plot-for-operators-subplot-3 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-4.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-4.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-4.svg rename to tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-4.svg index 8ee3a6c7..6631bc9c 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-4.svg +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-4.svg @@ -29,6 +29,6 @@ Operator A -matrix-plot-for-operators-Wide-subplot-4 +2_matrix-plot-for-operators-subplot-4 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-5.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-5.svg similarity index 91% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-5.svg rename to tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-5.svg index 6d644b34..2dd5e22b 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-5.svg +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-5.svg @@ -27,6 +27,6 @@ -matrix-plot-for-operators-subplot-5 +2_matrix-plot-for-operators-subplot-5 diff --git a/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-6.svg new file mode 100644 index 00000000..4d34fb18 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-6.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +2_matrix-plot-for-operators-subplot-6 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-7.svg new file mode 100644 index 00000000..d680d890 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-7.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +2_matrix-plot-for-operators-subplot-7 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-8.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-8.svg similarity index 92% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-8.svg rename to tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-8.svg index 1617926e..92a95eb8 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-8.svg +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-8.svg @@ -29,6 +29,6 @@ Operator B -matrix-plot-for-operators-Wide-subplot-8 +2_matrix-plot-for-operators-subplot-8 diff --git a/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-9.svg b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-9.svg new file mode 100644 index 00000000..1295b99e --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-matrix-plot-for-operators-subplot-9.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 +2_matrix-plot-for-operators-subplot-9 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/2-measurements-by-operator.svg new file mode 100644 index 00000000..9e6c690d --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-measurements-by-operator.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-9 +-6 +-3 +0 + + + + + + + + +Operator A +Operator B +Operator C +Operators +Measurement +2_measurements-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-measurements-by-part.svg b/tests/testthat/_snaps/msaGaugeRR/2-measurements-by-part.svg new file mode 100644 index 00000000..77a0d5e2 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-measurements-by-part.svg @@ -0,0 +1,175 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Parts +Measurement +2_measurements-by-part + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-part-by-operator-interaction.svg b/tests/testthat/_snaps/msaGaugeRR/2-part-by-operator-interaction.svg new file mode 100644 index 00000000..a26f4bdd --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-part-by-operator-interaction.svg @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Part +Average + + +Operator + + + + + + + + + +Operator A +Operator B +Operator C +2_part-by-operator-interaction + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/2-range-chart-by-operator.svg new file mode 100644 index 00000000..0c544b37 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-range-chart-by-operator.svg @@ -0,0 +1,122 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Operator A +Operator B +Operator C + +CL = 0.45 + +LCL = 0 + +UCL = 1.16 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + +1 +5 +10 +5 +10 +5 +10 +Sample +Sample range +2_range-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-traffic-plot-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/2-traffic-plot-subplot-1.svg new file mode 100644 index 00000000..e3f2cd97 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-traffic-plot-subplot-1.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +13.25% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +2_traffic-plot-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/2-traffic-plot-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/2-traffic-plot-subplot-2.svg new file mode 100644 index 00000000..87155513 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/2-traffic-plot-subplot-2.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +23.84% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +2_traffic-plot-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/4-average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/4-average-chart-by-operator.svg new file mode 100644 index 00000000..296fe87c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/4-average-chart-by-operator.svg @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + +1 + +CL = -4.56 + +LCL = -4.84 + +UCL = -4.27 + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +Sample +Sample average +4_average-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/4-components-of-variation.svg b/tests/testthat/_snaps/msaGaugeRR/4-components-of-variation.svg new file mode 100644 index 00000000..bdafea19 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/4-components-of-variation.svg @@ -0,0 +1,76 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 +200 + + + + + + + + + +Gauge r&R +Repeat +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +4_components-of-variation + + diff --git a/tests/testthat/_snaps/msaGaugeRR/4-measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/4-measurements-by-operator.svg new file mode 100644 index 00000000..8218be7b --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/4-measurements-by-operator.svg @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-9 +-6 +-3 +0 + + + + + +Measurement +4_measurements-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/4-measurements-by-part.svg b/tests/testthat/_snaps/msaGaugeRR/4-measurements-by-part.svg new file mode 100644 index 00000000..7e6d7272 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/4-measurements-by-part.svg @@ -0,0 +1,175 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Parts +Measurement +4_measurements-by-part + + diff --git a/tests/testthat/_snaps/msaGaugeRR/4-part-by-operator-interaction.svg b/tests/testthat/_snaps/msaGaugeRR/4-part-by-operator-interaction.svg new file mode 100644 index 00000000..c072de11 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/4-part-by-operator-interaction.svg @@ -0,0 +1,86 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Part +Average +4_part-by-operator-interaction + + diff --git a/tests/testthat/_snaps/msaGaugeRR/4-range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/4-range-chart-by-operator.svg new file mode 100644 index 00000000..f4f6b54a --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/4-range-chart-by-operator.svg @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + +1 + +CL = 0.85 + +LCL = 0.16 + +UCL = 1.54 + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +Sample +Sample range +4_range-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/4-traffic-plot-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/4-traffic-plot-subplot-1.svg new file mode 100644 index 00000000..92aa21bc --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/4-traffic-plot-subplot-1.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +11.75% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +4_traffic-plot-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/4-traffic-plot-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/4-traffic-plot-subplot-2.svg new file mode 100644 index 00000000..1f72d8a5 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/4-traffic-plot-subplot-2.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +23.40% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +4_traffic-plot-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-1.svg new file mode 100644 index 00000000..a7400f96 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-1.svg @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + +5_gauge-r-r-report-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-10.svg new file mode 100644 index 00000000..ca228783 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-10.svg @@ -0,0 +1,122 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Operator A +Operator B +Operator C + +CL = -4.56 + +LCL = -5.02 + +UCL = -4.1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + +1 +5 +10 +5 +10 +5 +10 +Sample +Sample average +5_gauge-r-r-report-subplot-10 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-11.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-11.svg new file mode 100644 index 00000000..d10c9ead --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-11.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +23.84% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +5_gauge-r-r-report-subplot-11 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-12.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-12.svg new file mode 100644 index 00000000..75d32cf0 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-12.svg @@ -0,0 +1,588 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Source + + + + +Total gauge r&R + + + + +Std. dev. + + + + +Repeatability + + + + +Study variation + + + + +Reproducibility + + + + +%Study variation + + + + +Operators + + + + +%Tolerance + + + + +Part-to-part + + + + +Total variation + + + + +0.40 + + + + +0.37 + + + + +0.15 + + + + +0.15 + + + + +3.29 + + + + +3.32 + + + + + 2.38 + + + + + 2.20 + + + + + 0.92 + + + + + 0.92 + + + + +19.77 + + + + +19.91 + + + + + 11.97 + + + + + 11.05 + + + + + 4.61 + + + + + 4.61 + + + + + 99.28 + + + + +100.00 + + + + + 23.84 + + + + + 22.01 + + + + + 9.18 + + + + + 9.18 + + + + +197.69 + + + + +199.12 + + + + + + + + + + + + + + + + + + + + + + + + +Number of distinct categories + + + + +11 + + +Gauge evaluation + + +5_gauge-r-r-report-subplot-12 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-2.svg new file mode 100644 index 00000000..f0714d74 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-2.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 +200 + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +5_gauge-r-r-report-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-3.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-3.svg new file mode 100644 index 00000000..d8a1b66c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-3.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Parts +Measurement +5_gauge-r-r-report-subplot-3 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-4.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-4.svg new file mode 100644 index 00000000..13680439 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-4.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-9 +-6 +-3 +0 + + + + + + + + +Operator A +Operator B +Operator C +Operators +Measurement +5_gauge-r-r-report-subplot-4 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-5.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-5.svg new file mode 100644 index 00000000..8aa946c2 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-5.svg @@ -0,0 +1,123 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-12 +-10 +-8 +-6 +-4 +-2 +0 + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Part +Average + + +Operator + + + + + + + + + +Operator A +Operator B +Operator C +5_gauge-r-r-report-subplot-5 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-6.svg new file mode 100644 index 00000000..59bb3aad --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-6.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +11.97% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +5_gauge-r-r-report-subplot-6 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-7.svg new file mode 100644 index 00000000..ded8e5fb --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-7.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Gauge r&R report + + +5_gauge-r-r-report-subplot-7 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-8.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-8.svg new file mode 100644 index 00000000..75b98d70 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-8.svg @@ -0,0 +1,41 @@ + + + + + + + + + + + + + + + + + + + + +Part name: +Gauge name: Name of the gauge study +Characteristic: +Gauge number: +Tolerance: +Location: +Performed by: +Date: + + +5_gauge-r-r-report-subplot-8 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-9.svg b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-9.svg new file mode 100644 index 00000000..530c7c64 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/5-gauge-r-r-report-subplot-9.svg @@ -0,0 +1,122 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Operator A +Operator B +Operator C + +CL = 0.45 + +LCL = 0 + +UCL = 1.16 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + +1 +5 +10 +5 +10 +5 +10 +Sample +Sample range +5_gauge-r-r-report-subplot-9 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-1.svg new file mode 100644 index 00000000..edc906f6 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-1.svg @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + +gauge-r-r-report-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-10.svg new file mode 100644 index 00000000..620cbecc --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-10.svg @@ -0,0 +1,124 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 8.08 + +LCL = 6.39 + +UCL = 9.76 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + +1 +5 +10 +5 +10 +5 +10 +Sample +Sample average +gauge-r-r-report-subplot-10 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-11.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-11.svg new file mode 100644 index 00000000..8832379d --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-11.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +55.26% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +gauge-r-r-report-subplot-11 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-12.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-12.svg new file mode 100644 index 00000000..b6374f69 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-12.svg @@ -0,0 +1,588 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Source + + + + +Total gauge r&R + + + + +Std. dev. + + + + +Repeatability + + + + +Study variation + + + + +Reproducibility + + + + +%Study variation + + + + +Operator + + + + +%Tolerance + + + + +Part-to-part + + + + +Total variation + + + + +0.92 + + + + +0.92 + + + + +0.03 + + + + +0.03 + + + + +1.71 + + + + +1.94 + + + + + 5.53 + + + + + 5.52 + + + + + 0.16 + + + + + 0.16 + + + + +10.24 + + + + +11.63 + + + + + 47.50 + + + + + 47.48 + + + + + 1.37 + + + + + 1.37 + + + + + 88.00 + + + + +100.00 + + + + + 55.26 + + + + + 55.24 + + + + + 1.59 + + + + + 1.59 + + + + +102.39 + + + + +116.35 + + + + + + + + + + + + + + + + + + + + + + + + +Number of distinct categories + + + + +2 + + +Gauge evaluation + + +gauge-r-r-report-subplot-12 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-2.svg new file mode 100644 index 00000000..19e40b83 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-2.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 +80 +100 +120 + + + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +gauge-r-r-report-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-3.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-3.svg new file mode 100644 index 00000000..34eb89c3 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-3.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Part +Measurement +gauge-r-r-report-subplot-3 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-4.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-4.svg new file mode 100644 index 00000000..7b20e66b --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-4.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +6 +8 +10 +12 + + + + + + + + +A +B +C +Operator +Measurement +gauge-r-r-report-subplot-4 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-5.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-5.svg new file mode 100644 index 00000000..84fcd8c2 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-5.svg @@ -0,0 +1,125 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Part +Average + + +Operator + + + + + + + + + +A +B +C +gauge-r-r-report-subplot-5 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-6.svg new file mode 100644 index 00000000..6e1d265b --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-6.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +47.50% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +gauge-r-r-report-subplot-6 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-7.svg new file mode 100644 index 00000000..23c11558 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-7.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Gauge r&R report + + +gauge-r-r-report-subplot-7 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-8.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-8.svg new file mode 100644 index 00000000..0b2a83ee --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-8.svg @@ -0,0 +1,41 @@ + + + + + + + + + + + + + + + + + + + + +Part name: +Gauge name: +Characteristic: +Gauge number: +Tolerance: +Location: +Performed by: +Date: + + +gauge-r-r-report-subplot-8 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-9.svg b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-9.svg new file mode 100644 index 00000000..8b09f252 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/gauge-r-r-report-subplot-9.svg @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 1.65 + +LCL = 0 + +UCL = 4.24 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + +1 +5 +10 +5 +10 +5 +10 +Sample +Sample range +gauge-r-r-report-subplot-9 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-6.svg deleted file mode 100644 index 3a61be96..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-6.svg +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -matrix-plot-for-operators-subplot-6 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-7.svg deleted file mode 100644 index 84f0268e..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-subplot-7.svg +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -matrix-plot-for-operators-subplot-7 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-10.svg deleted file mode 100644 index 00a8baf3..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-10.svg +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -matrix-plot-for-operators-Wide-subplot-10 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-11.svg b/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-11.svg deleted file mode 100644 index 1ffa5a4f..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-11.svg +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -matrix-plot-for-operators-Wide-subplot-11 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-15.svg b/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-15.svg deleted file mode 100644 index ee16353a..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-15.svg +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -matrix-plot-for-operators-Wide-subplot-15 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-5.svg b/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-5.svg deleted file mode 100644 index a48faacc..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-5.svg +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -matrix-plot-for-operators-Wide-subplot-5 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-6.svg deleted file mode 100644 index 03a892c7..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-6.svg +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -matrix-plot-for-operators-Wide-subplot-6 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-7.svg deleted file mode 100644 index 5dd7bc06..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-7.svg +++ /dev/null @@ -1,32 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - -matrix-plot-for-operators-Wide-subplot-7 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/measurements-by-part-longtype3.svg b/tests/testthat/_snaps/msaGaugeRR/measurements-by-part-longtype3.svg deleted file mode 100644 index 103f751c..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/measurements-by-part-longtype3.svg +++ /dev/null @@ -1,113 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -4 -6 -8 -10 -12 -14 - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -13 -14 -15 -16 -17 -18 -19 -20 -Parts -Measurement -measurements-by-part-LongType3 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/measurements-by-part-widetype3.svg b/tests/testthat/_snaps/msaGaugeRR/measurements-by-part-widetype3.svg deleted file mode 100644 index 1ad28571..00000000 --- a/tests/testthat/_snaps/msaGaugeRR/measurements-by-part-widetype3.svg +++ /dev/null @@ -1,113 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -4 -6 -8 -10 -12 -14 - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -13 -14 -15 -16 -17 -18 -19 -20 -Part -Measurement -measurements-by-part-WideType3 - - diff --git a/tests/testthat/_snaps/msaGaugeRR/average-chart-by-operator-wide.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-average-chart-by-operator.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRR/average-chart-by-operator-wide.svg rename to tests/testthat/_snaps/msaGaugeRR/wf1-average-chart-by-operator.svg index 49f2d99b..0d5a56c8 100644 --- a/tests/testthat/_snaps/msaGaugeRR/average-chart-by-operator-wide.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-average-chart-by-operator.svg @@ -119,6 +119,6 @@ 10 Sample Sample average -average-chart-by-operator-Wide +WF1_average-chart-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-components-of-variation.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-components-of-variation.svg new file mode 100644 index 00000000..950b310b --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-components-of-variation.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 +80 +100 +120 + + + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +WF1_components-of-variation + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-1.svg new file mode 100644 index 00000000..e2e27c8e --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-1.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator A + + +WF1_matrix-plot-for-operators-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-10.svg new file mode 100644 index 00000000..fa1ef895 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-10.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF1_matrix-plot-for-operators-subplot-10 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-11.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-11.svg new file mode 100644 index 00000000..1ca6de26 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-11.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF1_matrix-plot-for-operators-subplot-11 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-12.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-12.svg new file mode 100644 index 00000000..0d4a9e3e --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-12.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator C + + +WF1_matrix-plot-for-operators-subplot-12 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-13.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-13.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-13.svg rename to tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-13.svg index 949cfd81..f072b511 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-13.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-13.svg @@ -76,6 +76,6 @@ 9 10 11 -matrix-plot-for-operators-Wide-subplot-13 +WF1_matrix-plot-for-operators-subplot-13 diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-14.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-14.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-14.svg rename to tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-14.svg index 95af78b4..c47de05f 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-14.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-14.svg @@ -74,6 +74,6 @@ 9 10 11 -matrix-plot-for-operators-Wide-subplot-14 +WF1_matrix-plot-for-operators-subplot-14 diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-15.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-15.svg new file mode 100644 index 00000000..184c4a34 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-15.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF1_matrix-plot-for-operators-subplot-15 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-2.svg new file mode 100644 index 00000000..43c94537 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-2.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator B + + +WF1_matrix-plot-for-operators-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-3.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-3.svg new file mode 100644 index 00000000..f1648c4c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-3.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator C + + +WF1_matrix-plot-for-operators-subplot-3 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-4.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-4.svg new file mode 100644 index 00000000..34257ab9 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-4.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator A + + +WF1_matrix-plot-for-operators-subplot-4 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-5.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-5.svg new file mode 100644 index 00000000..420b6b81 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-5.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF1_matrix-plot-for-operators-subplot-5 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-6.svg new file mode 100644 index 00000000..c4fab92d --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-6.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF1_matrix-plot-for-operators-subplot-6 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-7.svg new file mode 100644 index 00000000..82aa7279 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-7.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF1_matrix-plot-for-operators-subplot-7 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-8.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-8.svg new file mode 100644 index 00000000..87192c2a --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-8.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator B + + +WF1_matrix-plot-for-operators-subplot-8 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-9.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-9.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-9.svg rename to tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-9.svg index 554ca489..8eb9276c 100644 --- a/tests/testthat/_snaps/msaGaugeRR/matrix-plot-for-operators-wide-subplot-9.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-matrix-plot-for-operators-subplot-9.svg @@ -76,6 +76,6 @@ 9 10 11 -matrix-plot-for-operators-Wide-subplot-9 +WF1_matrix-plot-for-operators-subplot-9 diff --git a/tests/testthat/_snaps/msaGaugeRR/measurements-by-operator-wide.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-measurements-by-operator.svg similarity index 97% rename from tests/testthat/_snaps/msaGaugeRR/measurements-by-operator-wide.svg rename to tests/testthat/_snaps/msaGaugeRR/wf1-measurements-by-operator.svg index c86419eb..285cb183 100644 --- a/tests/testthat/_snaps/msaGaugeRR/measurements-by-operator-wide.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-measurements-by-operator.svg @@ -62,6 +62,6 @@ C Operator Measurement -measurements-by-operator-Wide +WF1_measurements-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRR/measurements-by-part-wide.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-measurements-by-part.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRR/measurements-by-part-wide.svg rename to tests/testthat/_snaps/msaGaugeRR/wf1-measurements-by-part.svg index e41fa5d8..84244ff0 100644 --- a/tests/testthat/_snaps/msaGaugeRR/measurements-by-part-wide.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-measurements-by-part.svg @@ -168,6 +168,6 @@ 10 Part Measurement -measurements-by-part-Wide +WF1_measurements-by-part diff --git a/tests/testthat/_snaps/msaGaugeRR/part-by-operator-interaction-wide.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-part-by-operator-interaction.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRR/part-by-operator-interaction-wide.svg rename to tests/testthat/_snaps/msaGaugeRR/wf1-part-by-operator-interaction.svg index 8ae4b43d..d6dbf7f3 100644 --- a/tests/testthat/_snaps/msaGaugeRR/part-by-operator-interaction-wide.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-part-by-operator-interaction.svg @@ -120,6 +120,6 @@ A B C -part-by-operator-interaction-Wide +WF1_part-by-operator-interaction diff --git a/tests/testthat/_snaps/msaGaugeRR/range-chart-by-operator-wide.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-range-chart-by-operator.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRR/range-chart-by-operator-wide.svg rename to tests/testthat/_snaps/msaGaugeRR/wf1-range-chart-by-operator.svg index 047c6137..27431675 100644 --- a/tests/testthat/_snaps/msaGaugeRR/range-chart-by-operator-wide.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-range-chart-by-operator.svg @@ -115,6 +115,6 @@ 10 Sample Sample range -range-chart-by-operator-Wide +WF1_range-chart-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-traffic-plot-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-traffic-plot-subplot-1.svg new file mode 100644 index 00000000..16ce27a5 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-traffic-plot-subplot-1.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +47.50% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +WF1_traffic-plot-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf1-traffic-plot-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/wf1-traffic-plot-subplot-2.svg new file mode 100644 index 00000000..d3b7e439 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf1-traffic-plot-subplot-2.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +55.26% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +WF1_traffic-plot-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-average-chart-by-operator.svg new file mode 100644 index 00000000..0547548b --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-average-chart-by-operator.svg @@ -0,0 +1,124 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 8.08 + +LCL = 6.39 + +UCL = 9.76 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + +1 +5 +10 +5 +10 +5 +10 +Sample +Sample average +WF2_average-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-components-of-variation.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-components-of-variation.svg new file mode 100644 index 00000000..9eaf7169 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-components-of-variation.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 +200 + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +WF2_components-of-variation + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-1.svg new file mode 100644 index 00000000..e20ddb5a --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-1.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator A + + +WF2_matrix-plot-for-operators-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-10.svg new file mode 100644 index 00000000..24ef5a24 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-10.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF2_matrix-plot-for-operators-subplot-10 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-11.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-11.svg new file mode 100644 index 00000000..872dd7aa --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-11.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF2_matrix-plot-for-operators-subplot-11 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-12.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-12.svg new file mode 100644 index 00000000..c2b66daf --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-12.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator C + + +WF2_matrix-plot-for-operators-subplot-12 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-13.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-13.svg new file mode 100644 index 00000000..7db37072 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-13.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +WF2_matrix-plot-for-operators-subplot-13 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-14.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-14.svg new file mode 100644 index 00000000..39cf0ee8 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-14.svg @@ -0,0 +1,79 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +WF2_matrix-plot-for-operators-subplot-14 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-15.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-15.svg new file mode 100644 index 00000000..7277ee7d --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-15.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF2_matrix-plot-for-operators-subplot-15 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-2.svg new file mode 100644 index 00000000..fd480054 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-2.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator B + + +WF2_matrix-plot-for-operators-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-3.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-3.svg new file mode 100644 index 00000000..e69220ec --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-3.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator C + + +WF2_matrix-plot-for-operators-subplot-3 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-4.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-4.svg new file mode 100644 index 00000000..baa2c4cd --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-4.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator A + + +WF2_matrix-plot-for-operators-subplot-4 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-5.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-5.svg new file mode 100644 index 00000000..73a6e912 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-5.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF2_matrix-plot-for-operators-subplot-5 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-6.svg new file mode 100644 index 00000000..3603da2c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-6.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF2_matrix-plot-for-operators-subplot-6 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-7.svg new file mode 100644 index 00000000..f2373b26 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-7.svg @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + +WF2_matrix-plot-for-operators-subplot-7 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-8.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-8.svg new file mode 100644 index 00000000..dc3e20e2 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-8.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Operator B + + +WF2_matrix-plot-for-operators-subplot-8 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-9.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-9.svg new file mode 100644 index 00000000..e7536b42 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-matrix-plot-for-operators-subplot-9.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +WF2_matrix-plot-for-operators-subplot-9 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-measurements-by-operator.svg new file mode 100644 index 00000000..26b43bad --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-measurements-by-operator.svg @@ -0,0 +1,67 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +6 +8 +10 +12 + + + + + + + + +A +B +C +Operator +Measurement +WF2_measurements-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-measurements-by-part.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-measurements-by-part.svg new file mode 100644 index 00000000..86dc7b04 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-measurements-by-part.svg @@ -0,0 +1,173 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +4 +6 +8 +10 +12 +14 + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Part +Measurement +WF2_measurements-by-part + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-part-by-operator-interaction.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-part-by-operator-interaction.svg new file mode 100644 index 00000000..541401f5 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-part-by-operator-interaction.svg @@ -0,0 +1,125 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Part +Average + + +Operator + + + + + + + + + +A +B +C +WF2_part-by-operator-interaction + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-range-chart-by-operator.svg new file mode 100644 index 00000000..f7667728 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-range-chart-by-operator.svg @@ -0,0 +1,120 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 1.65 + +LCL = 0 + +UCL = 4.24 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + +1 +5 +10 +5 +10 +5 +10 +Sample +Sample range +WF2_range-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-traffic-plot-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-traffic-plot-subplot-1.svg new file mode 100644 index 00000000..c5c4d815 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-traffic-plot-subplot-1.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +30.70% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +WF2_traffic-plot-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf2-traffic-plot-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/wf2-traffic-plot-subplot-2.svg new file mode 100644 index 00000000..f9f921ac --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf2-traffic-plot-subplot-2.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +55.26% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +WF2_traffic-plot-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf4-average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/wf4-average-chart-by-operator.svg new file mode 100644 index 00000000..249ddd0b --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf4-average-chart-by-operator.svg @@ -0,0 +1,112 @@ + + + + + + + + + + + + + + + + + + + + + + + + +1 + +CL = 8.08 + +LCL = 6.39 + +UCL = 9.76 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +5 +6 +7 +8 +9 +10 +11 +12 + + + + + + + + + + + + + + + + +1 +2 +4 +5 +7 +9 +10 +Sample +Sample average +WF4_average-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/components-of-variation-widetype3.svg b/tests/testthat/_snaps/msaGaugeRR/wf4-components-of-variation.svg similarity index 53% rename from tests/testthat/_snaps/msaGaugeRR/components-of-variation-widetype3.svg rename to tests/testthat/_snaps/msaGaugeRR/wf4-components-of-variation.svg index 0e0930b1..b9f664bc 100644 --- a/tests/testthat/_snaps/msaGaugeRR/components-of-variation-widetype3.svg +++ b/tests/testthat/_snaps/msaGaugeRR/wf4-components-of-variation.svg @@ -21,58 +21,60 @@ - - + + - - - - - - - - - - - - + + + + + + + + + + + + - + 0 -20 -40 -60 -80 -100 +20 +40 +60 +80 +100 +120 - - - - + + + + + - - - - -Gauge r&R -Repeat -Part-to-Part + + + + +Gauge r&R +Repeat +Part-to-part Percent - - - - - - - - -% Contribution -% Study Variation -% Tolerance -components-of-variation-WideType3 + + + + + + + + +% Contribution +% Study variation +% Tolerance +WF4_components-of-variation diff --git a/tests/testthat/_snaps/msaGaugeRR/wf4-measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/wf4-measurements-by-operator.svg new file mode 100644 index 00000000..37ec2994 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf4-measurements-by-operator.svg @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +6 +8 +10 +12 + + + + + +Measurement +WF4_measurements-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf4-measurements-by-part.svg b/tests/testthat/_snaps/msaGaugeRR/wf4-measurements-by-part.svg new file mode 100644 index 00000000..04965f94 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf4-measurements-by-part.svg @@ -0,0 +1,173 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +4 +6 +8 +10 +12 +14 + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +Part +Measurement +WF4_measurements-by-part + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf4-range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRR/wf4-range-chart-by-operator.svg new file mode 100644 index 00000000..0b3e4333 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf4-range-chart-by-operator.svg @@ -0,0 +1,108 @@ + + + + + + + + + + + + + + + + + + + + + + + + +1 + +CL = 1.65 + +LCL = 0 + +UCL = 4.24 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 +5 + + + + + + + + + + + + + + +1 +2 +4 +5 +7 +9 +10 +Sample +Sample range +WF4_range-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf4-traffic-plot-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRR/wf4-traffic-plot-subplot-1.svg new file mode 100644 index 00000000..99e742a4 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf4-traffic-plot-subplot-1.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +47.49% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +WF4_traffic-plot-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRR/wf4-traffic-plot-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRR/wf4-traffic-plot-subplot-2.svg new file mode 100644 index 00000000..97376f84 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRR/wf4-traffic-plot-subplot-2.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +55.25% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +WF4_traffic-plot-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/components-of-variation.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/components-of-variation.svg deleted file mode 100644 index 09ceced2..00000000 --- a/tests/testthat/_snaps/msaGaugeRRnonrep/components-of-variation.svg +++ /dev/null @@ -1,76 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -20 -40 -60 -80 -100 - - - - - - - - - - - -Gauge r&R -Repeat -Reprod -Part-to-Part -Percent - - - - - - -% Contribution -% Study Variation -components-of-variation - - diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-average-chart-by-operator.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRRnonrep/average-chart-by-operator.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/lf1-average-chart-by-operator.svg index 20cd2c49..f9ba33d7 100644 --- a/tests/testthat/_snaps/msaGaugeRRnonrep/average-chart-by-operator.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-average-chart-by-operator.svg @@ -102,6 +102,6 @@ 15 Sample Sample average -average-chart-by-operator +LF1_average-chart-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRR/components-of-variation-wide.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-components-of-variation.svg similarity index 59% rename from tests/testthat/_snaps/msaGaugeRR/components-of-variation-wide.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/lf1-components-of-variation.svg index 9f0c1129..986c082d 100644 --- a/tests/testthat/_snaps/msaGaugeRR/components-of-variation-wide.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-components-of-variation.svg @@ -21,27 +21,27 @@ - - + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + - + @@ -57,27 +57,27 @@ - - - - - -Gauge r&R -Repeat -Reprod -Part-to-Part + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part Percent - - - - - - - - -% Contribution -% Study Variation -% Tolerance -components-of-variation-Wide + + + + + + + + +% Contribution +% Study variation +% Tolerance +LF1_components-of-variation diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-measurements-by-operator.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRRnonrep/measurements-by-operator.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/lf1-measurements-by-operator.svg index 1a273017..52701c27 100644 --- a/tests/testthat/_snaps/msaGaugeRRnonrep/measurements-by-operator.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-measurements-by-operator.svg @@ -66,6 +66,6 @@ C Operator Measurement -measurements-by-operator +LF1_measurements-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/operator-a.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-a.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRRnonrep/operator-a.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-a.svg index 8c17ff70..c9a547a5 100644 --- a/tests/testthat/_snaps/msaGaugeRRnonrep/operator-a.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-a.svg @@ -77,6 +77,6 @@ 5 Batch Measurement -operator-a +LF1_operator-a diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/operator-b.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-b.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRRnonrep/operator-b.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-b.svg index 918911b9..5dc497ac 100644 --- a/tests/testthat/_snaps/msaGaugeRRnonrep/operator-b.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-b.svg @@ -77,6 +77,6 @@ 10 Batch Measurement -operator-b +LF1_operator-b diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/operator-c.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-c.svg similarity index 98% rename from tests/testthat/_snaps/msaGaugeRRnonrep/operator-c.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-c.svg index 9bdd9dd7..2fda9716 100644 --- a/tests/testthat/_snaps/msaGaugeRRnonrep/operator-c.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-operator-c.svg @@ -73,6 +73,6 @@ 15 Batch Measurement -operator-c +LF1_operator-c diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-range-chart-by-operator.svg similarity index 99% rename from tests/testthat/_snaps/msaGaugeRRnonrep/range-chart-by-operator.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/lf1-range-chart-by-operator.svg index 3eb5a14b..83ab5893 100644 --- a/tests/testthat/_snaps/msaGaugeRRnonrep/range-chart-by-operator.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf1-range-chart-by-operator.svg @@ -106,6 +106,6 @@ 15 Sample Sample range -range-chart-by-operator +LF1_range-chart-by-operator diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-average-chart-by-operator.svg new file mode 100644 index 00000000..7e1bd961 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-average-chart-by-operator.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 33.31 + +LCL = 32.68 + +UCL = 33.93 + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample average +LF2_average-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/components-of-variation.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-components-of-variation.svg similarity index 55% rename from tests/testthat/_snaps/msaGaugeRR/components-of-variation.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/lf2-components-of-variation.svg index a0765d61..4e8c5419 100644 --- a/tests/testthat/_snaps/msaGaugeRR/components-of-variation.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-components-of-variation.svg @@ -21,67 +21,65 @@ - - + + - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + - + 0 -20 -40 -60 -80 -100 -120 -140 +20 +40 +60 +80 +100 +120 - - - - - - + + + + + - - - - - -Gauge r&R -Repeat -Reprod -Part-to-Part + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part Percent - - - - - - - - -% Contribution -% Study Variation -% Tolerance -components-of-variation + + + + + + + + +% Contribution +% Study variation +% Tolerance +LF2_components-of-variation diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-measurements-by-operator.svg new file mode 100644 index 00000000..90dbc9b5 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-measurements-by-operator.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + +A +B +C +Operator +Measurement +LF2_measurements-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-a.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-a.svg new file mode 100644 index 00000000..1f78a0fd --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-a.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +31.5 +32.0 +32.5 +33.0 +33.5 +34.0 +34.5 +35.0 + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +Batch +Measurement +LF2_operator-a + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-b.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-b.svg new file mode 100644 index 00000000..a1057f45 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-b.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +32.0 +32.5 +33.0 +33.5 +34.0 +34.5 +35.0 +35.5 + + + + + + + + + + + + + + +6 +7 +8 +9 +10 +Batch +Measurement +LF2_operator-b + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-c.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-c.svg new file mode 100644 index 00000000..e5ea3a21 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-operator-c.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +30 +31 +32 +33 +34 +35 + + + + + + + + + + + + +11 +12 +13 +14 +15 +Batch +Measurement +LF2_operator-c + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-range-chart-by-operator.svg new file mode 100644 index 00000000..8993a726 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf2-range-chart-by-operator.svg @@ -0,0 +1,111 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 0.33 + +LCL = 0 + +UCL = 1.09 + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample range +LF2_range-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-1.svg new file mode 100644 index 00000000..5e21d080 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-1.svg @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + +LF3_gauge-r-r-non-replicable-report-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-10.svg new file mode 100644 index 00000000..cd781316 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-10.svg @@ -0,0 +1,513 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Source + + + + +Total gauge r&R + + + + +Std. dev. + + + + +Repeatability + + + + +Study variation + + + + +Reproducibility + + + + +%Study variation + + + + +Part-To-part + + + + +%Tolerance + + + + +Total variation + + + + +0.28 + + + + +0.28 + + + + +0.00 + + + + +1.24 + + + + +1.27 + + + + +1.70 + + + + +1.70 + + + + +0.00 + + + + +7.41 + + + + +7.61 + + + + + 22.40 + + + + + 22.40 + + + + + 0.00 + + + + + 97.46 + + + + +100.00 + + + + +11.36 + + + + +11.36 + + + + + 0.00 + + + + +49.42 + + + + +50.71 + + + + + + + + + + + + + + + + + + + + + + + + +Number of distinct categories + + + + +6 + + +Gauge evaluation + + +LF3_gauge-r-r-non-replicable-report-subplot-10 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-2.svg new file mode 100644 index 00000000..4000718d --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-2.svg @@ -0,0 +1,83 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 +80 +100 + + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +LF3_gauge-r-r-non-replicable-report-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-3.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-3.svg new file mode 100644 index 00000000..5f58fd4c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-3.svg @@ -0,0 +1,111 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 0.33 + +LCL = 0 + +UCL = 1.09 + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample range +LF3_gauge-r-r-non-replicable-report-subplot-3 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-4.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-4.svg new file mode 100644 index 00000000..9f3dec88 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-4.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 33.31 + +LCL = 32.68 + +UCL = 33.93 + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample average +LF3_gauge-r-r-non-replicable-report-subplot-4 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-5.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-5.svg new file mode 100644 index 00000000..93cabbea --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-5.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +22.40% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +LF3_gauge-r-r-non-replicable-report-subplot-5 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-6.svg new file mode 100644 index 00000000..cef5459c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-6.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Gauge r&R (non-replicable) report + + +LF3_gauge-r-r-non-replicable-report-subplot-6 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-7.svg new file mode 100644 index 00000000..557c47df --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-7.svg @@ -0,0 +1,41 @@ + + + + + + + + + + + + + + + + + + + + +Part name: +Gauge name: Test Name +Characteristic: +Gauge number: +Tolerance: +Location: +Performed by: +Date: + + +LF3_gauge-r-r-non-replicable-report-subplot-7 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-8.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-8.svg new file mode 100644 index 00000000..2a437b6e --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-8.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + +A +B +C +Operator +Measurement +LF3_gauge-r-r-non-replicable-report-subplot-8 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-9.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-9.svg new file mode 100644 index 00000000..6fd1ccb5 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/lf3-gauge-r-r-non-replicable-report-subplot-9.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +11.36% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +LF3_gauge-r-r-non-replicable-report-subplot-9 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-average-chart-by-operator.svg new file mode 100644 index 00000000..7a7f0853 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-average-chart-by-operator.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 33.31 + +LCL = 32.68 + +UCL = 33.93 + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample average +WF1_average-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRR/components-of-variation-longtype3.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-components-of-variation.svg similarity index 59% rename from tests/testthat/_snaps/msaGaugeRR/components-of-variation-longtype3.svg rename to tests/testthat/_snaps/msaGaugeRRnonrep/wf1-components-of-variation.svg index c5a5097b..84fcc753 100644 --- a/tests/testthat/_snaps/msaGaugeRR/components-of-variation-longtype3.svg +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-components-of-variation.svg @@ -21,24 +21,27 @@ - - + + - - - - - - - - - - - - + + + + + + + + + + + + + + + - + @@ -54,25 +57,27 @@ - - - - -Gauge r&R -Repeat -Part-to-Part + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part Percent - - - - - - - - -% Contribution -% Study Variation -% Tolerance -components-of-variation-LongType3 + + + + + + + + +% Contribution +% Study variation +% Tolerance +WF1_components-of-variation diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-measurements-by-operator.svg new file mode 100644 index 00000000..fcf8451e --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-measurements-by-operator.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + +A +B +C +Operator +Measurement +WF1_measurements-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-a.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-a.svg new file mode 100644 index 00000000..32e10eb0 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-a.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +31.5 +32.0 +32.5 +33.0 +33.5 +34.0 +34.5 +35.0 + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +Batch +Measurement +WF1_operator-a + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-b.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-b.svg new file mode 100644 index 00000000..f85cfa3b --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-b.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +32.0 +32.5 +33.0 +33.5 +34.0 +34.5 +35.0 +35.5 + + + + + + + + + + + + + + +6 +7 +8 +9 +10 +Batch +Measurement +WF1_operator-b + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-c.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-c.svg new file mode 100644 index 00000000..deb54ecf --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-operator-c.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +30 +31 +32 +33 +34 +35 + + + + + + + + + + + + +11 +12 +13 +14 +15 +Batch +Measurement +WF1_operator-c + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-range-chart-by-operator.svg new file mode 100644 index 00000000..c72d0a53 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf1-range-chart-by-operator.svg @@ -0,0 +1,111 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 0.33 + +LCL = 0 + +UCL = 1.09 + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample range +WF1_range-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-average-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-average-chart-by-operator.svg new file mode 100644 index 00000000..83d0c178 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-average-chart-by-operator.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 33.31 + +LCL = 32.68 + +UCL = 33.93 + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample average +WF2_average-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-components-of-variation.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-components-of-variation.svg new file mode 100644 index 00000000..940c8e92 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-components-of-variation.svg @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 +80 +100 +120 + + + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +WF2_components-of-variation + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-measurements-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-measurements-by-operator.svg new file mode 100644 index 00000000..1aff4270 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-measurements-by-operator.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + +A +B +C +Operator +Measurement +WF2_measurements-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-a.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-a.svg new file mode 100644 index 00000000..7e774b85 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-a.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +31.5 +32.0 +32.5 +33.0 +33.5 +34.0 +34.5 +35.0 + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +Batch +Measurement +WF2_operator-a + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-b.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-b.svg new file mode 100644 index 00000000..7119130c --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-b.svg @@ -0,0 +1,82 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +32.0 +32.5 +33.0 +33.5 +34.0 +34.5 +35.0 +35.5 + + + + + + + + + + + + + + +6 +7 +8 +9 +10 +Batch +Measurement +WF2_operator-b + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-c.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-c.svg new file mode 100644 index 00000000..a8e8d29d --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-operator-c.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +30 +31 +32 +33 +34 +35 + + + + + + + + + + + + +11 +12 +13 +14 +15 +Batch +Measurement +WF2_operator-c + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-range-chart-by-operator.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-range-chart-by-operator.svg new file mode 100644 index 00000000..8aec1b84 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf2-range-chart-by-operator.svg @@ -0,0 +1,111 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 0.33 + +LCL = 0 + +UCL = 1.09 + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample range +WF2_range-chart-by-operator + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-1.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-1.svg new file mode 100644 index 00000000..31678426 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-1.svg @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + +WF3_gauge-r-r-non-replicable-report-subplot-1 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-10.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-10.svg new file mode 100644 index 00000000..288d5172 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-10.svg @@ -0,0 +1,513 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Source + + + + +Total gauge r&R + + + + +Std. dev. + + + + +Repeatability + + + + +Study variation + + + + +Reproducibility + + + + +%Study variation + + + + +Part-To-part + + + + +%Tolerance + + + + +Total variation + + + + +0.28 + + + + +0.28 + + + + +0.00 + + + + +1.24 + + + + +1.27 + + + + +1.70 + + + + +1.70 + + + + +0.00 + + + + +7.41 + + + + +7.61 + + + + + 22.40 + + + + + 22.40 + + + + + 0.00 + + + + + 97.46 + + + + +100.00 + + + + +11.36 + + + + +11.36 + + + + + 0.00 + + + + +49.42 + + + + +50.71 + + + + + + + + + + + + + + + + + + + + + + + + +Number of distinct categories + + + + +6 + + +Gauge evaluation + + +WF3_gauge-r-r-non-replicable-report-subplot-10 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-2.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-2.svg new file mode 100644 index 00000000..63d51d82 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-2.svg @@ -0,0 +1,83 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +20 +40 +60 +80 +100 + + + + + + + + + + + +Gauge r&R +Repeat +Reprod +Part-to-part +Percent + + + + + + + + +% Contribution +% Study variation +% Tolerance +WF3_gauge-r-r-non-replicable-report-subplot-2 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-3.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-3.svg new file mode 100644 index 00000000..6cda3d71 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-3.svg @@ -0,0 +1,111 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 0.33 + +LCL = 0 + +UCL = 1.09 + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.2 +0.4 +0.6 +0.8 +1.0 +1.2 + + + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample range +WF3_gauge-r-r-non-replicable-report-subplot-3 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-4.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-4.svg new file mode 100644 index 00000000..5c180276 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-4.svg @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +B +C + +CL = 33.31 + +LCL = 32.68 + +UCL = 33.93 + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample average +WF3_gauge-r-r-non-replicable-report-subplot-4 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-5.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-5.svg new file mode 100644 index 00000000..44aac246 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-5.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +22.40% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the process variation +WF3_gauge-r-r-non-replicable-report-subplot-5 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-6.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-6.svg new file mode 100644 index 00000000..37482b62 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-6.svg @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + +Gauge r&R (non-replicable) report + + +WF3_gauge-r-r-non-replicable-report-subplot-6 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-7.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-7.svg new file mode 100644 index 00000000..77d7abe6 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-7.svg @@ -0,0 +1,41 @@ + + + + + + + + + + + + + + + + + + + + +Part name: +Gauge name: Test Name +Characteristic: +Gauge number: +Tolerance: +Location: +Performed by: +Date: + + +WF3_gauge-r-r-non-replicable-report-subplot-7 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-8.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-8.svg new file mode 100644 index 00000000..269043f0 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-8.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +31 +32 +33 +34 +35 + + + + + + + + + +A +B +C +Operator +Measurement +WF3_gauge-r-r-non-replicable-report-subplot-8 + + diff --git a/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-9.svg b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-9.svg new file mode 100644 index 00000000..83c18391 --- /dev/null +++ b/tests/testthat/_snaps/msaGaugeRRnonrep/wf3-gauge-r-r-non-replicable-report-subplot-9.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +11.36% + + + + + + + + + +0% +10% +30% +100% +Percent measurement system variation of the tolerance +WF3_gauge-r-r-non-replicable-report-subplot-9 + + diff --git a/tests/testthat/_snaps/msaTestRetest/range-chart-by-part.svg b/tests/testthat/_snaps/msaTestRetest/lf1-range-chart-by-part.svg similarity index 99% rename from tests/testthat/_snaps/msaTestRetest/range-chart-by-part.svg rename to tests/testthat/_snaps/msaTestRetest/lf1-range-chart-by-part.svg index 76166deb..4f0b7964 100644 --- a/tests/testthat/_snaps/msaTestRetest/range-chart-by-part.svg +++ b/tests/testthat/_snaps/msaTestRetest/lf1-range-chart-by-part.svg @@ -89,6 +89,6 @@ 15 Sample Sample range -range-chart-by-part +LF1_range-chart-by-part diff --git a/tests/testthat/_snaps/msaTestRetest/run-chart-of-parts.svg b/tests/testthat/_snaps/msaTestRetest/lf1-run-chart-of-parts.svg similarity index 98% rename from tests/testthat/_snaps/msaTestRetest/run-chart-of-parts.svg rename to tests/testthat/_snaps/msaTestRetest/lf1-run-chart-of-parts.svg index 9cbb8af7..f7c3020d 100644 --- a/tests/testthat/_snaps/msaTestRetest/run-chart-of-parts.svg +++ b/tests/testthat/_snaps/msaTestRetest/lf1-run-chart-of-parts.svg @@ -106,8 +106,8 @@ 13 14 15 -Parts +Part Measurements -run-chart-of-parts +LF1_run-chart-of-parts diff --git a/tests/testthat/_snaps/msaTestRetest/scatterplot-of-1st-measurement-vs-2nd-measurement.svg b/tests/testthat/_snaps/msaTestRetest/lf1-scatterplot-of-1st-measurement-vs-2nd-measurement.svg similarity index 95% rename from tests/testthat/_snaps/msaTestRetest/scatterplot-of-1st-measurement-vs-2nd-measurement.svg rename to tests/testthat/_snaps/msaTestRetest/lf1-scatterplot-of-1st-measurement-vs-2nd-measurement.svg index 9f5f1fba..cf759c26 100644 --- a/tests/testthat/_snaps/msaTestRetest/scatterplot-of-1st-measurement-vs-2nd-measurement.svg +++ b/tests/testthat/_snaps/msaTestRetest/lf1-scatterplot-of-1st-measurement-vs-2nd-measurement.svg @@ -67,8 +67,8 @@ 1.2 1.4 1.6 -X1 -X2 -scatterplot-of-1st-measurement-vs-2nd-measurement +1 +2 +LF1_scatterplot-of-1st-measurement-vs-2nd-measurement diff --git a/tests/testthat/_snaps/msaTestRetest/traffic-light-chart-subplot-1.svg b/tests/testthat/_snaps/msaTestRetest/lf1-trafficchart-subplot-1.svg similarity index 96% rename from tests/testthat/_snaps/msaTestRetest/traffic-light-chart-subplot-1.svg rename to tests/testthat/_snaps/msaTestRetest/lf1-trafficchart-subplot-1.svg index bc0aac35..1c122d87 100644 --- a/tests/testthat/_snaps/msaTestRetest/traffic-light-chart-subplot-1.svg +++ b/tests/testthat/_snaps/msaTestRetest/lf1-trafficchart-subplot-1.svg @@ -48,6 +48,6 @@ 30% 100% Percent study variation of GRR -Traffic-light-chart-subplot-1 +LF1_trafficChart-subplot-1 diff --git a/tests/testthat/_snaps/msaTestRetest/traffic-light-chart-subplot-2.svg b/tests/testthat/_snaps/msaTestRetest/lf1-trafficchart-subplot-2.svg similarity index 96% rename from tests/testthat/_snaps/msaTestRetest/traffic-light-chart-subplot-2.svg rename to tests/testthat/_snaps/msaTestRetest/lf1-trafficchart-subplot-2.svg index 8012478c..8bc24231 100644 --- a/tests/testthat/_snaps/msaTestRetest/traffic-light-chart-subplot-2.svg +++ b/tests/testthat/_snaps/msaTestRetest/lf1-trafficchart-subplot-2.svg @@ -48,6 +48,6 @@ 30% 100% Percent tolerance of GRR -Traffic-light-chart-subplot-2 +LF1_trafficChart-subplot-2 diff --git a/tests/testthat/_snaps/msaTestRetest/wf1-range-chart-by-part.svg b/tests/testthat/_snaps/msaTestRetest/wf1-range-chart-by-part.svg new file mode 100644 index 00000000..cafb9161 --- /dev/null +++ b/tests/testthat/_snaps/msaTestRetest/wf1-range-chart-by-part.svg @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +CL = 0.05 + +LCL = 0 + +UCL = 0.16 + + + + + + + + + + + + + + + + + + + + + + +0.00 +0.05 +0.10 +0.15 +0.20 + + + + + + + + + + + + + + + +1 +2 +4 +6 +8 +10 +12 +14 +15 +Sample +Sample range +WF1_range-chart-by-part + + diff --git a/tests/testthat/_snaps/msaTestRetest/wf1-run-chart-of-parts.svg b/tests/testthat/_snaps/msaTestRetest/wf1-run-chart-of-parts.svg new file mode 100644 index 00000000..d6e2f201 --- /dev/null +++ b/tests/testthat/_snaps/msaTestRetest/wf1-run-chart-of-parts.svg @@ -0,0 +1,113 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.0 +1.1 +1.2 +1.3 +1.4 +1.5 + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 +6 +7 +8 +9 +10 +11 +12 +13 +14 +15 +Part +Measurements +WF1_run-chart-of-parts + + diff --git a/tests/testthat/_snaps/msaTestRetest/wf1-scatterplot-of-1st-measurement-vs-2nd-measurement.svg b/tests/testthat/_snaps/msaTestRetest/wf1-scatterplot-of-1st-measurement-vs-2nd-measurement.svg new file mode 100644 index 00000000..be5584e6 --- /dev/null +++ b/tests/testthat/_snaps/msaTestRetest/wf1-scatterplot-of-1st-measurement-vs-2nd-measurement.svg @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.0 +1.2 +1.4 +1.6 + + + + + + + + + +1.0 +1.2 +1.4 +1.6 +Measurement1 +Measurement2 +WF1_scatterplot-of-1st-measurement-vs-2nd-measurement + + diff --git a/tests/testthat/_snaps/msaTestRetest/wf1-traffichart-subplot-1.svg b/tests/testthat/_snaps/msaTestRetest/wf1-traffichart-subplot-1.svg new file mode 100644 index 00000000..e4300fc2 --- /dev/null +++ b/tests/testthat/_snaps/msaTestRetest/wf1-traffichart-subplot-1.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +2.17% + + + + + + + + + +0% +10% +30% +100% +Percent study variation of GRR +WF1_traffiChart-subplot-1 + + diff --git a/tests/testthat/_snaps/msaTestRetest/wf1-traffichart-subplot-2.svg b/tests/testthat/_snaps/msaTestRetest/wf1-traffichart-subplot-2.svg new file mode 100644 index 00000000..46d71840 --- /dev/null +++ b/tests/testthat/_snaps/msaTestRetest/wf1-traffichart-subplot-2.svg @@ -0,0 +1,53 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.52% + + + + + + + + + +0% +10% +30% +100% +Percent tolerance of GRR +WF1_traffiChart-subplot-2 + + diff --git a/tests/testthat/_snaps/msaType1Gauge/1-bias-histogram.svg b/tests/testthat/_snaps/msaType1Gauge/1-bias-histogram.svg new file mode 100644 index 00000000..8a6f8bb4 --- /dev/null +++ b/tests/testthat/_snaps/msaType1Gauge/1-bias-histogram.svg @@ -0,0 +1,253 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 + + + + + + + + + + + +-5.5 +-5.0 +-4.5 +-4.0 +-3.5 +-3.0 +dm +Count + + + + + + + + + + + + + + +Mean +Mean - 3s +Mean + 3s +Reference +Ref. - 0.10 * tol. +Ref. + 0.10 * tol. +1_bias-histogram + + diff --git a/tests/testthat/_snaps/msaType1Gauge/run-chart-of-dm.svg b/tests/testthat/_snaps/msaType1Gauge/1-run-chart-of-dm.svg similarity index 67% rename from tests/testthat/_snaps/msaType1Gauge/run-chart-of-dm.svg rename to tests/testthat/_snaps/msaType1Gauge/1-run-chart-of-dm.svg index cc76809b..7364628b 100644 --- a/tests/testthat/_snaps/msaType1Gauge/run-chart-of-dm.svg +++ b/tests/testthat/_snaps/msaType1Gauge/1-run-chart-of-dm.svg @@ -27,16 +27,25 @@ - - -Ref + 0.1 * Tol - - -Ref - 0.1 * Tol + + +Ref. + 0.10 * tol. + + +Ref. - 0.10 * tol. + + - -Ref + + +Mean + 3s + +Mean - 3s + +Ref. + +Mean @@ -122,6 +131,6 @@ 50 Observation dm -run-chart-of-dm +1_run-chart-of-dm diff --git a/tests/testthat/_snaps/msaType1Gauge/2-bias-histogram.svg b/tests/testthat/_snaps/msaType1Gauge/2-bias-histogram.svg new file mode 100644 index 00000000..ccdf3fe2 --- /dev/null +++ b/tests/testthat/_snaps/msaType1Gauge/2-bias-histogram.svg @@ -0,0 +1,247 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 +15 + + + + + + + + + + +-5.0 +-4.5 +-4.0 +-3.5 +-3.0 +dm +Count + + + + + + + + + + + + + + +Mean +Mean - 2s +Mean + 2s +Reference +Ref. - 0.07 * tol. +Ref. + 0.07 * tol. +2_bias-histogram + + diff --git a/tests/testthat/_snaps/msaType1Gauge/2-run-chart-of-dm.svg b/tests/testthat/_snaps/msaType1Gauge/2-run-chart-of-dm.svg new file mode 100644 index 00000000..45252329 --- /dev/null +++ b/tests/testthat/_snaps/msaType1Gauge/2-run-chart-of-dm.svg @@ -0,0 +1,136 @@ + + + + + + + + + + + + + + + + + + + + + + + +Ref. + 0.07 * tol. + + +Ref. - 0.07 * tol. + + + + + + +Mean + 2s + +Mean - 2s + +Ref. + +Mean + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-5.5 +-5.0 +-4.5 +-4.0 +-3.5 +-3.0 +-2.5 + + + + + + + + + + + + + + +1 +10 +20 +30 +40 +50 +Observation +dm +2_run-chart-of-dm + + diff --git a/tests/testthat/_snaps/msaType1Gauge/3-bias-histogram.svg b/tests/testthat/_snaps/msaType1Gauge/3-bias-histogram.svg new file mode 100644 index 00000000..0053b8a3 --- /dev/null +++ b/tests/testthat/_snaps/msaType1Gauge/3-bias-histogram.svg @@ -0,0 +1,248 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 + + + + + + + + + + +-5.5 +-5.0 +-4.5 +-4.0 +-3.5 +-3.0 +dmMissing1 +Count + + + + + + + + + + + + + + +Mean +Mean - 3s +Mean + 3s +Reference +Ref. - 0.10 * tol. +Ref. + 0.10 * tol. +3_bias-histogram + + diff --git a/tests/testthat/_snaps/msaType1Gauge/3-run-chart-of-dmmissing1.svg b/tests/testthat/_snaps/msaType1Gauge/3-run-chart-of-dmmissing1.svg new file mode 100644 index 00000000..f0bd0397 --- /dev/null +++ b/tests/testthat/_snaps/msaType1Gauge/3-run-chart-of-dmmissing1.svg @@ -0,0 +1,135 @@ + + + + + + + + + + + + + + + + + + + + + + + +Ref. + 0.10 * tol. + + +Ref. - 0.10 * tol. + + + + + + +Mean + 3s + +Mean - 3s + +Ref. + +Mean + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-5.5 +-5.0 +-4.5 +-4.0 +-3.5 +-3.0 +-2.5 + + + + + + + + + + + + + + +1 +10 +20 +30 +40 +50 +Observation +dmMissing1 +3_run-chart-of-dmmissing1 + + diff --git a/tests/testthat/_snaps/msaType1Gauge/4-bias-histogram.svg b/tests/testthat/_snaps/msaType1Gauge/4-bias-histogram.svg new file mode 100644 index 00000000..bf4dcae1 --- /dev/null +++ b/tests/testthat/_snaps/msaType1Gauge/4-bias-histogram.svg @@ -0,0 +1,176 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +5 +10 + + + + + + + + + + +-4.6 +-4.4 +-4.2 +-4.0 +-3.8 +-3.6 +dmMissing25 +Count + + + + + + + + + + + + + + +Mean +Mean - 3s +Mean + 3s +Reference +Ref. - 0.10 * tol. +Ref. + 0.10 * tol. +4_bias-histogram + + diff --git a/tests/testthat/_snaps/msaType1Gauge/4-run-chart-of-dmmissing25.svg b/tests/testthat/_snaps/msaType1Gauge/4-run-chart-of-dmmissing25.svg new file mode 100644 index 00000000..a93f49b6 --- /dev/null +++ b/tests/testthat/_snaps/msaType1Gauge/4-run-chart-of-dmmissing25.svg @@ -0,0 +1,111 @@ + + + + + + + + + + + + + + + + + + + + + + + +Ref. + 0.10 * tol. + + +Ref. - 0.10 * tol. + + + + + + +Mean + 3s + +Mean - 3s + +Ref. + +Mean + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-5.5 +-5.0 +-4.5 +-4.0 +-3.5 +-3.0 +-2.5 + + + + + + + + + + + + + + +1 +5 +10 +15 +20 +25 +Observation +dmMissing25 +4_run-chart-of-dmmissing25 + + diff --git a/tests/testthat/_snaps/msaType1Gauge/5-run-chart-of-dmmissing49.svg b/tests/testthat/_snaps/msaType1Gauge/5-run-chart-of-dmmissing49.svg new file mode 100644 index 00000000..1721b6d0 --- /dev/null +++ b/tests/testthat/_snaps/msaType1Gauge/5-run-chart-of-dmmissing49.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + + + + + + + + + + + + +Ref. + 0.10 * tol. + + +Ref. - 0.10 * tol. + + + +Ref. + +Mean + + + + + + + +-5.5 +-5.0 +-4.5 +-4.0 +-3.5 +-3.0 +-2.5 + + + + + + + + + +1 +Observation +dmMissing49 +5_run-chart-of-dmmissing49 + + diff --git a/tests/testthat/_snaps/msaType1Gauge/bias-histogram.svg b/tests/testthat/_snaps/msaType1Gauge/bias-histogram.svg deleted file mode 100644 index b8472f05..00000000 --- a/tests/testthat/_snaps/msaType1Gauge/bias-histogram.svg +++ /dev/null @@ -1,84 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -5 -10 -15 - - - - - - - - - - - --5.5 --5.0 --4.5 --4.0 --3.5 --3.0 -dm -Counts - - - - - - -Mean -Reference -bias-histogram - - diff --git a/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart10-subplot-2.svg b/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart10-subplot-2.svg index 0122c5b5..655b61b4 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart10-subplot-2.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chart10-subplot-2.svg @@ -21,39 +21,39 @@ - - + + - - - -1 -2 - - - - + + + +1 +2 + + + + - --1 -0 - - - - - - - - -1 -5 -10 -15 -20 -Sample + +0 +1 + + + + + + + + +1 +5 +10 +15 +20 +Sample Sample range -x-bar-r-control-chart10-subplot-2 +x-bar-r-control-chart10-subplot-2 diff --git a/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chartw8-subplot-2.svg b/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chartw8-subplot-2.svg index e1f4810c..e6d5383e 100644 --- a/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chartw8-subplot-2.svg +++ b/tests/testthat/_snaps/processCapabilityStudies/x-bar-r-control-chartw8-subplot-2.svg @@ -21,36 +21,36 @@ - - + + - - - - - - + + + + + + - --1 -0 - - - - - - - - -06:15 -10:10 -15:05 -20:10 -01:05 -Sample + +0 +1 + + + + + + + + +06:15 +10:10 +15:05 +20:10 +01:05 +Sample Sample range -x-bar-r-control-chartW8-subplot-2 +x-bar-r-control-chartW8-subplot-2 diff --git a/tests/testthat/_snaps/variablesChartsSubgroups/x-bar-r-control-chart24-subplot-2.svg b/tests/testthat/_snaps/variablesChartsSubgroups/x-bar-r-control-chart24-subplot-2.svg index e1567d4b..e12b5cf8 100644 --- a/tests/testthat/_snaps/variablesChartsSubgroups/x-bar-r-control-chart24-subplot-2.svg +++ b/tests/testthat/_snaps/variablesChartsSubgroups/x-bar-r-control-chart24-subplot-2.svg @@ -21,36 +21,36 @@ - - + + - - - - - - + + + + + + - --1 -0 - - - - - - - - -1 -5 -10 -15 -20 -Sample + +0 +1 + + + + + + + + +1 +5 +10 +15 +20 +Sample Sample range -x-bar-r-control-chart24-subplot-2 +x-bar-r-control-chart24-subplot-2 diff --git a/tests/testthat/_snaps/variablesChartsSubgroups/x-bar-r-control-chart9-subplot-2.svg b/tests/testthat/_snaps/variablesChartsSubgroups/x-bar-r-control-chart9-subplot-2.svg index c5191dc9..68b7539c 100644 --- a/tests/testthat/_snaps/variablesChartsSubgroups/x-bar-r-control-chart9-subplot-2.svg +++ b/tests/testthat/_snaps/variablesChartsSubgroups/x-bar-r-control-chart9-subplot-2.svg @@ -21,36 +21,36 @@ - - + + - - - - - - + + + + + + - --1 -0 - - - - - - - - -1 -5 -10 -15 -20 -Sample + +0 +1 + + + + + + + + +1 +5 +10 +15 +20 +Sample Sample range -x-bar-r-control-chart9-subplot-2 +x-bar-r-control-chart9-subplot-2 diff --git a/tests/testthat/datasets/msaAttributeAgreement/msaAttributeKappa_long.csv b/tests/testthat/datasets/msaAttributeAgreement/msaAttributeKappa_long.csv new file mode 100644 index 00000000..8f3986cb --- /dev/null +++ b/tests/testthat/datasets/msaAttributeAgreement/msaAttributeKappa_long.csv @@ -0,0 +1,136 @@ +Part,Operator,Results,Reference,PartMissing5,OperatorMissing5,ResultsMissing5,ReferenceMissing5 +1,EG,Yes,Yes,1,EG,Yes,Yes +1,EG,Yes,Yes,1,EG,Yes,Yes +1,EG,Yes,Yes,1,EG,Yes,Yes +2,EG,No,No,,EG,No,No +2,EG,No,No,2,EG,No,No +2,EG,No,No,2,EG,No,No +3,EG,Yes,Yes,3,EG,Yes,Yes +3,EG,Yes,Yes,3,EG,Yes,Yes +3,EG,Yes,Yes,3,EG,Yes,Yes +4,EG,Yes,Yes,4,EG,Yes,Yes +4,EG,No,Yes,4,EG,No,Yes +4,EG,No,Yes,4,EG,No,Yes +5,EG,Yes,Yes,5,EG,Yes,Yes +5,EG,Yes,Yes,5,EG,Yes,Yes +5,EG,Yes,Yes,5,EG,Yes,Yes +6,EG,Yes,No,6,EG,Yes,No +6,EG,Yes,No,6,EG,Yes,No +6,EG,Yes,No,6,EG,Yes,No +7,EG,Yes,Yes,,EG,Yes,Yes +7,EG,Yes,Yes,7,EG,Yes,Yes +7,EG,Yes,Yes,7,EG,Yes,Yes +8,EG,No,No,8,EG,No,No +8,EG,No,No,8,EG,No,No +8,EG,No,No,8,EG,No,No +9,EG,No,No,9,EG,No, +9,EG,No,No,9,EG,No,No +9,EG,No,No,,EG,No,No +10,EG,Yes,Yes,10,EG,Yes,Yes +10,EG,Yes,Yes,10,EG,Yes,Yes +10,EG,Yes,Yes,,EG,Yes,Yes +11,EG,No,No,11,EG,No,No +11,EG,No,No,11,,,No +11,EG,No,No,11,EG,No,No +12,EG,Yes,Yes,12,EG,Yes,Yes +12,EG,Yes,Yes,12,EG,Yes,Yes +12,EG,Yes,Yes,12,EG,Yes,Yes +13,EG,Yes,Yes,13,,Yes,Yes +13,EG,Yes,Yes,13,EG,Yes,Yes +13,EG,Yes,Yes,13,EG,Yes,Yes +14,EG,No,Yes,14,EG,,Yes +14,EG,No,Yes,14,EG,No,Yes +14,EG,No,Yes,,,No,Yes +15,EG,Yes,Yes,15,EG,Yes,Yes +15,EG,Yes,Yes,15,EG,Yes,Yes +15,EG,Yes,Yes,15,EG,Yes,Yes +1,BL,Yes,Yes,1,BL,Yes,Yes +1,BL,Yes,Yes,1,BL,Yes,Yes +1,BL,Yes,Yes,1,BL,Yes,Yes +2,BL,No,No,2,BL,,No +2,BL,No,No,2,BL,No,No +2,BL,No,No,2,BL,No,No +3,BL,Yes,Yes,3,BL,Yes,Yes +3,BL,Yes,Yes,3,BL,Yes,Yes +3,BL,Yes,Yes,3,BL,Yes, +4,BL,Yes,Yes,4,,Yes,Yes +4,BL,No,Yes,4,BL,No,Yes +4,BL,No,Yes,4,BL,No,Yes +5,BL,Yes,Yes,5,BL,Yes,Yes +5,BL,Yes,Yes,5,BL,Yes,Yes +5,BL,Yes,Yes,5,BL,Yes,Yes +6,BL,Yes,No,6,BL,,No +6,BL,Yes,No,6,BL,Yes,No +6,BL,Yes,No,6,,Yes,No +7,BL,No,Yes,7,BL,No,Yes +7,BL,No,Yes,7,BL,No,Yes +7,BL,No,Yes,7,BL,No, +8,BL,No,No,8,BL,,No +8,BL,No,No,8,BL,No,No +8,BL,No,No,8,BL,No,No +9,BL,No,No,9,BL,No,No +9,BL,No,No,9,BL,No,No +9,BL,No,No,9,BL,No,No +10,BL,Yes,Yes,10,BL,Yes,Yes +10,BL,Yes,Yes,10,BL,Yes,Yes +10,BL,Yes,Yes,10,BL,Yes,Yes +11,BL,No,No,11,BL,No, +11,BL,No,No,11,BL,No,No +11,BL,No,No,11,BL,No,No +12,BL,Yes,Yes,12,BL,Yes,Yes +12,BL,Yes,Yes,12,BL,Yes,Yes +12,BL,Yes,Yes,12,BL,Yes,Yes +13,BL,Yes,Yes,13,BL,Yes,Yes +13,BL,Yes,Yes,13,BL,Yes,Yes +13,BL,Yes,Yes,13,BL,Yes,Yes +14,BL,No,Yes,14,BL,No,Yes +14,BL,No,Yes,14,BL,No,Yes +14,BL,No,Yes,14,BL,No,Yes +15,BL,Yes,Yes,15,BL,Yes,Yes +15,BL,Yes,Yes,15,BL,Yes,Yes +15,BL,Yes,Yes,15,BL,Yes,Yes +1,MH,Yes,Yes,1,MH,Yes,Yes +1,MH,Yes,Yes,1,MH,Yes,Yes +1,MH,Yes,Yes,1,MH,Yes,Yes +2,MH,Yes,No,2,MH,Yes,No +2,MH,Yes,No,2,MH,Yes,No +2,MH,Yes,No,2,MH,Yes,No +3,MH,Yes,Yes,3,MH,Yes,Yes +3,MH,Yes,Yes,3,MH,Yes,Yes +3,MH,Yes,Yes,3,MH,Yes,Yes +4,MH,Yes,Yes,4,MH,Yes,Yes +4,MH,Yes,Yes,4,MH,Yes,Yes +4,MH,Yes,Yes,4,MH,Yes,Yes +5,MH,Yes,Yes,5,MH,Yes,Yes +5,MH,Yes,Yes,5,MH,Yes,Yes +5,MH,Yes,Yes,5,MH,Yes,Yes +6,MH,Yes,No,6,MH,Yes,No +6,MH,Yes,No,6,MH,Yes,No +6,MH,Yes,No,6,MH,Yes,No +7,MH,Yes,Yes,7,MH,Yes,Yes +7,MH,Yes,Yes,7,MH,Yes,Yes +7,MH,Yes,Yes,7,MH,Yes,Yes +8,MH,No,No,8,MH,No,No +8,MH,No,No,8,MH,No,No +8,MH,Yes,No,8,MH,Yes,No +9,MH,Yes,No,9,MH,Yes,No +9,MH,No,No,9,MH,No, +9,MH,No,No,9,MH,No,No +10,MH,Yes,Yes,10,MH,Yes,Yes +10,MH,Yes,Yes,10,MH,Yes,Yes +10,MH,Yes,Yes,10,MH,Yes,Yes +11,MH,Yes,No,11,MH,Yes,No +11,MH,No,No,11,MH,No,No +11,MH,Yes,No,11,MH,Yes,No +12,MH,Yes,Yes,12,MH,Yes,Yes +12,MH,Yes,Yes,12,MH,Yes,Yes +12,MH,Yes,Yes,12,MH,Yes,Yes +13,MH,Yes,Yes,13,MH,Yes,Yes +13,MH,Yes,Yes,13,MH,Yes,Yes +13,MH,Yes,Yes,13,MH,Yes,Yes +14,MH,No,Yes,14,MH,No,Yes +14,MH,No,Yes,14,MH,No,Yes +14,MH,No,Yes,14,MH,No,Yes +15,MH,Yes,Yes,15,MH,Yes,Yes +15,MH,Yes,Yes,15,MH,Yes,Yes +15,MH,Yes,Yes,15,MH,Yes,Yes diff --git a/tests/testthat/datasets/msaAttributeAgreement/msaAttributeKappa_wide.csv b/tests/testthat/datasets/msaAttributeAgreement/msaAttributeKappa_wide.csv new file mode 100644 index 00000000..e340efe5 --- /dev/null +++ b/tests/testthat/datasets/msaAttributeAgreement/msaAttributeKappa_wide.csv @@ -0,0 +1,46 @@ +Operator,Part,Repeat.1,Repeat.2,Repeat.3,Reference,OperatorMissing5,PartMissing5,Repeat.1Missing5,Repeat.2Missing5,Repeat.3Missing5,ReferenceMissing5 +EG,1,Yes,Yes,Yes,Yes,EG,1,Yes,Yes,Yes,Yes +EG,2,No,No,No,No,EG,2,No,No,No,No +EG,3,Yes,Yes,Yes,Yes,,3,Yes,,Yes,Yes +EG,4,Yes,No,No,Yes,EG,4,Yes,No,No,Yes +EG,5,Yes,Yes,Yes,Yes,EG,5,Yes,Yes,Yes,Yes +EG,6,Yes,Yes,Yes,No,EG,6,,,,No +EG,7,Yes,Yes,Yes,Yes,EG,7,Yes,Yes,Yes, +EG,8,No,No,No,No,EG,,No,No,No,No +EG,9,No,No,No,No,EG,9,No,No,No,No +EG,10,Yes,Yes,Yes,Yes,EG,10,Yes,Yes,Yes,Yes +EG,11,No,No,No,No,EG,,No,,No,No +EG,12,Yes,Yes,Yes,Yes,EG,12,Yes,Yes,Yes,Yes +EG,13,Yes,Yes,Yes,Yes,EG,13,Yes,Yes,,Yes +EG,14,No,No,No,Yes,EG,14,No,No,No,Yes +EG,15,Yes,Yes,Yes,Yes,EG,15,,Yes,Yes,Yes +BL,1,Yes,Yes,Yes,Yes,BL,,Yes,Yes,Yes,Yes +BL,2,No,No,No,No,,2,No,No,No,No +BL,3,Yes,Yes,Yes,Yes,BL,3,Yes,Yes,Yes, +BL,4,Yes,No,No,Yes,BL,4,Yes,No,No,Yes +BL,5,Yes,Yes,Yes,Yes,BL,5,Yes,,Yes,Yes +BL,6,Yes,Yes,Yes,No,BL,,Yes,Yes,,No +BL,7,No,No,No,Yes,BL,7,,No,No,Yes +BL,8,No,No,No,No,BL,8,No,No,No,No +BL,9,No,No,No,No,,9,No,No,No,No +BL,10,Yes,Yes,Yes,Yes,BL,10,Yes,Yes,,Yes +BL,11,No,No,No,No,BL,11,No,No,,No +BL,12,Yes,Yes,Yes,Yes,BL,12,,Yes,Yes,Yes +BL,13,Yes,Yes,Yes,Yes,BL,13,Yes,Yes,Yes, +BL,14,No,No,No,Yes,BL,14,No,No,No,Yes +BL,15,Yes,Yes,Yes,Yes,BL,15,,,,Yes +MH,1,Yes,Yes,Yes,Yes,MH,1,Yes,Yes,Yes,Yes +MH,2,Yes,Yes,Yes,No,,,Yes,Yes,Yes,No +MH,3,Yes,Yes,Yes,Yes,MH,3,Yes,Yes,Yes, +MH,4,Yes,Yes,Yes,Yes,MH,4,Yes,Yes,Yes,Yes +MH,5,Yes,Yes,Yes,Yes,MH,5,,Yes,Yes,Yes +MH,6,Yes,Yes,Yes,No,MH,6,Yes,Yes,Yes,No +MH,7,Yes,Yes,Yes,Yes,MH,7,Yes,Yes,Yes, +MH,8,No,No,Yes,No,MH,8,No,No,Yes,No +MH,9,Yes,No,No,No,,9,Yes,No,No,No +MH,10,Yes,Yes,Yes,Yes,MH,10,Yes,Yes,Yes,Yes +MH,11,Yes,No,Yes,No,MH,11,Yes,No,Yes,No +MH,12,Yes,Yes,Yes,Yes,MH,12,Yes,Yes,Yes,Yes +MH,13,Yes,Yes,Yes,Yes,MH,13,Yes,Yes,Yes,Yes +MH,14,No,No,No,Yes,MH,14,No,No,No,Yes +MH,15,Yes,Yes,Yes,Yes,MH,15,Yes,Yes,Yes,Yes diff --git a/tests/testthat/datasets/msaAttributeAgreement/msaAttributeTau_long.csv b/tests/testthat/datasets/msaAttributeAgreement/msaAttributeTau_long.csv new file mode 100644 index 00000000..0ea4eec9 --- /dev/null +++ b/tests/testthat/datasets/msaAttributeAgreement/msaAttributeTau_long.csv @@ -0,0 +1,121 @@ +Sample,Agreed,Operator,Rating,SampleMissing5,AgreedMissing5,OperatorMissing5,RatingMissing5 +1,5,A,5,1,5,A,5 +2,5,A,5,2,5,A,5 +3,5,A,5,,5,A,5 +4,0,A,0,4,0,A,0 +5,0,A,0,5,0,A,0 +6,4,A,5,6,4,A,5 +7,0,A,0,7,0,A,0 +8,0,A,0,8,0,A,0 +9,0,A,0,9,0,A,0 +10,4,A,0,10,4,A, +11,0,A,0,11,0,A,0 +12,4,A,4,12,4,A,4 +13,5,A,5,,5,A,5 +14,4,A,4,14,4,A,4 +15,4,A,3,15,4,A,3 +16,0,A,0,16,0,A,0 +17,4,A,0,17,4,A,0 +18,3,A,5,18,3,A,5 +19,0,A,0,19,0,A,0 +20,0,A,0,20,0,A,0 +21,3,A,0,21,3,A,0 +22,4,A,4,22,4,A,4 +23,3,A,0,23,3,A,0 +24,0,A,0,,0,A,0 +25,0,A,0,25,0,A, +26,5,A,6,26,5,A,6 +27,5,A,6,27,5,A,6 +28,0,A,0,28,0,A,0 +29,0,A,0,29,0,A,0 +30,0,A,0,30,0,A,0 +1,5,B,4,1,5,B,4 +2,5,B,5,2,5,B,5 +3,5,B,5,3,5,B,5 +4,0,B,0,4,0,B,0 +5,0,B,0,5,0,B,0 +6,4,B,3,6,4,B,3 +7,0,B,0,7,0,B,0 +8,0,B,0,8,0,B,0 +9,0,B,0,9,0,B,0 +10,4,B,4,10,4,B,4 +11,0,B,0,11,0,B,0 +12,4,B,0,12,4,B,0 +13,5,B,4,,5,B,4 +14,4,B,4,14,4,B,4 +15,4,B,4,15,4,B,4 +16,0,B,0,16,0,B,0 +17,4,B,4,17,,B,4 +18,3,B,0,18,3,B,0 +19,0,B,0,19,0,B,0 +20,0,B,0,20,0,B,0 +21,3,B,4,21,3,,4 +22,4,B,4,22,4,B,4 +23,3,B,4,23,3,B,4 +24,0,B,0,24,0,B, +25,0,B,0,25,0,B,0 +26,5,B,4,26,5,B,4 +27,5,B,4,27,5,B,4 +28,0,B,0,28,0,B,0 +29,0,B,0,29,0,B,0 +30,0,B,0,30,0,B,0 +1,5,C,6,1,5,,6 +2,5,C,5,2,5,C,5 +3,5,C,4,3,,C,4 +4,0,C,0,,0,C,0 +5,0,C,0,5,0,C,0 +6,4,C,4,6,4,C,4 +7,0,C,0,7,0,C,0 +8,0,C,0,8,0,C,0 +9,0,C,0,9,0,C,0 +10,4,C,0,10,4,C,0 +11,0,C,4,11,0,C,4 +12,4,C,0,12,,C,0 +13,5,C,5,13,5,C,5 +14,4,C,4,14,4,C,4 +15,4,C,4,15,4,C,4 +16,0,C,0,16,0,,0 +17,4,C,4,17,4,C,4 +18,3,C,5,18,3,C,5 +19,0,C,0,19,0,C,0 +20,0,C,6,20,0,C,6 +21,3,C,4,21,3,C,4 +22,4,C,4,22,4,C,4 +23,3,C,3,23,3,C,3 +24,0,C,0,24,0,C,0 +25,0,C,0,25,0,C,0 +26,5,C,5,26,5,C,5 +27,5,C,6,27,5,C,6 +28,0,C,0,28,0,C,0 +29,0,C,5,29,0,C,5 +30,0,C,0,30,0,C,0 +1,5,D,4,1,5,D,4 +2,5,D,5,2,5,D,5 +3,5,D,4,3,5,D,4 +4,0,D,0,4,0,D,0 +5,0,D,0,5,0,D,0 +6,4,D,4,6,4,D,4 +7,0,D,0,7,0,D, +8,0,D,0,8,0,D,0 +9,0,D,0,9,0,D,0 +10,4,D,0,10,4,D,0 +11,0,D,0,11,0,D,0 +12,4,D,4,12,4,,4 +13,5,D,5,13,5,D,5 +14,4,D,0,14,4,D,0 +15,4,D,4,15,,D,4 +16,0,D,0,16,0,D,0 +17,4,D,0,17,4,D,0 +18,3,D,0,18,3,D,0 +19,0,D,0,19,0,D,0 +20,0,D,0,20,0,D,0 +21,3,D,0,21,3,D, +22,4,D,4,22,4,D,4 +23,3,D,0,23,3,D,0 +24,0,D,0,24,0,,0 +25,0,D,0,25,0,D,0 +26,5,D,4,26,5,D,4 +27,5,D,4,27,5,D,4 +28,0,D,0,28,0,D,0 +29,0,D,0,29,0,D,0 +30,0,D,0,30,0,D,0 diff --git a/tests/testthat/datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv b/tests/testthat/datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv new file mode 100644 index 00000000..0d2742f8 --- /dev/null +++ b/tests/testthat/datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv @@ -0,0 +1,91 @@ +Run,Parts,Operators,Dm,PartsMissing5,OperatorsMissing5,DmMissing5 +7,1,Operator A,-0.5,1,Operator A,-0.5 +36,1,Operator A,-0.5,1,,-0.5 +70,1,Operator A,-0.5,1,Operator A,-0.5 +8,2,Operator A,-7,2,Operator A,-7 +37,2,Operator A,-6.5,2,Operator A, +69,2,Operator A,-6,2,Operator A,-6 +2,3,Operator A,-2,3,Operator A,-2 +32,3,Operator A,-2,,Operator A,-2 +65,3,Operator A,-1.5,3,Operator A,-1.5 +4,4,Operator A,-8,4,Operator A,-8 +35,4,Operator A,-8,4,Operator A,-8 +63,4,Operator A,-7.5,4,Operator A,-7.5 +5,5,Operator A,-4,5,Operator A,-4 +33,5,Operator A,-4,5,Operator A,-4 +68,5,Operator A,-3.5,5,Operator A,-3.5 +10,6,Operator A,-2,6,Operator A,-2 +34,6,Operator A,-1,6,Operator A,-1 +66,6,Operator A,-2,6,Operator A,-2 +3,7,Operator A,-11,7,Operator A,-11 +31,7,Operator A,-11,7,Operator A,-11 +61,7,Operator A,-11,7,Operator A,-11 +1,8,Operator A,-6,8,Operator A,-6 +38,8,Operator A,-6,8,Operator A,-6 +67,8,Operator A,-6,8,Operator A,-6 +6,9,Operator A,-2,9,Operator A,-2 +39,9,Operator A,-2,9,Operator A,-2 +62,9,Operator A,-1,9,Operator A,-1 +9,10,Operator A,-6,10,Operator A,-6 +40,10,Operator A,-6,10,Operator A,-6 +64,10,Operator A,-6,10,, +15,1,Operator B,-0.5,1,Operator B,-0.5 +45,1,Operator B,-0.5,1,Operator B,-0.5 +80,1,Operator B,-0.5,1,Operator B,-0.5 +20,2,Operator B,-6.5,2,Operator B,-6.5 +42,2,Operator B,-7,2,Operator B,-7 +73,2,Operator B,-6.5,2,Operator B,-6.5 +18,3,Operator B,-1,3,Operator B,-1 +44,3,Operator B,-1,,Operator B,-1 +79,3,Operator B,-2,3,Operator B,-2 +12,4,Operator B,-7,4,Operator B,-7 +43,4,Operator B,-7.5,4,Operator B, +78,4,Operator B,-7.5,4,Operator B,-7.5 +11,5,Operator B,-3.5,5,Operator B,-3.5 +49,5,Operator B,-3.5,5,Operator B,-3.5 +71,5,Operator B,-4,5,,-4 +16,6,Operator B,-1,6,Operator B,-1 +50,6,Operator B,-2,6,Operator B,-2 +72,6,Operator B,-2,6,Operator B,-2 +14,7,Operator B,-11,7,Operator B,-11 +46,7,Operator B,-11,7,Operator B,-11 +76,7,Operator B,-11,7,Operator B,-11 +17,8,Operator B,-6,8,Operator B,-6 +48,8,Operator B,-6,8,Operator B, +77,8,Operator B,-6,8,Operator B,-6 +13,9,Operator B,-2,9,,-2 +41,9,Operator B,-2,9,Operator B,-2 +74,9,Operator B,-2,9,Operator B,-2 +19,10,Operator B,-6,10,Operator B,-6 +47,10,Operator B,-6,,Operator B,-6 +75,10,Operator B,-6,10,Operator B,-6 +26,1,Operator C,-1,1,Operator C,-1 +53,1,Operator C,-0.5,1,Operator C,-0.5 +83,1,Operator C,-0.5,1,Operator C,-0.5 +21,2,Operator C,-6,2,Operator C,-6 +57,2,Operator C,-6,2,Operator C, +88,2,Operator C,-6,2,Operator C,-6 +28,3,Operator C,-2,3,Operator C,-2 +54,3,Operator C,-2,3,Operator C,-2 +90,3,Operator C,-1,3,Operator C,-1 +22,4,Operator C,-7,4,Operator C,-7 +58,4,Operator C,-7,4,Operator C,-7 +85,4,Operator C,-7,,Operator C,-7 +25,5,Operator C,-3,5,Operator C,-3 +56,5,Operator C,-4,5,Operator C,-4 +87,5,Operator C,-4,5,Operator C,-4 +27,6,Operator C,-1,6,Operator C,-1 +60,6,Operator C,-1,6,Operator C,-1 +81,6,Operator C,-1,6,Operator C,-1 +23,7,Operator C,-11,7,Operator C,-11 +51,7,Operator C,-10,7,Operator C,-10 +89,7,Operator C,-11,7,Operator C,-11 +29,8,Operator C,-6,8,,-6 +55,8,Operator C,-5,8,Operator C,-5 +86,8,Operator C,-5,8,Operator C,-5 +24,9,Operator C,-2,9,Operator C,-2 +52,9,Operator C,-1,9,Operator C,-1 +82,9,Operator C,-2,9,Operator C,-2 +30,10,Operator C,-6,10,Operator C,-6 +59,10,Operator C,-6,,Operator C,-6 +84,10,Operator C,-6,10,Operator C,-6 diff --git a/tests/testthat/datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv b/tests/testthat/datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv new file mode 100644 index 00000000..4a4642da --- /dev/null +++ b/tests/testthat/datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv @@ -0,0 +1,31 @@ +Operator,Part,Measurement1,Measurement2,Measurement3,OperatorMissing5,PartMissing5,Measurement1Missing5,Measurement2Missing5,Measurement3Missing5 +A,1,11.47508631,10.39458285,12.01885527,A,1,11.47508631,10.39458285,12.01885527 +B,1,10.36433412,10.18773633,10.44934243,B,,10.36433412,10.18773633,10.44934243 +C,1,11.82882975,9.080170551,10.70349264,,1,11.82882975,9.080170551,10.70349264 +A,2,5.932503725,8.166070237,8.379381474,A,2,5.932503725,8.166070237,8.379381474 +B,2,6.462534845,8.279574454,7.947087832,B,2,,, +C,2,8.128436252,7.587629062,9.470104531,C,2,8.128436252,7.587629062,9.470104531 +A,3,6.546149555,7.067798465,9.053303869,A,,6.546149555,7.067798465,9.053303869 +B,3,7.277440823,6.786190061,9.609245246,B,3,7.277440823,6.786190061, +C,3,6.564494743,7.403837873,4.880407594,C,3,6.564494743,7.403837873,4.880407594 +A,4,10.80709996,7.871202933,8.848345562,A,,10.80709996,,8.848345562 +B,4,9.453631343,8.153288282,9.726037739,,4,9.453631343,8.153288282,9.726037739 +C,4,9.400382161,8.339462717,8.760034996,C,4,,8.339462717,8.760034996 +A,5,9.170567153,12.81936487,11.57257807,A,5,9.170567153,12.81936487,11.57257807 +B,5,11.22739331,10.14313235,10.90230764,B,5,11.22739331,10.14313235,10.90230764 +C,5,10.51837921,10.35792725,9.162059696,C,,10.51837921,10.35792725,9.162059696 +A,6,8.302862749,8.549813051,9.401191612,A,6,8.302862749,8.549813051, +B,6,8.129536693,8.150409158,8.811062329,B,6,8.129536693,8.150409158,8.811062329 +C,6,8.394631887,8.682379386,8.715200975,,6,,8.682379386,8.715200975 +A,7,6.08942143,8.567477243,6.407021271,A,7,6.08942143,,6.407021271 +B,7,7.822564943,5.685934567,7.363412846,B,7,7.822564943,5.685934567,7.363412846 +C,7,6.026057165,6.481758565,7.28120972,C,7,6.026057165,6.481758565, +A,8,5.960289779,5.113996382,7.008724901,A,8,5.960289779,5.113996382,7.008724901 +B,8,6.294267434,5.871694334,5.796146094,B,8,6.294267434,5.871694334,5.796146094 +C,8,6.672000388,5.905375186,6.730683818,,8,,,6.730683818 +A,9,6.905913491,8.758733213,8.84172787,A,9,6.905913491,8.758733213,8.84172787 +B,9,7.981804441,7.924074953,9.232042804,B,9,7.981804441,7.924074953,9.232042804 +C,9,8.116895733,7.246734626,8.498385162,C,9,8.116895733,7.246734626,8.498385162 +A,10,5.197567991,5.304200443,6.082679479,A,,,5.304200443, +B,10,6.491304319,6.410390759,4.874269979,,10,6.491304319,6.410390759,4.874269979 +C,10,5.209453338,5.744852215,4.818953594,C,10,5.209453338,,4.818953594 diff --git a/tests/testthat/datasets/msaGaugeRRNested/msaGaugeRRNested_long.csv b/tests/testthat/datasets/msaGaugeRRNested/msaGaugeRRNested_long.csv new file mode 100644 index 00000000..bb18c78f --- /dev/null +++ b/tests/testthat/datasets/msaGaugeRRNested/msaGaugeRRNested_long.csv @@ -0,0 +1,31 @@ +Operator,Batch,Result,OperatorMissing5,BatchMissing5,ResultMissing5 +A,1,33.4,A,1,33.4 +A,1,33.2,A,1,33.2 +A,2,32.4,A,2,32.4 +A,2,31.7,A,2,31.7 +A,3,34.4,A,3,34.4 +A,3,34.5,,, +A,4,33.9,A,4,33.9 +A,4,34.5,A,4,34.5 +A,5,34.5,A,5,34.5 +A,5,34.7,A,, +B,6,32.5,B,6,32.5 +B,6,32.1,,6,32.1 +B,7,32.1,B,,32.1 +B,7,32.3,B,7,32.3 +B,8,35.1,B,8, +B,8,34.7,,8,34.7 +B,9,32.4,B,9,32.4 +B,9,33.1,B,,33.1 +B,10,34.8,B,10,34.8 +B,10,34.9,,10, +C,11,32.6,C,11,32.6 +C,11,32.7,C,11,32.7 +C,12,32.3,C,12,32.3 +C,12,32.1,C,,32.1 +C,13,34.9,,13, +C,13,34.7,C,13,34.7 +C,14,33,C,14,33 +C,14,33.2,C,14,33.2 +C,15,31.6,C,15,31.6 +C,15,30.9,C,15,30.9 diff --git a/tests/testthat/datasets/msaGaugeRRNested/msaGaugeRRNested_wide.csv b/tests/testthat/datasets/msaGaugeRRNested/msaGaugeRRNested_wide.csv new file mode 100644 index 00000000..ed20a067 --- /dev/null +++ b/tests/testthat/datasets/msaGaugeRRNested/msaGaugeRRNested_wide.csv @@ -0,0 +1,16 @@ +Operator,Batch,Result1,Result2,OperatorMissing5,BatchMissing5,Result1Missing5,Result2Missing5 +A,1,33.4,33.2,A,1,33.4,33.2 +A,2,32.4,31.7,A,2,, +A,3,34.4,34.5,A,3,,34.5 +A,4,33.9,34.5,,,33.9, +A,5,34.5,34.7,A,5,34.5,34.7 +B,6,32.5,32.1,B,,,32.1 +B,7,32.1,32.3,B,7,32.1,32.3 +B,8,35.1,34.7,,8,35.1,34.7 +B,9,32.4,33.1,B,,, +B,10,34.8,34.9,,10,34.8,34.9 +C,11,32.6,32.7,C,,32.6,32.7 +C,12,32.3,32.1,C,12,, +C,13,34.9,34.7,,13,34.9,34.7 +C,14,33,33.2,C,,33,33.2 +C,15,31.6,30.9,,15,31.6, diff --git a/tests/testthat/datasets/msaLinearityStudy/msaLinearity.csv b/tests/testthat/datasets/msaLinearityStudy/msaLinearity.csv new file mode 100644 index 00000000..45756839 --- /dev/null +++ b/tests/testthat/datasets/msaLinearityStudy/msaLinearity.csv @@ -0,0 +1,61 @@ +,Part,Reference,Measurement,PartMissing5,ReferenceMissing5,MeasurementMissing5 +1,1,2,2.7,1,2,2.7 +2,1,2,2.5,1,2, +3,1,2,2.4,1,2,2.4 +4,1,2,2.5,1,, +5,1,2,2.7,1,2,2.7 +6,1,2,2.3,1,2,2.3 +7,1,2,2.5,1,2, +8,1,2,2.5,1,2,2.5 +9,1,2,2.4,1,2,2.4 +10,1,2,2.4,1,2,2.4 +11,1,2,2.6,,2,2.6 +12,1,2,2.4,1,2,2.4 +13,2,4,5.1,2,4,5.1 +14,2,4,3.9,2,,3.9 +15,2,4,4.2,2,4,4.2 +16,2,4,5,2,4,5 +17,2,4,3.8,2,4,3.8 +18,2,4,3.9,2,4,3.9 +19,2,4,3.9,2,4, +20,2,4,3.9,2,4,3.9 +21,2,4,3.9,2,,3.9 +22,2,4,4,,4,4 +23,2,4,4.1,2,4,4.1 +24,2,4,3.8,2,4,3.8 +25,3,6,5.8,3,6,5.8 +26,3,6,5.7,3,6,5.7 +27,3,6,5.9,3,6,5.9 +28,3,6,5.9,3,6,5.9 +29,3,6,6,3,6,6 +30,3,6,6.1,3,6, +31,3,6,6,3,6,6 +32,3,6,6.1,3,6,6.1 +33,3,6,6.4,,6,6.4 +34,3,6,6.3,3,6,6.3 +35,3,6,6,3,,6 +36,3,6,6.1,3,6,6.1 +37,4,8,7.6,4,8,7.6 +38,4,8,7.7,4,8,7.7 +39,4,8,7.8,4,8,7.8 +40,4,8,7.7,4,8,7.7 +41,4,8,7.8,4,8,7.8 +42,4,8,7.8,4,8,7.8 +43,4,8,7.8,4,8,7.8 +44,4,8,7.7,4,8,7.7 +45,4,8,7.8,4,8,7.8 +46,4,8,7.5,4,8,7.5 +47,4,8,7.6,,8,7.6 +48,4,8,7.7,4,8,7.7 +49,5,10,9.1,5,10,9.1 +50,5,10,9.3,5,10,9.3 +51,5,10,9.5,5,10,9.5 +52,5,10,9.3,5,10,9.3 +53,5,10,9.4,5,,9.4 +54,5,10,9.5,5,10,9.5 +55,5,10,9.5,5,10,9.5 +56,5,10,9.5,5,10,9.5 +57,5,10,9.6,5,10,9.6 +58,5,10,9.2,,10,9.2 +59,5,10,9.3,5,10,9.3 +60,5,10,9.4,5,10,9.4 diff --git a/tests/testthat/datasets/msaTestRetest/msaTestRetest_long.csv b/tests/testthat/datasets/msaTestRetest/msaTestRetest_long.csv new file mode 100644 index 00000000..8290ab7d --- /dev/null +++ b/tests/testthat/datasets/msaTestRetest/msaTestRetest_long.csv @@ -0,0 +1,31 @@ +Part,Measurement,Repetition,PartMissing5,MeasurementMissing5,RepetitionMissing5 +1,1.36,1,1,1.36,1 +2,1.31,1,2,,1 +3,1.46,1,3,1.46,1 +4,1.25,1,4,, +5,1.22,1,5,1.22,1 +6,1.09,1,,1.09,1 +7,1.14,1,7,,1 +8,1.16,1,8,1.16,1 +9,1.14,1,,1.14,1 +10,1.18,1,10,1.18,1 +11,1.15,1,11,1.15,1 +12,1.13,1,12,, +13,1.14,1,13,1.14,1 +14,1.1,1,14,1.1,1 +15,1.12,1,,1.12,1 +1,1.43,2,1,1.43,2 +2,1.38,2,2,1.38,2 +3,1.38,2,3,1.38,2 +4,1.31,2,4,1.31, +5,1.19,2,5,1.19,2 +6,1.14,2,,1.14,2 +7,1.18,2,7,1.18,2 +8,1.11,2,8,1.11,2 +9,1.07,2,9,,2 +10,1.17,2,10,1.17, +11,1.12,2,,1.12,2 +12,1.07,2,12,1.07,2 +13,1.11,2,13,1.11,2 +14,1.16,2,14,1.16, +15,1.16,2,15,1.16,2 diff --git a/tests/testthat/datasets/msaTestRetest/msaTestRetest_wide.csv b/tests/testthat/datasets/msaTestRetest/msaTestRetest_wide.csv new file mode 100644 index 00000000..1379b32e --- /dev/null +++ b/tests/testthat/datasets/msaTestRetest/msaTestRetest_wide.csv @@ -0,0 +1,16 @@ +Part,Measurement1,Measurement2,PartMissing5,Measurement1Missing5,Measurement2Missing5 +1,1.36,1.43,1,, +2,1.31,1.38,,1.31,1.38 +3,1.46,1.38,3,1.46, +4,1.25,1.31,4,,1.31 +5,1.22,1.19,,1.22,1.19 +6,1.09,1.14,6,,1.14 +7,1.14,1.18,7,1.14, +8,1.16,1.11,,1.16,1.11 +9,1.14,1.07,9,,1.07 +10,1.18,1.17,10,1.18,1.17 +11,1.15,1.12,,1.15, +12,1.13,1.07,,, +13,1.14,1.11,13,1.14,1.11 +14,1.1,1.16,14,1.1,1.16 +15,1.12,1.16,15,1.12,1.16 diff --git a/tests/testthat/datasets/msaType1InstrumentCapability/msaType1.csv b/tests/testthat/datasets/msaType1InstrumentCapability/msaType1.csv new file mode 100644 index 00000000..f25b0297 --- /dev/null +++ b/tests/testthat/datasets/msaType1InstrumentCapability/msaType1.csv @@ -0,0 +1,51 @@ +Sample,dm,dmMissing1,dmMissing49,dmMissing25 +1,-4,-4,,-4 +2,-4.1,-4.1,,-4.1 +3,-4.1,-4.1,,-4.1 +4,-4.1,-4.1,,-4.1 +5,-4.1,-4.1,,-4.1 +6,-3.9,-3.9,,-3.9 +7,-3.9,-3.9,,-3.9 +8,-3.9,-3.9,,-3.9 +9,-4.1,-4.1,,-4.1 +10,-4.2,-4.2,,-4.2 +11,-3.9,,,-3.9 +12,-4.2,-4.2,,-4.2 +13,-4,-4,,-4 +14,-3.8,-3.8,,-3.8 +15,-3.9,-3.9,,-3.9 +16,-3.9,-3.9,,-3.9 +17,-3.9,-3.9,,-3.9 +18,-3.9,-3.9,,-3.9 +19,-4.6,-4.6,,-4.6 +20,-4.3,-4.3,,-4.3 +21,-3.9,-3.9,,-3.9 +22,-3.7,-3.7,,-3.7 +23,-3.7,-3.7,,-3.7 +24,-3.9,-3.9,,-3.9 +25,-4,-4,,-4 +26,-5,-5,, +27,-3.9,-3.9,, +28,-3.8,-3.8,, +29,-3.7,-3.7,, +30,-3.8,-3.8,, +31,-3.7,-3.7,, +32,-3.8,-3.8,, +33,-3.6,-3.6,, +34,-3.5,-3.5,, +35,-3.6,-3.6,, +36,-3.6,-3.6,, +37,-3.4,-3.4,, +38,-5.1,-5.1,, +39,-3.5,-3.5,, +40,-4,-4,, +41,-4.5,-4.5,, +42,-3.5,-3.5,, +43,-5.1,-5.1,, +44,-5,-5,, +45,-3.5,-3.5,, +46,-3.5,-3.5,, +47,-3.5,-3.5,, +48,-3.6,-3.6,, +49,-3.6,-3.6,, +50,-3.5,-3.5,-3.5, diff --git a/tests/testthat/msaGageRandr_long.csv b/tests/testthat/msaGageRandr_long.csv deleted file mode 100644 index 5dd74fdf..00000000 --- a/tests/testthat/msaGageRandr_long.csv +++ /dev/null @@ -1,91 +0,0 @@ -Run,Parts,Operators,Dm,,Gauge r&R (manual equipment),,, -7,1,Operator A,-0.5,,Schweinfurt / TWS Q1,,, -36,1,Operator A,-0.5,,Peter Saal,,, -70,1,Operator A,-0.5,,Gauge,S-441-0 / 17969,, -8,2,Operator A,-7,,Diameter (Dm),,, -37,2,Operator A,-6.5,,13-May-11,,, -69,2,Operator A,-6,,,,, -2,3,Operator A,-2,,Target = ,0,µm, -32,3,Operator A,-2,,USL = ,15,µm,Upper Specification Limit -65,3,Operator A,-1.5,,,,, -4,4,Operator A,-8,,Tolerance for Vd is 15 µm,,, -35,4,Operator A,-8,,,,, -63,4,Operator A,-7.5,,,,, -5,5,Operator A,-4,,,,, -33,5,Operator A,-4,,,,, -68,5,Operator A,-3.5,,,,, -10,6,Operator A,-2,,,,, -34,6,Operator A,-1,,,,, -66,6,Operator A,-2,,,,, -3,7,Operator A,-11,,,,, -31,7,Operator A,-11,,,,, -61,7,Operator A,-11,,,,, -1,8,Operator A,-6,,,,, -38,8,Operator A,-6,,,,, -67,8,Operator A,-6,,,,, -6,9,Operator A,-2,,,,, -39,9,Operator A,-2,,,,, -62,9,Operator A,-1,,,,, -9,10,Operator A,-6,,,,, -40,10,Operator A,-6,,,,, -64,10,Operator A,-6,,,,, -15,1,Operator B,-0.5,,,,, -45,1,Operator B,-0.5,,,,, -80,1,Operator B,-0.5,,,,, -20,2,Operator B,-6.5,,,,, -42,2,Operator B,-7,,,,, -73,2,Operator B,-6.5,,,,, -18,3,Operator B,-1,,,,, -44,3,Operator B,-1,,,,, -79,3,Operator B,-2,,,,, -12,4,Operator B,-7,,,,, -43,4,Operator B,-7.5,,,,, -78,4,Operator B,-7.5,,,,, -11,5,Operator B,-3.5,,,,, -49,5,Operator B,-3.5,,,,, -71,5,Operator B,-4,,,,, -16,6,Operator B,-1,,,,, -50,6,Operator B,-2,,,,, -72,6,Operator B,-2,,,,, -14,7,Operator B,-11,,,,, -46,7,Operator B,-11,,,,, -76,7,Operator B,-11,,,,, -17,8,Operator B,-6,,,,, -48,8,Operator B,-6,,,,, -77,8,Operator B,-6,,,,, -13,9,Operator B,-2,,,,, -41,9,Operator B,-2,,,,, -74,9,Operator B,-2,,,,, -19,10,Operator B,-6,,,,, -47,10,Operator B,-6,,,,, -75,10,Operator B,-6,,,,, -26,1,Operator C,-1,,,,, -53,1,Operator C,-0.5,,,,, -83,1,Operator C,-0.5,,,,, -21,2,Operator C,-6,,,,, -57,2,Operator C,-6,,,,, -88,2,Operator C,-6,,,,, -28,3,Operator C,-2,,,,, -54,3,Operator C,-2,,,,, -90,3,Operator C,-1,,,,, -22,4,Operator C,-7,,,,, -58,4,Operator C,-7,,,,, -85,4,Operator C,-7,,,,, -25,5,Operator C,-3,,,,, -56,5,Operator C,-4,,,,, -87,5,Operator C,-4,,,,, -27,6,Operator C,-1,,,,, -60,6,Operator C,-1,,,,, -81,6,Operator C,-1,,,,, -23,7,Operator C,-11,,,,, -51,7,Operator C,-10,,,,, -89,7,Operator C,-11,,,,, -29,8,Operator C,-6,,,,, -55,8,Operator C,-5,,,,, -86,8,Operator C,-5,,,,, -24,9,Operator C,-2,,,,, -52,9,Operator C,-1,,,,, -82,9,Operator C,-2,,,,, -30,10,Operator C,-6,,,,, -59,10,Operator C,-6,,,,, -84,10,Operator C,-6,,,,, diff --git a/tests/testthat/msaGageRandr_wide.csv b/tests/testthat/msaGageRandr_wide.csv deleted file mode 100644 index ea939d2f..00000000 --- a/tests/testthat/msaGageRandr_wide.csv +++ /dev/null @@ -1,31 +0,0 @@ -Operator,Part,Measurement1,Measurement2,Measurement3 -A,1,11.47508631,10.39458285,12.01885527 -B,1,10.36433412,10.18773633,10.44934243 -C,1,11.82882975,9.080170551,10.70349264 -A,2,5.932503725,8.166070237,8.379381474 -B,2,6.462534845,8.279574454,7.947087832 -C,2,8.128436252,7.587629062,9.470104531 -A,3,6.546149555,7.067798465,9.053303869 -B,3,7.277440823,6.786190061,9.609245246 -C,3,6.564494743,7.403837873,4.880407594 -A,4,10.80709996,7.871202933,8.848345562 -B,4,9.453631343,8.153288282,9.726037739 -C,4,9.400382161,8.339462717,8.760034996 -A,5,9.170567153,12.81936487,11.57257807 -B,5,11.22739331,10.14313235,10.90230764 -C,5,10.51837921,10.35792725,9.162059696 -A,6,8.302862749,8.549813051,9.401191612 -B,6,8.129536693,8.150409158,8.811062329 -C,6,8.394631887,8.682379386,8.715200975 -A,7,6.08942143,8.567477243,6.407021271 -B,7,7.822564943,5.685934567,7.363412846 -C,7,6.026057165,6.481758565,7.28120972 -A,8,5.960289779,5.113996382,7.008724901 -B,8,6.294267434,5.871694334,5.796146094 -C,8,6.672000388,5.905375186,6.730683818 -A,9,6.905913491,8.758733213,8.84172787 -B,9,7.981804441,7.924074953,9.232042804 -C,9,8.116895733,7.246734626,8.498385162 -A,10,5.197567991,5.304200443,6.082679479 -B,10,6.491304319,6.410390759,4.874269979 -C,10,5.209453338,5.744852215,4.818953594 diff --git a/tests/testthat/msaGaugeNN.csv b/tests/testthat/msaGaugeNN.csv deleted file mode 100644 index 16465a86..00000000 --- a/tests/testthat/msaGaugeNN.csv +++ /dev/null @@ -1,31 +0,0 @@ -"","Operator","Batch","Result","X","X.1" -"1","A",1,33.4,NA,"Nested Gauge r&R Study" -"2","A",1,33.2,NA,"Source: SPC for Excel" -"3","A",2,32.4,NA,"https://www.spcforexcel.com/knowledge/measurement-systems-analysis/destructive-gage-rr-analysis#results" -"4","A",2,31.7,NA,"" -"5","A",3,34.4,NA,"You are involved in heat treating of parts and want to perform a Gauge r&R analysis on the hardness tester." -"6","A",3,34.5,NA,"To measure hardness, a piece of the product is cut, prepared and tested." -"7","A",4,33.9,NA,"That piece is altered, so it cannot be retested.  The parts are produced in small batches." -"8","A",4,34.5,NA,"You are confident that the parts within a batch are homogeneous." -"9","A",5,34.5,NA,"You want to include three operators in the Gauge r&R study." -"10","A",5,34.7,NA,"You would like each operator to test two parts per batch." -"11","B",6,32.5,NA,"But there are not always enough parts for each operator to test parts from each batch." -"12","B",6,32.1,NA,"You will have to use a nested design.  You decide to use 15 batches and take 2 parts from each batch." -"13","B",7,32.1,NA,"Operator 1 will measure the two parts for batches 1 to 5;" -"14","B",7,32.3,NA,"operator 2 will measure 2 parts from batches 6 -10;  and" -"15","B",8,35.1,NA,"operator 3 will measure 2 parts from batches 11 - 15." -"16","B",8,34.7,NA,"The resulting from the Gauge r&R study are shown in the table." -"17","B",9,32.4,NA,"" -"18","B",9,33.1,NA,"" -"19","B",10,34.8,NA,"" -"20","B",10,34.9,NA,"Tolerance range: (38 – 30) = 8" -"21","C",11,32.6,NA,"" -"22","C",11,32.7,NA,"" -"23","C",12,32.3,NA,"" -"24","C",12,32.1,NA,"" -"25","C",13,34.9,NA,"" -"26","C",13,34.7,NA,"" -"27","C",14,33,NA,"" -"28","C",14,33.2,NA,"" -"29","C",15,31.6,NA,"" -"30","C",15,30.9,NA,"" diff --git a/tests/testthat/msaGaugeNNMising.csv b/tests/testthat/msaGaugeNNMising.csv deleted file mode 100644 index 0499b6c7..00000000 --- a/tests/testthat/msaGaugeNNMising.csv +++ /dev/null @@ -1,31 +0,0 @@ -V1,Operator,Batch,Result,X,X.1 -1,A,1,33.4,"",Nested Gauge r&R Study -2,A,1,33.2,"",Source: SPC for Excel -3,A,2,32.4,"",https://www.spcforexcel.com/knowledge/measurement-systems-analysis/destructive-gage-rr-analysis#results -4,A,2,31.7,"","" -5,A,3,34.4,"",You are involved in heat treating of parts and want to perform a Gauge r&R analysis on the hardness tester. -6,A,3,34.5,"","To measure hardness, a piece of the product is cut, prepared and tested." -7,A,4,33.9,"","That piece is altered, so it cannot be retested.  The parts are produced in small batches." -8,A,4,34.5,"",You are confident that the parts within a batch are homogeneous. -9,A,5,34.5,"",You want to include three operators in the Gauge r&R study. -10,A,5,34.7,"",You would like each operator to test two parts per batch. -11,B,6,32.5,"",But there are not always enough parts for each operator to test parts from each batch. -12,B,6,32.1,"",You will have to use a nested design.  You decide to use 15 batches and take 2 parts from each batch. -13,B,7,32.1,"",Operator 1 will measure the two parts for batches 1 to 5; -14,B,7,32.3,"",operator 2 will measure 2 parts from batches 6 -10;  and -15,B,8,35.1,"",operator 3 will measure 2 parts from batches 11 - 15. -16,B,8,34.7,"",The resulting from the Gauge r&R study are shown in the table. -17,B,9,32.4,"","" -18,B,9,33.1,"","" -19,B,10,34.8,"","" -20,B,10,34.9,"",Tolerance range: (38 – 30) = 8 -21,C,11,32.6,"","" -22,C,11,32.7,"","" -23,C,12,32.3,"","" -24,C,12,32.1,"","" -25,C,13,34.9,"","" -26,C,13,34.7,"","" -27,C,14,33,"","" -28,C,14,33.2,"","" -29,C,15,31.6,"","" -30,C,15,"","","" \ No newline at end of file diff --git a/tests/testthat/msaGaugeRR_Type3_Long.csv b/tests/testthat/msaGaugeRR_Type3_Long.csv deleted file mode 100644 index 25a7d0bf..00000000 --- a/tests/testthat/msaGaugeRR_Type3_Long.csv +++ /dev/null @@ -1,61 +0,0 @@ -Part,Appraiser,dm,Repeat,, -1,A,7.8,1,,Gauge r&R (automatic equipment) -1,A,9,2,,Steyr - ACBB -1,A,8.8,3,,Rudolf Peterseil -2,A,7,1,,Gauge name: MIB 110EA -2,A,8.3,2,,Diameter (dm) -2,A,7.8,3,,22-Aug-11 -3,A,8.8,1,, -3,A,8.9,2,,Target = 0 µm -3,A,9,3,,Upper specification limit = 12 µm -4,A,8.7,1,,Lower specification limit = 0 µm -4,A,8.5,2,, -4,A,8.5,3,,Tolerance for dm is 12 µm -5,A,5.4,1,, -5,A,5.3,2,, -5,A,5.4,3,, -6,A,6.9,1,, -6,A,7.2,2,, -6,A,7.1,3,, -7,A,6.8,1,, -7,A,6.9,2,, -7,A,6.9,3,, -8,A,7.3,1,, -8,A,8,2,, -8,A,7.7,3,, -9,A,7.5,1,, -9,A,7.8,2,, -9,A,7.6,3,, -10,A,4.2,1,, -10,A,4.3,2,, -10,A,3.9,3,, -11,A,8,1,, -11,A,7.1,2,, -11,A,6.8,3,, -12,A,6.5,1,, -12,A,6.3,2,, -12,A,5.9,3,, -13,A,7,1,, -13,A,6.9,2,, -13,A,6.9,3,, -14,A,7.2,1,, -14,A,8.1,2,, -14,A,6.6,3,, -15,A,8,1,, -15,A,7.3,2,, -15,A,8,3,, -16,A,8.4,1,, -16,A,7.7,2,, -16,A,7.9,3,, -17,A,13.1,1,, -17,A,13,2,, -17,A,13.3,3,, -18,A,11.1,1,, -18,A,9.9,2,, -18,A,9.8,3,, -19,A,11,1,, -19,A,10.5,2,, -19,A,11.3,3,, -20,A,7.6,1,, -20,A,6.7,2,, -20,A,6.4,3,, diff --git a/tests/testthat/msaGaugeRR_Type3_Wide.csv b/tests/testthat/msaGaugeRR_Type3_Wide.csv deleted file mode 100644 index dc209aef..00000000 --- a/tests/testthat/msaGaugeRR_Type3_Wide.csv +++ /dev/null @@ -1,21 +0,0 @@ -"","Part","Repeat.1","Repeat.2","Repeat.3","Machine","X","X.1" -"1",1,7.8,9,8.8,1,NA,"Gauge r&R (automatic equipment)" -"2",2,7,8.3,7.8,1,NA,"Steyr - ACBB" -"3",3,8.8,8.9,9,1,NA,"Rudolf Peterseil" -"4",4,8.7,8.5,8.5,1,NA,"Gauge" -"5",5,5.4,5.3,5.4,1,NA,"Diameter (dm)" -"6",6,6.9,7.2,7.1,1,NA,"22-Aug-11" -"7",7,6.8,6.9,6.9,1,NA,"" -"8",8,7.3,8,7.7,1,NA,"Target = 0 µm" -"9",9,7.5,7.8,7.6,1,NA,"Upper Specification Limit = 12 µm" -"10",10,4.2,4.3,3.9,1,NA,"" -"11",11,8,7.1,6.8,1,NA,"Tolerance for dm is 12 µm" -"12",12,6.5,6.3,5.9,1,NA,"" -"13",13,7,6.9,6.9,1,NA,"" -"14",14,7.2,8.1,6.6,1,NA,"" -"15",15,8,7.3,8,1,NA,"" -"16",16,8.4,7.7,7.9,1,NA,"" -"17",17,13.1,13,13.3,1,NA,"" -"18",18,11.1,9.9,9.8,1,NA,"" -"19",19,11,10.5,11.3,1,NA,"" -"20",20,7.6,6.7,6.4,1,NA,"" diff --git a/tests/testthat/msaLinearity.csv b/tests/testthat/msaLinearity.csv deleted file mode 100644 index a513c434..00000000 --- a/tests/testthat/msaLinearity.csv +++ /dev/null @@ -1,61 +0,0 @@ -"","Part","Reference","Measurement" -"1",1,2,2.7 -"2",1,2,2.5 -"3",1,2,2.4 -"4",1,2,2.5 -"5",1,2,2.7 -"6",1,2,2.3 -"7",1,2,2.5 -"8",1,2,2.5 -"9",1,2,2.4 -"10",1,2,2.4 -"11",1,2,2.6 -"12",1,2,2.4 -"13",2,4,5.1 -"14",2,4,3.9 -"15",2,4,4.2 -"16",2,4,5 -"17",2,4,3.8 -"18",2,4,3.9 -"19",2,4,3.9 -"20",2,4,3.9 -"21",2,4,3.9 -"22",2,4,4 -"23",2,4,4.1 -"24",2,4,3.8 -"25",3,6,5.8 -"26",3,6,5.7 -"27",3,6,5.9 -"28",3,6,5.9 -"29",3,6,6 -"30",3,6,6.1 -"31",3,6,6 -"32",3,6,6.1 -"33",3,6,6.4 -"34",3,6,6.3 -"35",3,6,6 -"36",3,6,6.1 -"37",4,8,7.6 -"38",4,8,7.7 -"39",4,8,7.8 -"40",4,8,7.7 -"41",4,8,7.8 -"42",4,8,7.8 -"43",4,8,7.8 -"44",4,8,7.7 -"45",4,8,7.8 -"46",4,8,7.5 -"47",4,8,7.6 -"48",4,8,7.7 -"49",5,10,9.1 -"50",5,10,9.3 -"51",5,10,9.5 -"52",5,10,9.3 -"53",5,10,9.4 -"54",5,10,9.5 -"55",5,10,9.5 -"56",5,10,9.5 -"57",5,10,9.6 -"58",5,10,9.2 -"59",5,10,9.3 -"60",5,10,9.4 diff --git a/tests/testthat/msaTau.csv b/tests/testthat/msaTau.csv deleted file mode 100644 index 69b38380..00000000 --- a/tests/testthat/msaTau.csv +++ /dev/null @@ -1,121 +0,0 @@ -Sample,Agreed,Operator,Rating -1,5,A,5 -2,5,A,5 -3,5,A,5 -4,0,A,0 -5,0,A,0 -6,4,A,5 -7,0,A,0 -8,0,A,0 -9,0,A,0 -10,4,A,0 -11,0,A,0 -12,4,A,4 -13,5,A,5 -14,4,A,4 -15,4,A,3 -16,0,A,0 -17,4,A,0 -18,3,A,5 -19,0,A,0 -20,0,A,0 -21,3,A,0 -22,4,A,4 -23,3,A,0 -24,0,A,0 -25,0,A,0 -26,5,A,6 -27,5,A,6 -28,0,A,0 -29,0,A,0 -30,0,A,0 -1,5,B,4 -2,5,B,5 -3,5,B,5 -4,0,B,0 -5,0,B,0 -6,4,B,3 -7,0,B,0 -8,0,B,0 -9,0,B,0 -10,4,B,4 -11,0,B,0 -12,4,B,0 -13,5,B,4 -14,4,B,4 -15,4,B,4 -16,0,B,0 -17,4,B,4 -18,3,B,0 -19,0,B,0 -20,0,B,0 -21,3,B,4 -22,4,B,4 -23,3,B,4 -24,0,B,0 -25,0,B,0 -26,5,B,4 -27,5,B,4 -28,0,B,0 -29,0,B,0 -30,0,B,0 -1,5,C,6 -2,5,C,5 -3,5,C,4 -4,0,C,0 -5,0,C,0 -6,4,C,4 -7,0,C,0 -8,0,C,0 -9,0,C,0 -10,4,C,0 -11,0,C,4 -12,4,C,0 -13,5,C,5 -14,4,C,4 -15,4,C,4 -16,0,C,0 -17,4,C,4 -18,3,C,5 -19,0,C,0 -20,0,C,6 -21,3,C,4 -22,4,C,4 -23,3,C,3 -24,0,C,0 -25,0,C,0 -26,5,C,5 -27,5,C,6 -28,0,C,0 -29,0,C,5 -30,0,C,0 -1,5,D,4 -2,5,D,5 -3,5,D,4 -4,0,D,0 -5,0,D,0 -6,4,D,4 -7,0,D,0 -8,0,D,0 -9,0,D,0 -10,4,D,0 -11,0,D,0 -12,4,D,4 -13,5,D,5 -14,4,D,0 -15,4,D,4 -16,0,D,0 -17,4,D,0 -18,3,D,0 -19,0,D,0 -20,0,D,0 -21,3,D,0 -22,4,D,4 -23,3,D,0 -24,0,D,0 -25,0,D,0 -26,5,D,4 -27,5,D,4 -28,0,D,0 -29,0,D,0 -30,0,D,0 diff --git a/tests/testthat/msaTestRetest.csv b/tests/testthat/msaTestRetest.csv deleted file mode 100644 index 0cc14c96..00000000 --- a/tests/testthat/msaTestRetest.csv +++ /dev/null @@ -1,16 +0,0 @@ -"","Part","X1","X2","Range","X","X.1" -"1",1,1.36,1.43,0.07,NA,"Repeated measurement study" -"2",2,1.31,1.38,0.07,NA,"Measure the same sample twice with the same evaluation method by the same appraiser (use minimum 10 parts, preferred 30)" -"3",3,1.46,1.38,0.08,NA,"" -"4",4,1.25,1.31,0.06,NA,"Specification: +/- 1 mm" -"5",5,1.22,1.19,0.03,NA,"" -"6",6,1.09,1.14,0.05,NA,"Average (X1) = 1.197" -"7",7,1.14,1.18,0.04,NA,"St.Dev. (X1) = 0.1058" -"8",8,1.16,1.11,0.05,NA,"" -"9",9,1.14,1.07,0.07,NA,"Average (X2) = 1.199" -"10",10,1.18,1.17,0.01,NA,"St.Dev. (X2) = 0.1178" -"11",11,1.15,1.12,0.03,NA,"" -"12",12,1.13,1.07,0.06,NA,"Average (R) = 0.05" -"13",13,1.14,1.11,0.03,NA,"sgauge = 0.044" -"14",14,1.1,1.16,0.06,NA,"" -"15",15,1.12,1.16,0.04,NA,"d2 (n=2) = 1.128" diff --git a/tests/testthat/msaType1.csv b/tests/testthat/msaType1.csv deleted file mode 100644 index 6268621f..00000000 --- a/tests/testthat/msaType1.csv +++ /dev/null @@ -1,51 +0,0 @@ -Sample,dm,, -1,-4,,Type 1 Study -2,-4.1,,Schweinfurt -3,-4.1,,Peter Saal -4,-4.1,,Gauge: S-441-0 -5,-4.1,,Lehring 45.256 -6,-3.9,,13-Nov-10 -7,-3.9,, -8,-3.9,,Reference = -4.0 µm -9,-4.1,,Resolution = 0.1 µm -10,-4.2,, -11,-3.9,,Tolerance for dm is 15 µm -12,-4.2,, -13,-4,, -14,-3.8,, -15,-3.9,, -16,-3.9,, -17,-3.9,, -18,-3.9,, -19,-4.6,, -20,-4.3,, -21,-3.9,, -22,-3.7,, -23,-3.7,, -24,-3.9,, -25,-4,, -26,-5,, -27,-3.9,, -28,-3.8,, -29,-3.7,, -30,-3.8,, -31,-3.7,, -32,-3.8,, -33,-3.6,, -34,-3.5,, -35,-3.6,, -36,-3.6,, -37,-3.4,, -38,-5.1,, -39,-3.5,, -40,-4,, -41,-4.5,, -42,-3.5,, -43,-5.1,, -44,-5,, -45,-3.5,, -46,-3.5,, -47,-3.5,, -48,-3.6,, -49,-3.6,, -50,-3.5,, diff --git a/tests/testthat/test-msaAttribute.R b/tests/testthat/test-msaAttribute.R index d7ef6ae6..41d25d3d 100644 --- a/tests/testthat/test-msaAttribute.R +++ b/tests/testthat/test-msaAttribute.R @@ -1,4 +1,9 @@ context("Attribute Agreement Analysis") +.numDecimals <- 2 + +# Long format #### + +## AAA and Fleiss' Kappa #### options <- analysisOptions("msaAttribute") options$dataFormat <- "longFormat" @@ -9,70 +14,70 @@ options$standardLongFormat <- "Reference" options$cohensKappa <- TRUE options$fleissKappa <- TRUE options$positiveReference <- "Yes" -results <- runAnalysis("msaAttribute", "AAALong.csv", options) +results <- runAnalysis("msaAttribute", "datasets/msaAttributeAgreement/msaAttributeKappa_long.csv", options) -test_that("All Appraisers vs Standard table results match", { +test_that("LF1.1 AAA and Fleiss - All Appraisers vs Standard table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_AllVsStandard"]][["data"]] jaspTools::expect_equal_tables(table, list(21.267, 73.414, 15, 7, 46.67)) }) -test_that("Between Appraisers table results match", { +test_that("LF1.2 AAA and Fleiss - Between Appraisers table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_Between"]][["data"]] jaspTools::expect_equal_tables(table, list(32.287, 83.664, 15, 9, 60)) }) -test_that("Each Appraiser vs Standard table results match", { +test_that("LF1.3 AAA and Fleiss - Each Appraiser vs Standard table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_EachVsStandard"]][["data"]] jaspTools::expect_equal_tables(table, list("BL", 44.9, 92.213, 15, 11, 73.33, "EG", 51.911, 95.669, 15, 12, 80, "MH", 32.287, 83.664, 15, 9, 60)) }) -test_that("Each Appraiser vs Standard plot matches", { +test_that("LF1.4 AAA and Fleiss - Each Appraiser vs Standard plot matches", { plotName <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_PlotVs"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "each-appraiser-vs-standard") + jaspTools::expect_equal_plots(testPlot, "LF1_each-appraiser-vs-standard") }) -test_that("Within Appraisers plot matches", { +test_that("LF1.5 AAA and Fleiss - Within Appraisers plot matches", { plotName <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_PlotWithin"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "within-appraisers") + jaspTools::expect_equal_plots(testPlot, "LF1_within-appraisers") }) -test_that("Study effectiveness summary table results match", { +test_that("LF1.6 AAA and Fleiss - Study effectiveness summary table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_StudyEffectiveness"]][["data"]] jaspTools::expect_equal_tables(table, - list("BL", "73.33 (Unacceptable)", "26.67 (Unacceptable)", "20 (Unacceptable)", - "EG", "80 (Marginally acceptable)", "16.67 (Unacceptable)", - "20 (Unacceptable)", "MH", "60 (Unacceptable)", "10 (Marginally acceptable)", - "66.67 (Unacceptable)")) + list("BL", "73.33 (unacceptable)", "26.67 (unacceptable)", "20 (unacceptable)", + "EG", "80 (marginally acceptable)", "16.67 (unacceptable)", + "20 (unacceptable)", "MH", "60 (unacceptable)", "10 (marginally acceptable)", + "66.67 (unacceptable)")) }) -test_that("Within Appraisers table results match", { +test_that("LF1.7 AAA and Fleiss - Within Appraisers table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_Within"]][["data"]] jaspTools::expect_equal_tables(table, list("BL", 68.052, 99.831, 15, 14, 93.33, "EG", 68.052, 99.831, 15, 14, 93.33, "MH", 51.911, 95.669, 15, 12, 80)) }) -test_that("Cohen's Kappa for Appraiser vs Standard table results match", { +test_that("LF1.8 AAA and Fleiss - Cohen's Kappa for Appraiser vs Standard table results match", { table <- results[["results"]][["cohensKappa"]][["data"]] jaspTools::expect_equal_tables(table, list("BL", 0.492307692307692, "EG", 0.612903225806452, "MH", 0.264150943396226, "All", 0.466666666666667)) }) -test_that("Cohen's Kappa correlations summary table results match", { +test_that("LF1.9 AAA and Fleiss - Cohen's Kappa correlations summary table results match", { table <- results[["results"]][["cohensKappaCor"]][["data"]] jaspTools::expect_equal_tables(table, list("-", 0.87, 0.52, "BL", 0.87, "-", 0.6, "EG", 0.52, 0.6, "-", "MH" )) }) -test_that("Fleiss' Kappa table results match", { +test_that("LF1.10 AAA and Fleiss - Fleiss' Kappa table results match", { table <- results[["results"]][["fleissKappa"]][["data"]] jaspTools::expect_equal_tables(table, list("BL", "", 0.48608895977317, 0.91, "EG", "", 0.612918660287081, @@ -80,129 +85,132 @@ test_that("Fleiss' Kappa table results match", { "All", 0.641666666666666, 0.439719816302578)) }) -# Wide -options$dataFormat <- "wideFormat" -options$operatorWideFormat <- "Operator" -options$partWideFormat <- "Part" -options$measurementsWideFormat <- c("Repeat.1", "Repeat.2", "Repeat.3") -options$standardWideFormat <- "Reference" -results <- runAnalysis("msaAttribute", "AAARow.csv", options) +## Kendall's Tau #### +options <- analysisOptions("msaAttribute") +options$dataFormat <- "longFormat" +options$operatorLongFormat <- "Operator" +options$partLongFormat <- "Sample" +options$measurementLongFormat <- c("Rating") +options$standardLongFormat <- "Agreed" +options$fleissKappa <- TRUE +options$cohensKappa <- TRUE +options$positiveReference <- "" +options$kendallsTau <- TRUE +results <- runAnalysis("msaAttribute", "datasets/msaAttributeAgreement/msaAttributeTau_long.csv", options, makeTests = T) -test_that("All Appraisers vs Standard table results match", { +test_that("LF2.1 Kendall Tau - All appraisers vs standard table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_AllVsStandard"]][["data"]] jaspTools::expect_equal_tables(table, - list(21.267, 73.414, 15, 7, 46.67)) + list(25.461, 62.573, 30, 13, 43.33)) }) -test_that("Between Appraisers table results match", { +test_that("LF2.2 Kendall Tau - Between appraisers table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_Between"]][["data"]] jaspTools::expect_equal_tables(table, - list(32.287, 83.664, 15, 9, 60)) + list(25.461, 62.573, 30, 13, 43.33)) }) -test_that("Each Appraiser vs Standard table results match", { +test_that("LF2.3 Kendall Tau - Each appraiser vs standard table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_EachVsStandard"]][["data"]] jaspTools::expect_equal_tables(table, - list("EG", 51.911, 95.669, 15, 12, 80, "BL", 44.9, 92.213, 15, 11, - 73.33, "MH", 32.287, 83.664, 15, 9, 60)) + list("A", 50.604, 85.265, 30, 21, 70, "B", 50.604, 85.265, 30, 21, + 70, "C", 47.188, 82.713, 30, 20, 66.67, "D", 47.188, 82.713, + 30, 20, 66.67)) }) -test_that("Each Appraiser vs Standard plot matches", { +test_that("LF2.4 Kendall Tau - Each Appraiser vs Standard plot matches", { plotName <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_PlotVs"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "each-appraiser-vs-standard2") -}) - -test_that("Within Appraisers plot matches", { - plotName <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_PlotWithin"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "within-appraisers2") + jaspTools::expect_equal_plots(testPlot, "LF2_each-appraiser-vs-standard") }) -test_that("Study effectiveness summary table results match", { - table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_StudyEffectiveness"]][["data"]] - jaspTools::expect_equal_tables(table, - list("EG", "80 (Marginally acceptable)", "16.67 (Unacceptable)", "20 (Unacceptable)", - "BL", "73.33 (Unacceptable)", "26.67 (Unacceptable)", "20 (Unacceptable)", - "MH", "60 (Unacceptable)", "10 (Marginally acceptable)", "66.67 (Unacceptable)" - )) -}) - -test_that("Within Appraisers table results match", { - table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_Within"]][["data"]] +test_that("LF2.5 Kendall Tau - Kendall's tau table results match", { + table <- results[["results"]][["KendallTau"]][["data"]] jaspTools::expect_equal_tables(table, - list("EG", 68.052, 99.831, 15, 14, 93.33, "BL", 68.052, 99.831, 15, - 14, 93.33, "MH", 51.911, 95.669, 15, 12, 80)) + list(1, 0.790897539450037, 0.544077276765283, 0.603570260407359, 0.784579319887982, + "A", 0.544077276765283, 0.818329173912156, 1, 0.485871445981783, + 0.604587661572944, "B", 0.603570260407359, 0.573358877643966, + 0.485871445981783, 1, 0.474625719247113, "C", 0.784579319887982, + 0.763623484279901, 0.604587661572944, 0.474625719247113, 1, + "D")) }) -test_that("Cohen's Kappa for Appraiser vs Standard table results match", { +test_that("LF2.6 Kendall Tau - Cohen's kappa for appraiser vs standard table results match", { table <- results[["results"]][["cohensKappa"]][["data"]] jaspTools::expect_equal_tables(table, - list("EG", 0.612903225806452, "BL", 0.492307692307692, "MH", 0.264150943396226, - "All", 0.466666666666667)) + list("A", 0.540816326530612, "B", 0.537671232876712, "C", 0.523052464228935, + "D", 0.456521739130435, "All", 0.515512112197195)) }) -test_that("Cohen's Kappa correlations summary table results match", { +test_that("LF2.7 Kendall Tau - Cohen's kappa correlations summary table results match", { table <- results[["results"]][["cohensKappaCor"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.87, "-", 0.6, "EG", "-", 0.87, 0.52, "BL", 0.52, 0.6, "-", "MH" - )) + list("-", 0.6, 0.63, 0.86, "A", 0.6, "-", 0.61, 0.63, "B", 0.63, 0.61, + "-", 0.52, "C", 0.86, 0.63, 0.52, "-", "D")) }) -test_that("Fleiss' Kappa table results match", { +test_that("LF2.8 Kendall Tau - Fleiss' kappa table results match", { table <- results[["results"]][["fleissKappa"]][["data"]] jaspTools::expect_equal_tables(table, - list("EG", "", 0.612918660287081, 0.905462184873949, "BL", "", 0.48608895977317, - 0.91, "MH", "", 0.220151828847481, 0.543918918918919, "All", - 0.641666666666666, 0.439719816302578)) + list("A", "", 0.532871972318339, "NaN", "B", "", 0.529616724738676, + "NaN", "C", "", 0.52, "NaN", "D", "", 0.440820130475303, "NaN", + "All", 0.405850091407678, 0.505827206883079)) }) -# Tau -options$dataFormat <- "longFormat" -options$operatorLongFormat <- "Operator" -options$partLongFormat <- "Sample" -options$measurementLongFormat <- c("Rating") -options$standardLongFormat <- "Agreed" -options$fleissKappa <- FALSE -options$cohensKappa <- FALSE -options$positiveReference <- "" -options$kendallsTau <- TRUE -results <- runAnalysis("msaAttribute", "msaTau.csv", options) +# Wide Format #### + +## AAA and Fleiss' Kappa #### +options <- analysisOptions("msaAttribute") +options$dataFormat <- "wideFormat" +options$operatorWideFormat <- "Operator" +options$partWideFormat <- "Part" +options$measurementsWideFormat <- c("Repeat.1", "Repeat.2", "Repeat.3") +options$standardWideFormat <- "Reference" +options$fleissKappa <- TRUE +results <- runAnalysis("msaAttribute", "datasets/msaAttributeAgreement/msaAttributeKappa_wide.csv", options) -test_that("All Appraisers vs Standard table results match", { +test_that("WF1.1 AAA and Fleiss - All appraisers vs standard table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_AllVsStandard"]][["data"]] jaspTools::expect_equal_tables(table, - list(25.461, 62.573, 30, 13, 43.33)) + list(21.267, 73.414, 15, 7, 46.67)) }) -test_that("Between Appraisers table results match", { +test_that("WF1.2 AAA and Fleiss - Between appraisers table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_Between"]][["data"]] jaspTools::expect_equal_tables(table, - list(25.461, 62.573, 30, 13, 43.33)) + list(32.287, 83.664, 15, 9, 60)) }) -test_that("Each Appraiser vs Standard table results match", { +test_that("WF1.3 AAA and Fleiss - Each appraiser vs standard table results match", { table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_EachVsStandard"]][["data"]] jaspTools::expect_equal_tables(table, - list("A", 50.604, 85.265, 30, 21, 70, "B", 50.604, 85.265, 30, 21, - 70, "C", 47.188, 82.713, 30, 20, 66.67, "D", 47.188, 82.713, - 30, 20, 66.67)) + list("EG", 51.911, 95.669, 15, 12, 80, "BL", 44.9, 92.213, 15, 11, + 73.33, "MH", 32.287, 83.664, 15, 9, 60)) }) -test_that("Each Appraiser vs Standard plot matches", { +test_that("WF1.4 AAA and Fleiss - Each Appraiser vs Standard plot matches", { plotName <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_PlotVs"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "each-appraiser-vs-standard3") + jaspTools::expect_equal_plots(testPlot, "WF1_each-appraiser-vs-standard") }) -test_that("Kendall's Tau table results match", { - table <- results[["results"]][["KendallTau"]][["data"]] +test_that("WF1.5 AAA and Fleiss - Within Appraisers plot matches", { + plotName <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_PlotWithin"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_within-appraisers") +}) + +test_that("WF1.6 AAA and Fleiss - Within appraisers table results match", { + table <- results[["results"]][["AAAtableGraphs"]][["collection"]][["AAAtableGraphs_Within"]][["data"]] jaspTools::expect_equal_tables(table, - list(1, 0.790897539450037, 0.544077276765283, 0.603570260407359, 0.784579319887982, - "A", 0.544077276765283, 0.818329173912156, 1, 0.485871445981783, - 0.604587661572944, "B", 0.603570260407359, 0.573358877643966, - 0.485871445981783, 1, 0.474625719247113, "C", 0.784579319887982, - 0.763623484279901, 0.604587661572944, 0.474625719247113, 1, - "D")) + list("EG", 68.052, 99.831, 15, 14, 93.33, "BL", 68.052, 99.831, 15, + 14, 93.33, "MH", 51.911, 95.669, 15, 12, 80)) }) +test_that("WF1.7 AAA and Fleiss - Fleiss' kappa table results match", { + table <- results[["results"]][["fleissKappa"]][["data"]] + jaspTools::expect_equal_tables(table, + list("EG", "", 0.612918660287081, 0.905462184873949, "BL", "", 0.48608895977317, + 0.91, "MH", "", 0.220151828847481, 0.543918918918919, "All", + 0.641666666666666, 0.439719816302578)) +}) diff --git a/tests/testthat/test-msaGaugeLinearity.R b/tests/testthat/test-msaGaugeLinearity.R index 748d05dd..dad20089 100644 --- a/tests/testthat/test-msaGaugeLinearity.R +++ b/tests/testthat/test-msaGaugeLinearity.R @@ -1,45 +1,116 @@ -context("[Quality Control] MSA Gauge Linearity") +context("[Quality Control] MSA - Gauge Linearity") +.numDecimals <- 2 +set.seed(1) + +# Basic test #### options <- analysisOptions("msaGaugeLinearity") options$part <- "Part" options$measurement <- "Measurement" options$standard <- "Reference" +options$manualProcessVariation <- TRUE +options$manualProcessVariationValue <- 1 set.seed(1) -results <- runAnalysis("msaGaugeLinearity", "msaLinearity.csv", options) +results <- runAnalysis("msaGaugeLinearity", "datasets/msaLinearityStudy/msaLinearity.csv", options) + -test_that("Bias and Linearity plot matches", { +test_that("1.1 Basic test - Bias and linearity plot matches", { plotName <- results[["results"]][["LB"]][["collection"]][["LB_plot1"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "bias-and-linearity") + jaspTools::expect_equal_plots(testPlot, "1_bias-and-linearity") }) -test_that("Percentage Process Variation Graph plot matches", { +test_that("1.2 Basic test - Percentage process variation graph plot matches", { plotName <- results[["results"]][["LB"]][["collection"]][["LB_plot2"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "percentage-process-variation-graph") + jaspTools::expect_equal_plots(testPlot, "1_percentage-process-variation-graph") }) -test_that("Gauge Bias table results match", { +test_that("1.3 Basic test - Gauge bias table results match", { table <- results[["results"]][["LB"]][["collection"]][["LB_table1"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.491666666666667, 2.49166666666667, 1, 2.87233310444284e-08, - 2, 0.125, 4.125, 2, 0.353991325267683, 4, 0.0250000000000004, - 6.025, 3, 0.667130710762814, 6, -0.291666666666667, 7.70833333333333, - 4, 6.41948050554358e-07, 8, -0.616666666666667, 9.38333333333333, - 5, 1.55444480038029e-08, 10, -0.0533333333333334, "Average", + list(0.491666666666667, 2.49166666666667, 1, 49.1666666666667, 2.87233310444284e-08, + 2, 0.125, 4.125, 2, 12.5, 0.353991325267683, 4, 0.0250000000000004, + 6.025, 3, 2.50000000000004, 0.667130710762814, 6, -0.291666666666667, + 7.70833333333333, 4, 29.1666666666667, 6.41948050554358e-07, + 8, -0.616666666666667, 9.38333333333333, 5, 61.6666666666667, + 1.55444480038029e-08, 10, -0.0533333333333334, "Total", 5.33333333333334, 0.356307101472113)) }) -test_that("Regression Model table results match", { +test_that("1.4 Basic test - Regression model table results match", { table <- results[["results"]][["LB"]][["collection"]][["LB_table2"]][["data"]] jaspTools::expect_equal_tables(table, list(0.0725242725916125, 10.1575188601321, 0.736666666666666, "Intercept", - 1.73379959546223e-14, 0.0109334454718107, -12.0425594114992, - -0.131666666666667, "Slope", 2.03771558228568e-17)) + 1.73379959546227e-14, 0.0109334454718107, -12.0425594114992, + -0.131666666666667, "Slope", 2.03771558228573e-17)) +}) + +test_that("1.5 Basic test - Gauge linearity table results match", { + table <- results[["results"]][["LB"]][["collection"]][["LB_table3"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.239539788646537, 0.131666666666667, 13.1666666666667, 0.714318415932242 + )) +}) + +test_that("1.6 Basic test - Regression equation table results match", { + table <- results[["results"]][["LB"]][["collection"]][["LB_tableEquation"]][["data"]] + jaspTools::expect_equal_tables(table, + list("Bias = 0.74 - 0.13 * Reference value")) +}) + +# Missing values test #### + +options <- analysisOptions("msaGaugeLinearity") +options$part <- "PartMissing5" +options$measurement <- "MeasurementMissing5" +options$standard <- "ReferenceMissing5" +options$manualProcessVariation <- TRUE +options$manualProcessVariationValue <- 1 +set.seed(1) +results <- runAnalysis("msaGaugeLinearity", "datasets/msaLinearityStudy/msaLinearity.csv", options) + + +test_that("2.1 Missing values test - Bias and linearity plot matches", { + plotName <- results[["results"]][["LB"]][["collection"]][["LB_plot1"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_bias-and-linearity") }) -test_that("Gauge Linearity table results match", { +test_that("2.2 Missing values test - Percentage process variation graph plot matches", { + plotName <- results[["results"]][["LB"]][["collection"]][["LB_plot2"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_percentage-process-variation-graph") +}) + +test_that("2.3 Missing values test - Gauge bias table results match", { + table <- results[["results"]][["LB"]][["collection"]][["LB_table1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.475, 2.475, 1, 47.5, 4.1784708324642e-05, 2, 0.225, 4.225, 2, + 22.5, 0.267640820562279, 4, -0.0222222222222221, 5.97777777777778, + 3, 2.22222222222221, 0.71883629907514, 6, -0.281818181818182, + 7.71818181818182, 4, 28.1818181818182, 2.48662323102535e-06, + 8, -0.6, 9.4, 5, 60, 4.65540714815082e-07, 10, -0.0408080808080808, + "Total", 4.08080808080808, 0.230205182734234)) +}) + +test_that("2.4 Missing values test - Regression model table results match", { + table <- results[["results"]][["LB"]][["collection"]][["LB_table2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.0897638791625512, 8.45044628565873, 0.7585448392555, "Intercept", + 9.18217700323426e-11, 0.0130153805110511, -10.2247895183502, + -0.133079526226734, "Slope", 3.35065357366737e-13)) +}) + +test_that("2.5 Missing values test - Gauge linearity table results match", { table <- results[["results"]][["LB"]][["collection"]][["LB_table3"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.239539788646537, 13.1666666666667, 0.714318415932242)) + list(0.246859991507049, 0.133079526226734, 13.3079526226734, 0.703796096771246 + )) +}) + +test_that("2.6 Missing values test - Regression equation table results match", { + table <- results[["results"]][["LB"]][["collection"]][["LB_tableEquation"]][["data"]] + jaspTools::expect_equal_tables(table, + list("Bias = 0.76 - 0.13 * Reference value")) }) diff --git a/tests/testthat/test-msaGaugeRR.R b/tests/testthat/test-msaGaugeRR.R index b6133040..a3f80189 100644 --- a/tests/testthat/test-msaGaugeRR.R +++ b/tests/testthat/test-msaGaugeRR.R @@ -1,13 +1,15 @@ context("[Quality Control] Gauge r&R") .numDecimals <- 2 -# Long format +# Long format #### + +## Default settings #### options <- analysisOptions("msaGaugeRR") options$operatorLongFormat <- "Operators" options$partLongFormat <- "Parts" options$measurementLongFormat <- "Dm" options$tolerance <- TRUE -options$toleranceValue <- 15 +options$toleranceValue <- 10 options$rChart <- TRUE options$xBarChart <- TRUE options$scatterPlot <- TRUE @@ -18,94 +20,240 @@ options$partMeasurementPlotAllValues <- TRUE options$operatorMeasurementPlot <- TRUE options$partByOperatorMeasurementPlot <- TRUE options$trafficLightChart <- TRUE +options$anovaModelType <- "randomEffect" set.seed(1) -results <- runAnalysis("msaGaugeRR", "msaGageRandr_long.csv", options) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options) -test_that("Variance Components table results match", { +test_that("LF1.1 Default settings - Variance components table results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable1"]][["data"]] jaspTools::expect_equal_tables(table, - list(1.43, "Total Gauge r&R", 0.157929724596391, 1.22, "Repeatability", + list(1.43, "Total gauge r&R", 0.157929724596391, 1.22, "Repeatability", 0.134544159544159, 0.21, "Reproducibility", 0.0233855650522318, - 0.21, "Operators", 0.0233855650522318, 98.57, "Part-to-Part", - 10.8561068903661, 100, "Total Variation", 11.0140366149625 + 0.21, "Operators", 0.0233855650522318, 98.57, "Part-to-part", + 10.8561068903661, 100, "Total variation", 11.0140366149625 )) }) -test_that("Gauge Evaluation table results match", { +test_that("LF1.2 Default settings - Gauge evaluation table results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable2"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.397403729972922, 11.97, 15.9, "Total Gauge r&R", 2.38442237983753, - 0.36680261659939, 11.05, 14.67, "Repeatability", 2.20081569959634, - 0.15292339602635, 4.61, 6.12, "Reproducibility", 0.917540376158099, - 0.15292339602635, 4.61, 6.12, "Operators", 0.917540376158099, - 3.29486067844547, 99.28, 131.79, "Part-to-Part", 19.7691640706728, - 3.31874021504585, 100, 132.75, "Total Variation", 19.9124412902751 + list(0.397403729972922, 11.97, 23.84, "Total gauge r&R", 2.38442237983753, + 0.36680261659939, 11.05, 22.01, "Repeatability", 2.20081569959634, + 0.15292339602635, 4.61, 9.18, "Reproducibility", 0.917540376158099, + 0.15292339602635, 4.61, 9.18, "Operators", 0.917540376158099, + 3.29486067844547, 99.28, 197.69, "Part-to-part", 19.7691640706728, + 3.31874021504584, 100, 199.12, "Total variation", 19.9124412902751 )) }) -test_that("Components of Variation plot matches", { +test_that("LF1.3 Default settings - Components of variation plot matches", { plotName <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_VarCompGraph"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "components-of-variation") + jaspTools::expect_equal_plots(testPlot, "1_components-of-variation") }) -test_that("Two-way ANOVA Table with Interaction results match", { +test_that("LF1.4 Default settings - Two-way ANOVA table with interaction results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable1"]][["data"]] jaspTools::expect_equal_tables(table, - list(9, 765.700483091787, 97.8395061728395, 2.22178519889191e-21, 880.555555555556, - "Parts", 2, 6.54347826086958, 0.836111111111114, 0.0073155788200197, + list(9, 622.789783889979, 97.8395061728395, 1.41581280737464e-20, 880.555555555556, + "Parts", 2, 5.32220039292731, 0.836111111111114, 0.0152789978971193, 1.67222222222223, "Operators", 18, 1.22946859903382, 0.157098765432099, 0.268355463232599, 2.82777777777778, "Parts * Operators", 60, 0.127777777777778, 7.66666666666667, "Repeatability", 89, 892.722222222222, "Total")) }) -test_that("Two-way ANOVA Table without Interaction results match", { +test_that("LF1.5 Default settings - Two-way ANOVA table without interaction results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable2"]][["data"]] jaspTools::expect_equal_tables(table, - list(9, 727.192518087174, 97.8395061728395, 2.19585066080531e-71, 880.555555555556, + list(9, 727.192518087174, 97.8395061728395, 2.19585066080532e-71, 880.555555555556, "Parts", 2, 6.21439915299104, 0.836111111111114, 0.00313130866789578, 1.67222222222223, "Operators", 78, 0.134544159544159, 10.4944444444444, "Repeatability", 89, 892.722222222222, "Total")) }) -test_that("Part by Operator Interaction plot matches", { +test_that("LF1.6 Default settings - Part by operator interaction plot matches", { plotName <- results[["results"]][["gaugeByInteraction"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "part-by-operator-interaction") + jaspTools::expect_equal_plots(testPlot, "1_part-by-operator-interaction") }) -test_that("Measurements by Operator plot matches", { +test_that("LF1.7 Default settings - Measurements by operator plot matches", { plotName <- results[["results"]][["gaugeByOperator"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "measurements-by-operator") + jaspTools::expect_equal_plots(testPlot, "1_measurements-by-operator") }) -test_that("Measurements by Part plot matches", { +test_that("LF1.8 Default settings - Measurements by part plot matches", { plotName <- results[["results"]][["gaugeByPart"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "measurements-by-part") + jaspTools::expect_equal_plots(testPlot, "1_measurements-by-part") }) -test_that("Range chart by operator plot matches", { +test_that("LF1.9 Default settings - Matrix plot for operators matches", { + plotName <- results[["results"]][["gaugeScatterOperators"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "1_matrix-plot-for-operators") +}) + +test_that("LF1.10 Default settings - Range chart by operator plot matches", { plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "range-chart-by-operator") + jaspTools::expect_equal_plots(testPlot, "1_range-chart-by-operator") +}) + +test_that("LF1.11 Default settings - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + +test_that("LF1.12 Default settings - Traffic plot matches", { + plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "1_traffic-plot") +}) + +test_that("LF1.13 Default settings - Average chart by operator plot matches", { + plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "1_average-chart-by-operator") +}) + +test_that("LF1.14 Default settings - Test results for x-bar chart table results match", { + table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("Operator A", "Point 1", "", "Point 2", "", "Point 3", "", "Point 4", + "", "Point 5", "", "Point 6", "", "Point 7", "", "Point 8", + "", "Point 9", "", "Point 10", "Operator B", "Point 11", "", + "Point 12", "", "Point 13", "", "Point 14", "", "Point 15", + "", "Point 16", "", "Point 17", "", "Point 18", "", "Point 19", + "", "Point 20", "Operator C", "Point 21", "", "Point 22", "", + "Point 23", "", "Point 24", "", "Point 25", "", "Point 26", + "", "Point 27", "", "Point 28", "", "Point 29", "", "Point 30" + )) }) -test_that("Matrix Plot for Operators matches", { +## Historical std. dev #### + +options <- analysisOptions("msaGaugeRR") +options$operatorLongFormat <- "Operators" +options$partLongFormat <- "Parts" +options$measurementLongFormat <- "Dm" +options$tolerance <- TRUE +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE +options$anovaModelType <- "randomEffect" +options$processVariationReference <- "historicalSd" +options$historicalSdValue <- 3 +set.seed(1) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options) + + +test_that("LF2.1 Historical std. dev. - Variance components table results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.75, "Total gauge r&R", 0.157929724596391, 1.49, "Repeatability", + 0.134544159544159, 0.26, "Reproducibility", 0.0233855650522318, + 0.26, "Operators", 0.0233855650522318, 98.25, "Part-to-part", + 8.84207027540361, 100, "Total variation", 9)) +}) + +test_that("LF2.2 Historical std. dev. - Gauge evaluation table results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.397403729972922, 13.25, 23.84, "Total gauge r&R", 2.38442237983753, + 0.36680261659939, 12.23, 22.01, "Repeatability", 2.20081569959634, + 0.15292339602635, 5.1, 9.18, "Reproducibility", 0.917540376158099, + 0.15292339602635, 5.1, 9.18, "Operators", 0.917540376158099, + 2.97356188356718, 99.12, 178.41, "Part-to-part", 17.8413713014031, + 3, 100, 180, "Total variation", 18)) +}) + +test_that("LF2.3 Historical std. dev. - Components of variation plot matches", { + plotName <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_VarCompGraph"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_components-of-variation") +}) + +test_that("LF2.4 Historical std. dev. - Two-way ANOVA table with interaction results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(9, 622.789783889979, 97.8395061728395, 1.41581280737464e-20, 880.555555555556, + "Parts", 2, 5.32220039292731, 0.836111111111114, 0.0152789978971193, + 1.67222222222223, "Operators", 18, 1.22946859903382, 0.157098765432099, + 0.268355463232599, 2.82777777777778, "Parts * Operators", + 60, 0.127777777777778, 7.66666666666667, "Repeatability", 89, + 892.722222222222, "Total")) +}) + +test_that("LF2.5 Historical std. dev. - Two-way ANOVA table without interaction results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(9, 727.192518087174, 97.8395061728395, 2.19585066080532e-71, 880.555555555556, + "Parts", 2, 6.21439915299104, 0.836111111111114, 0.00313130866789578, + 1.67222222222223, "Operators", 78, 0.134544159544159, 10.4944444444444, + "Repeatability", 89, 892.722222222222, "Total")) +}) + +test_that("LF2.6 Historical std. dev. - Part by operator interaction plot matches", { + plotName <- results[["results"]][["gaugeByInteraction"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_part-by-operator-interaction") +}) + +test_that("LF2.7 Historical std. dev. - Measurements by operator plot matches", { + plotName <- results[["results"]][["gaugeByOperator"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_measurements-by-operator") +}) + +test_that("LF2.8 Historical std. dev. - Measurements by part plot matches", { + plotName <- results[["results"]][["gaugeByPart"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_measurements-by-part") +}) + +test_that("LF2.9 Historical std. dev. - Matrix plot for operators matches", { plotName <- results[["results"]][["gaugeScatterOperators"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "matrix-plot-for-operators") + jaspTools::expect_equal_plots(testPlot, "2_matrix-plot-for-operators") }) -test_that("Average chart by operator plot matches", { +test_that("LF2.10 Historical std. dev. - Range chart by operator plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_range-chart-by-operator") +}) + +test_that("LF2.11 Historical std. dev. - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + +test_that("LF2.12 Historical std. dev. - Traffic plot matches", { + plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_traffic-plot") +}) + +test_that("LF2.13 Historical std. dev. - Average chart by operator plot matches", { plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "average-chart-by-operator") + jaspTools::expect_equal_plots(testPlot, "2_average-chart-by-operator") }) -test_that("Test results for x-bar chart table results match", { +test_that("LF2.14 Historical std. dev. - Test results for x-bar chart table results match", { table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] jaspTools::expect_equal_tables(table, list("Operator A", "Point 1", "", "Point 2", "", "Point 3", "", "Point 4", @@ -119,104 +267,305 @@ test_that("Test results for x-bar chart table results match", { )) }) -# Wide -options$dataFormat <- "wideFormat" +## Fixed effects model #### + +options <- analysisOptions("msaGaugeRR") +options$operatorLongFormat <- "Operators" +options$partLongFormat <- "Parts" +options$measurementLongFormat <- "Dm" +options$tolerance <- TRUE +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE +options$anovaModelType <- "fixedEffect" +set.seed(1) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options) + +test_that("LF3.1 Fixed effect ANOVA - Two-way ANOVA table with interaction results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(9, 765.700483091787, 97.8395061728395, 2.22178519889191e-21, 880.555555555556, + "Parts", 2, 6.54347826086958, 0.836111111111114, 0.0073155788200197, + 1.67222222222223, "Operators", 18, 1.22946859903382, 0.157098765432099, + 0.268355463232599, 2.82777777777778, "Parts * Operators", + 60, 0.127777777777778, 7.66666666666667, "Repeatability", 89, + 892.722222222222, "Total")) +}) + +test_that("LF3.2 Fixed effect ANOVA - Two-way ANOVA table without interaction results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(9, 727.192518087174, 97.8395061728395, 2.19585066080532e-71, 880.555555555556, + "Parts", 2, 6.21439915299104, 0.836111111111114, 0.00313130866789578, + 1.67222222222223, "Operators", 78, 0.134544159544159, 10.4944444444444, + "Repeatability", 89, 892.722222222222, "Total")) +}) + +## Type 3 study #### +options <- analysisOptions("msaGaugeRR") +options$partLongFormat <- "Parts" +options$measurementLongFormat <- "Dm" +options$tolerance <- TRUE +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE +options$anovaModelType <- "randomEffect" +options$type3 <- TRUE +set.seed(1) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options) + + +test_that("LF4.1 Type 3 study - Variance components table results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.38, "Total gauge r&R", 0.152083333333333, 1.38, "Repeatability", + 0.152083333333333, 98.62, "Part-to-part", 10.8541580932785, + 100, "Total variation", 11.0062414266118)) +}) + +test_that("LF4.2 Type 3 study - Gauge evaluation table results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.389978631893253, 11.75, 23.4, "Total gauge r&R", 2.33987179135952, + 0.389978631893253, 11.75, 23.4, "Repeatability", 2.33987179135952, + 3.29456493232088, 99.31, 197.67, "Part-to-part", 19.7673895939253, + 3.3175655873866, 100, 199.05, "Total variation", 19.9053935243196 + )) +}) + +test_that("LF4.3 Type 3 study - Components of variation plot matches", { + plotName <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_VarCompGraph"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_components-of-variation") +}) + +test_that("LF4.4 Type 3 study - One-way ANOVA table results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(9, 643.328259766616, 97.8395061728395, 9.59874187907134e-71, 880.555555555556, + "Parts", 80, 0.152083333333333, 12.1666666666667, "Repeatability", + 89, 892.722222222222, "Total")) +}) + +test_that("LF4.5 Type 3 study - Part by operator interaction plot matches", { + plotName <- results[["results"]][["gaugeByInteraction"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_part-by-operator-interaction") +}) + +test_that("LF4.6 Type 3 study - Measurements by operator plot matches", { + plotName <- results[["results"]][["gaugeByOperator"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_measurements-by-operator") +}) + +test_that("LF4.7 Type 3 study - Measurements by part plot matches", { + plotName <- results[["results"]][["gaugeByPart"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_measurements-by-part") +}) + +test_that("LF4.9 Type 3 study - Range chart by operator plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_range-chart-by-operator") +}) + +test_that("LF4.10 Type 3 study - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1, "Point 10", "Point 8", "", "", "Point 9")) +}) + +test_that("LF4.11 Type 3 study - traffic plot matches", { + plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_traffic-plot") +}) + +test_that("LF4.12 Type 3 study - Average chart by operator plot matches", { + plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_average-chart-by-operator") +}) + +test_that("LF4.13 Type 3 study - Test results for x-bar chart table results match", { + table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1, "Point 1", "", "Point 2", "", "Point 3", "", "Point 4", "", + "Point 5", "", "Point 6", "", "Point 7", "", "Point 8", "", + "Point 9", "", "Point 10")) +}) + +## Report #### + +options <- analysisOptions("msaGaugeRR") +options$operatorLongFormat <- "Operators" +options$partLongFormat <- "Parts" +options$measurementLongFormat <- "Dm" +options$tolerance <- TRUE +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE +options$anovaModelType <- "randomEffect" +options$report <- TRUE +options$reportGaugeNameText <- "Name of the gauge study" +set.seed(1) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options) + + + +test_that("LF5. Gauge r&R report plot matches", { + plotName <- results[["results"]][["report"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "5_gauge-r-r-report") +}) + +# Wide format #### + +## Default settings #### +options <- analysisOptions("msaGaugeRR") options$operatorWideFormat <- "Operator" options$partWideFormat <- "Part" -options$measurementsWideFormat <- c("Measurement1", "Measurement2", "Measurement3") +options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3") +options$dataFormat <- "wideFormat" +options$tolerance <- TRUE +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE +options$anovaModelType <- "randomEffect" set.seed(1) -results <- runAnalysis("msaGaugeRR", "msaGageRandr_wide.csv", options) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options) -test_that("Variance Components table results match", { + +test_that("WF1.1 Default Settings - Variance components table results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable1"]][["data"]] jaspTools::expect_equal_tables(table, - list(22.56, "Total Gauge r&R", 0.848225424491385, 22.54, "Repeatability", + list(22.56, "Total gauge r&R", 0.848225424491385, 22.54, "Repeatability", 0.847522164107094, 0.02, "Reproducibility", 0.000703260384290564, - 0.02, "Operator", 0.000703260384290564, 77.44, "Part-to-Part", - 2.91190554000432, 100, "Total Variation", 3.7601309644957)) + 0.02, "Operator", 0.000703260384290564, 77.44, "Part-to-part", + 2.91190554000432, 100, "Total variation", 3.7601309644957)) }) -test_that("Gauge Evaluation table results match", { +test_that("WF1.2 Default Settings - Gauge evaluation table results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable2"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.920991544201892, 47.5, 36.84, "Total Gauge r&R", 5.52594926521135, - 0.920609669787959, 47.48, 36.82, "Repeatability", 5.52365801872775, - 0.0265190570022873, 1.37, 1.06, "Reproducibility", 0.159114342013724, - 0.0265190570022873, 1.37, 1.06, "Operator", 0.159114342013724, - 1.70643064318604, 88, 68.26, "Part-to-Part", 10.2385838591162, - 1.93910571256332, 100, 77.56, "Total Variation", 11.6346342753799 + list(0.920991544201892, 47.5, 55.26, "Total gauge r&R", 5.52594926521135, + 0.920609669787959, 47.48, 55.24, "Repeatability", 5.52365801872775, + 0.0265190570022873, 1.37, 1.59, "Reproducibility", 0.159114342013724, + 0.0265190570022873, 1.37, 1.59, "Operator", 0.159114342013724, + 1.70643064318604, 88, 102.39, "Part-to-part", 10.2385838591162, + 1.93910571256332, 100, 116.35, "Total variation", 11.6346342753799 )) }) -test_that("Components of Variation plot matches", { +test_that("WF1.3 Default Settings - Components of variation plot matches", { plotName <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_VarCompGraph"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "components-of-variation-Wide") + jaspTools::expect_equal_plots(testPlot, "WF1_components-of-variation") }) -test_that("Two-way ANOVA Table with Interaction results match", { +test_that("WF1.4 Default Settings - Two-way ANOVA table with interaction results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable1"]][["data"]] jaspTools::expect_equal_tables(table, - list(9, 28.837403998517, 27.0546720241459, 6.66730220666189e-09, 243.492048217314, - "Part", 2, 0.925856544711989, 0.868619975635811, 0.41425774549038, + list(9, 49.6115781426449, 27.0546720241459, 7.05242347812414e-11, 243.492048217313, + "Part", 2, 1.59283423428892, 0.868619975635811, 0.23071349585535, 1.73723995127162, "Operator", 18, 0.581263589632298, 0.545329800764601, 0.89932032121579, 9.81593641376281, "Part * Operator", 60, - 0.938179873109842, 56.2907923865906, "Repeatability", 89, 311.336016968939, + 0.938179873109842, 56.2907923865905, "Repeatability", 89, 311.336016968938, "Total")) }) -test_that("Two-way ANOVA Table without Interaction results match", { +test_that("WF1.5 Default Settings - Two-way ANOVA table without interaction results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable2"]][["data"]] jaspTools::expect_equal_tables(table, - list(9, 31.9220820055477, 27.0546720241459, 1.20668982102463e-22, 243.492048217314, + list(9, 31.9220820055477, 27.0546720241459, 1.20668982102463e-22, 243.492048217313, "Part", 2, 1.02489352187142, 0.868619975635811, 0.363615551786533, 1.73723995127162, "Operator", 78, 0.847522164107094, 66.1067288003534, - "Repeatability", 89, 311.336016968939, "Total")) + "Repeatability", 89, 311.336016968938, "Total")) }) -test_that("Part by Operator Interaction plot matches", { +test_that("WF1.6 Default Settings - Part by operator interaction plot matches", { plotName <- results[["results"]][["gaugeByInteraction"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "part-by-operator-interaction-Wide") + jaspTools::expect_equal_plots(testPlot, "WF1_part-by-operator-interaction") }) -test_that("Measurements by Operator plot matches", { +test_that("WF1.7 Default Settings - Measurements by operator plot matches", { plotName <- results[["results"]][["gaugeByOperator"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "measurements-by-operator-Wide") + jaspTools::expect_equal_plots(testPlot, "WF1_measurements-by-operator") }) -test_that("Measurements by Part plot matches", { +test_that("WF1.8 Default Settings - Measurements by part plot matches", { plotName <- results[["results"]][["gaugeByPart"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "measurements-by-part-Wide") + jaspTools::expect_equal_plots(testPlot, "WF1_measurements-by-part") +}) + +test_that("WF1.9 Default Settings - Matrix plot for operators matches", { + plotName <- results[["results"]][["gaugeScatterOperators"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_matrix-plot-for-operators") }) -test_that("Range chart by operator plot matches", { +test_that("WF1.10 Default Settings - Range chart by operator plot matches", { plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "range-chart-by-operator-Wide") + jaspTools::expect_equal_plots(testPlot, "WF1_range-chart-by-operator") }) -test_that("Test results for range chart table results match", { +test_that("WF1.11 Default Settings - Test results for range chart table results match", { table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] jaspTools::expect_equal_tables(table, list("C", "Point 30")) }) -test_that("Matrix Plot for Operators matches", { - plotName <- results[["results"]][["gaugeScatterOperators"]][["data"]] +test_that("WF1.12 Default Settings - Traffic plot matches", { + plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "matrix-plot-for-operators-Wide") + jaspTools::expect_equal_plots(testPlot, "WF1_traffic-plot") }) -test_that("Average chart by operator plot matches", { +test_that("WF1.13 Default Settings - Average chart by operator plot matches", { plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "average-chart-by-operator-Wide") + jaspTools::expect_equal_plots(testPlot, "WF1_average-chart-by-operator") }) -test_that("Test results for x-bar chart table results match", { +test_that("WF1.14 Default Settings - Test results for x-bar chart table results match", { table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] jaspTools::expect_equal_tables(table, list("A", "Point 1", "", "Point 5", "", "Point 8", "", "Point 10", @@ -225,97 +574,304 @@ test_that("Test results for x-bar chart table results match", { )) }) -# Long: Type 3 +## Historical std. dev #### options <- analysisOptions("msaGaugeRR") -data <- read.csv("msaGaugeRR_Type3_Long.csv") -options$dataFormat <- "longFormat" -names(data)[1] <- "Parts" -options$operatorLongFormat <- "" -options$partLongFormat <- "Parts" -options$measurementLongFormat <- "dm" -options$type3 <- TRUE +options$operatorWideFormat <- "Operator" +options$partWideFormat <- "Part" +options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3") +options$dataFormat <- "wideFormat" options$tolerance <- TRUE -options$toleranceValue <- 12 -options$anovaModelType <- 'RandomEffects' +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE +options$anovaModelType <- "randomEffect" +options$processVariationReference <- "historicalSd" +options$historicalSdValue <- 3 set.seed(1) -results <- runAnalysis("msaGaugeRR", data, options) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options) -test_that("Variance Components table results match", { +test_that("WF2.1 Historical std. dev. - Variance components table results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable1"]][["data"]] jaspTools::expect_equal_tables(table, - list(4.53, "Total Gauge r&R", 0.176833333333333, 4.53, "Repeatability", - 0.176833333333333, 95.47, "Part-to-Part", 3.73036549707602, - 100, "Total Variation", 3.90719883040936)) + list(9.42, "Total gauge r&R", 0.848225424491385, 9.42, "Repeatability", + 0.847522164107094, 0.01, "Reproducibility", 0.000703260384290564, + 0.01, "Operator", 0.000703260384290564, 90.58, "Part-to-part", + 8.15177457550861, 100, "Total variation", 9)) }) -test_that("Gauge Evaluation table results match", { +test_that("WF2.2 Historical std. dev. - Gauge evaluation table results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable2"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.420515556588972, 21.27, 21.03, "Total Gauge r&R", 2.52309333953384, - 0.420515556588972, 21.27, 21.03, "Repeatability", 2.52309333953384, - 1.93141541287109, 97.71, 96.57, "Part-to-Part", 11.5884924772266, - 1.97666356024726, 100, 98.83, "Total Variation", 11.8599813614835 - )) + list(0.920991544201892, 30.7, 55.26, "Total gauge r&R", 5.52594926521135, + 0.920609669787959, 30.69, 55.24, "Repeatability", 5.52365801872775, + 0.0265190570022873, 0.88, 1.59, "Reproducibility", 0.159114342013724, + 0.0265190570022873, 0.88, 1.59, "Operator", 0.159114342013724, + 2.85513127115175, 95.17, 171.31, "Part-to-part", 17.1307876269105, + 3, 100, 180, "Total variation", 18)) }) -test_that("Components of Variation plot matches", { +test_that("WF2.3 Historical std. dev. - Components of variation plot matches", { plotName <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_VarCompGraph"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "components-of-variation-LongType3") + jaspTools::expect_equal_plots(testPlot, "WF2_components-of-variation") }) -test_that("One-way ANOVA Table results match", { +test_that("WF2.4 Historical std. dev. - -way ANOVA table with interaction results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable1"]][["data"]] jaspTools::expect_equal_tables(table, - list(19, 64.2861253038345, 11.3679298245614, 4.58619746938796e-24, - 215.990666666667, "Parts", 40, 0.176833333333333, 7.07333333333333, - "Repeatability", 59, 223.064, "Total")) + list(9, 49.6115781426449, 27.0546720241459, 7.05242347812414e-11, 243.492048217313, + "Part", 2, 1.59283423428892, 0.868619975635811, 0.23071349585535, + 1.73723995127162, "Operator", 18, 0.581263589632298, 0.545329800764601, + 0.89932032121579, 9.81593641376281, "Part * Operator", 60, + 0.938179873109842, 56.2907923865905, "Repeatability", 89, 311.336016968938, + "Total")) +}) + +test_that("WF2.5 Historical std. dev. - Two-way ANOVA table without interaction results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(9, 31.9220820055477, 27.0546720241459, 1.20668982102463e-22, 243.492048217313, + "Part", 2, 1.02489352187142, 0.868619975635811, 0.363615551786533, + 1.73723995127162, "Operator", 78, 0.847522164107094, 66.1067288003534, + "Repeatability", 89, 311.336016968938, "Total")) }) -test_that("Measurements by Part plot matches", { +test_that("WF2.6 Historical std. dev. - Part by operator interaction plot matches", { + plotName <- results[["results"]][["gaugeByInteraction"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_part-by-operator-interaction") +}) + +test_that("WF2.7 Historical std. dev. - Measurements by operator plot matches", { + plotName <- results[["results"]][["gaugeByOperator"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_measurements-by-operator") +}) + +test_that("WF2.8 Historical std. dev. - Measurements by part plot matches", { plotName <- results[["results"]][["gaugeByPart"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "measurements-by-part-LongType3") + jaspTools::expect_equal_plots(testPlot, "WF2_measurements-by-part") +}) + +test_that("WF2.9 Historical std. dev. - Matrix plot for operators matches", { + plotName <- results[["results"]][["gaugeScatterOperators"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_matrix-plot-for-operators") +}) + +test_that("WF2.10 Historical std. dev. - Range chart by operator plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_range-chart-by-operator") +}) + +test_that("WF2.11 Historical std. dev. - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("C", "Point 30")) +}) + +test_that("WF2.12 Historical std. dev. - Traffic plot matches", { + plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_traffic-plot") +}) + +test_that("WF2.13 Historical std. dev. - Average chart by operator plot matches", { + plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_average-chart-by-operator") +}) + +test_that("WF2.14 Historical std. dev. - Test results for x-bar chart table results match", { + table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("A", "Point 1", "", "Point 5", "", "Point 8", "", "Point 10", + "B", "Point 11", "", "Point 15", "", "Point 18", "", "Point 20", + "C", "Point 21", "", "Point 23", "", "Point 25", "", "Point 30" + )) }) -# Type 3 WIDE -options$operatorWideFormat <- "" +## Fixed effects model #### + +options <- analysisOptions("msaGaugeRR") +options$operatorWideFormat <- "Operator" +options$partWideFormat <- "Part" +options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3") options$dataFormat <- "wideFormat" +options$tolerance <- TRUE +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE +options$anovaModelType <- "fixedEffect" +set.seed(1) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options) + +test_that("WF3.1 Fixed effct ANOVA - Two-way ANOVA table with interaction results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(9, 28.837403998517, 27.0546720241459, 6.66730220666189e-09, 243.492048217313, + "Part", 2, 0.925856544711989, 0.868619975635811, 0.41425774549038, + 1.73723995127162, "Operator", 18, 0.581263589632298, 0.545329800764601, + 0.89932032121579, 9.81593641376281, "Part * Operator", 60, + 0.938179873109842, 56.2907923865905, "Repeatability", 89, 311.336016968938, + "Total")) +}) + +test_that("WF3.2 Fixed effct ANOVA - Two-way ANOVA table without interaction results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(9, 31.9220820055477, 27.0546720241459, 1.20668982102463e-22, 243.492048217313, + "Part", 2, 1.02489352187142, 0.868619975635811, 0.363615551786533, + 1.73723995127162, "Operator", 78, 0.847522164107094, 66.1067288003534, + "Repeatability", 89, 311.336016968938, "Total")) +}) + +## Type 3 study #### + +options <- analysisOptions("msaGaugeRR") options$partWideFormat <- "Part" -options$measurementsWideFormat <- c("Repeat.1", "Repeat.2", "Repeat.3") -options$type3 <- TRUE +options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3") +options$dataFormat <- "wideFormat" +options$tolerance <- TRUE +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE options$anovaModelType <- "randomEffect" -options$scatterPlot <- FALSE -options$scatterPlotFitLine <- FALSE +options$type3 <- TRUE set.seed(1) -results <- runAnalysis("msaGaugeRR", "msaGaugeRR_Type3_Wide.csv", options) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options) + -test_that("Variance Components table results match", { +test_that("WF4.1 Type 3 study - Variance components table results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable1"]][["data"]] jaspTools::expect_equal_tables(table, - list(4.53, "Total Gauge r&R", 0.176833333333333, 4.53, "Repeatability", - 0.176833333333333, 95.47, "Part-to-Part", 3.73036549707602, - 100, "Total Variation", 3.90719883040936)) + list(22.56, "Total gauge r&R", 0.848049609395312, 22.56, "Repeatability", + 0.848049609395312, 77.44, "Part-to-part", 2.91184693497229, + 100, "Total variation", 3.7598965443676)) +}) + +test_that("WF4.2 Type 3 study - Gauge evaluation table results match", { + table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_RRtable2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.920896090444146, 47.49, 55.25, "Total gauge r&R", 5.52537654266487, + 0.920896090444146, 47.49, 55.25, "Repeatability", 5.52537654266487, + 1.70641347128189, 88, 102.38, "Part-to-part", 10.2384808276913, + 1.9390452661987, 100, 116.34, "Total variation", 11.6342715971922 + )) }) -test_that("Components of Variation plot matches", { +test_that("WF4.3 Type 3 study - Components of variation plot matches", { plotName <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_VarCompGraph"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "components-of-variation-WideType3") + jaspTools::expect_equal_plots(testPlot, "WF4_components-of-variation") }) -test_that("One-way ANOVA Table results match", { +test_that("WF4.4 Type 3 study - One-way ANOVA table results match", { table <- results[["results"]][["gaugeANOVA"]][["collection"]][["gaugeANOVA_anovaTable1"]][["data"]] jaspTools::expect_equal_tables(table, - list(19, 64.2861253038345, 11.3679298245614, 4.58619746938796e-24, - 215.990666666667, "Part", 40, 0.176833333333333, 7.07333333333333, - "Repeatability", 59, 223.064, "Total")) + list(9, 31.9022280352642, 27.0546720241459, 6.20007551605074e-23, 243.492048217313, + "Part", 80, 0.848049609395312, 67.843968751625, "Repeatability", + 89, 311.336016968938, "Total")) }) -test_that("Measurements by Part plot matches", { +test_that("WF4.6 Type 3 study - Measurements by operator plot matches", { + plotName <- results[["results"]][["gaugeByOperator"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF4_measurements-by-operator") +}) + +test_that("WF4.7 Type 3 study - Measurements by part plot matches", { plotName <- results[["results"]][["gaugeByPart"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "measurements-by-part-WideType3") + jaspTools::expect_equal_plots(testPlot, "WF4_measurements-by-part") +}) + +test_that("WF4.9 Type 3 study - Range chart by operator plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF4_range-chart-by-operator") +}) + +test_that("WF4.10 Type 3 study - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1, "Point 9", "", "Point 10")) +}) + +test_that("WF4.11 Type 3 study - Traffic plot matches", { + plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF4_traffic-plot") +}) + +test_that("WF4.12 Type 3 study - Average chart by operator plot matches", { + plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF4_average-chart-by-operator") }) +test_that("WF4.13 Type 3 study - Test results for x-bar chart table results match", { + table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1, "Point 1", "Point 16", "", "Point 2", "Point 17", "", "Point 3", + "Point 18", "", "Point 9", "", "", "Point 13", "", "", "Point 14", + "", "", "Point 15", "", "", "Point 22", "", "", "Point 23", + "", "", "Point 28", "", "", "Point 29", "", "", "Point 30", + "")) +}) + +## Report #### + +options <- analysisOptions("msaGaugeRR") +options$operatorWideFormat <- "Operator" +options$partWideFormat <- "Part" +options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3") +options$dataFormat <- "wideFormat" +options$tolerance <- TRUE +options$toleranceValue <- 10 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$scatterPlot <- TRUE +options$scatterPlotFitLine <- TRUE +options$scatterPlotOriginLine <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$partByOperatorMeasurementPlot <- TRUE +options$trafficLightChart <- TRUE +options$anovaModelType <- "randomEffect" +options$report <- TRUE +set.seed(1) +results <- runAnalysis("msaGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options) + +test_that("WF5 - Gauge r&R report plot matches", { + plotName <- results[["results"]][["report"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "gauge-r-r-report") +}) diff --git a/tests/testthat/test-msaGaugeRRnonrep.R b/tests/testthat/test-msaGaugeRRnonrep.R index 8600b01a..64b8f0aa 100644 --- a/tests/testthat/test-msaGaugeRRnonrep.R +++ b/tests/testthat/test-msaGaugeRRnonrep.R @@ -1,9 +1,15 @@ context("[Quality Control] MSA Gauge non-replicabe") +.numDecimals <- 2 +# Long format #### + +## Default settings #### options <- analysisOptions("msaGaugeRRnonrep") options$partLongFormat <- "Batch" options$operatorLongFormat <- "Operator" options$measurementLongFormat <- "Result" +options$tolerance <- TRUE +options$toleranceValue <- 15 options$rChart <- TRUE options$xBarChart <- TRUE options$partMeasurementPlot <- TRUE @@ -11,83 +17,462 @@ options$partMeasurementPlotAllValues <- TRUE options$operatorMeasurementPlot <- TRUE set.seed(1) -results <- runAnalysis("msaGaugeRRnonrep", "msaGaugeNN.csv", options) +results <- runAnalysis("msaGaugeRRnonrep", "datasets/msaGaugeRRNested/msaGaugeRRNested_long.csv", options) + -test_that("Measurements by Operator plot matches", { +test_that("LF1.1 Default settings - Measurements by operator plot matches", { plotName <- results[["results"]][["NRoperatorGraph"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "measurements-by-operator") + jaspTools::expect_equal_plots(testPlot, "LF1_measurements-by-operator") }) -test_that("Operator A plot matches", { +test_that("LF1.2 Default settings - Operator A plot matches", { plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_A"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "operator-a") + jaspTools::expect_equal_plots(testPlot, "LF1_operator-a") }) -test_that("Operator B plot matches", { +test_that("LF1.3 Default settings - Operator B plot matches", { plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_B"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "operator-b") + jaspTools::expect_equal_plots(testPlot, "LF1_operator-b") }) -test_that("Operator C plot matches", { +test_that("LF1.4 Default settings - Operator C plot matches", { plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_C"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "operator-c") + jaspTools::expect_equal_plots(testPlot, "LF1_operator-c") }) +test_that("LF1.5 Default settings - Components of variation plot matches", { + plotName <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF1_components-of-variation") +}) + +test_that("LF1.6 Default settings - Gauge r&R (nested) table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(2, 0.696059139499015, 2.18133333333333, 4.36266666666666, 0.517597080688392, + "Operator", 12, 38.849173553719, 3.13383333333333, 37.606, 4.46224072581384e-09, + "Batch(Operator)", 15, "", 0.0806666666666667, 1.21, "", "Repeatability", + 29, "", "", 43.1786666666667, "", "Total")) +}) -test_that("Range chart by operator plot matches", { +test_that("LF1.7 Default settings - Variance components table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.0806666666666667, 5.01892466428164, "Total gauge r&R", 0.0806666666666667, + 5.01892466428164, "Repeatability", 0, 0, "Reproducibility", + 1.52658333333333, 94.9810753357184, "Part-To-part", 1.60725, + 100, "Total variation")) +}) + +test_that("LF1.8 Default settings - Gauge evaluation table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table3"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.284018778721877, 22.4029566447861, 11.3607511488751, "Total gauge r&R", + 1.70411267233126, 0.284018778721877, 22.4029566447861, 11.3607511488751, + "Repeatability", 1.70411267233126, 0, 0, 0, "Reproducibility", + 0, 1.23554981013852, 97.458234816622, 49.4219924055408, "Part-To-part", + 7.41329886083112, 1.26777363910124, 100, 50.7109455640496, "Total variation", + 7.60664183460744)) +}) + +test_that("LF1.9 Default settings - Range chart by operator plot matches", { plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "range-chart-by-operator") + jaspTools::expect_equal_plots(testPlot, "LF1_range-chart-by-operator") }) -test_that("Average chart by operator plot matches", { +test_that("LF1.10 Default settings - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + +test_that("LF1.11 Default settings - Average chart by operator plot matches", { plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "average-chart-by-operator") + jaspTools::expect_equal_plots(testPlot, "LF1_average-chart-by-operator") }) -test_that("Test results for x-bar chart table results match", { +test_that("LF1.12 Default settings - Test results for x-bar chart table results match", { table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] jaspTools::expect_equal_tables(table, - list("A", "Point 2", "", "Point 3", "", "Point 4", "", "Point 5", - "B", "Point 6", "", "Point 7", "", "Point 8", "", "Point 10", "C", - "Point 11", "", "Point 12", "", "Point 13", "", "Point 15")) + list("A", "Point 2", "", "Point 3", "", "Point 4", "", "Point 5", "B", + "Point 6", "", "Point 7", "", "Point 8", "", "Point 10", "C", + "Point 11", "", "Point 12", "", "Point 13", "", "Point 15" + )) }) -test_that("Components of Variation plot matches", { +## Historical std. dev. #### + +options <- analysisOptions("msaGaugeRRnonrep") +options$partLongFormat <- "Batch" +options$operatorLongFormat <- "Operator" +options$measurementLongFormat <- "Result" +options$tolerance <- TRUE +options$toleranceValue <- 15 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$processVariationReference <- "historicalSd" +options$historicalSdValue <- 3 +set.seed(1) + +results <- runAnalysis("msaGaugeRRnonrep", "datasets/msaGaugeRRNested/msaGaugeRRNested_long.csv", options) + + +test_that("LF2.1 Historical std. dev. - Measurements by operator plot matches", { + plotName <- results[["results"]][["NRoperatorGraph"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF2_measurements-by-operator") +}) + +test_that("LF2.2 Historical std. dev. - Operator A plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_A"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF2_operator-a") +}) + +test_that("LF2.3 Historical std. dev. - Operator B plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_B"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF2_operator-b") +}) + +test_that("LF2.4 Historical std. dev. - Operator C plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_C"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF2_operator-c") +}) + +test_that("LF2.5 Historical std. dev. - Components of variation plot matches", { plotName <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "components-of-variation") + jaspTools::expect_equal_plots(testPlot, "LF2_components-of-variation") }) -test_that("Gauge r&R (Nested) table results match", { +test_that("LF2.6 Historical std. dev. - Gauge r&R (nested) table results match", { table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table1"]][["data"]] jaspTools::expect_equal_tables(table, - list(2, 0.696059139499019, 2.18133333333334, 4.36266666666668, 0.51759708068839, - "Operator", 12, 38.849173553719, 3.13383333333333, 37.606, 4.4622407258139e-09, + list(2, 0.696059139499015, 2.18133333333333, 4.36266666666666, 0.517597080688392, + "Operator", 12, 38.849173553719, 3.13383333333333, 37.606, 4.46224072581384e-09, "Batch(Operator)", 15, "", 0.0806666666666667, 1.21, "", "Repeatability", 29, "", "", 43.1786666666667, "", "Total")) }) -test_that("Variance Components table results match", { +test_that("LF2.7 Historical std. dev. - Variance components table results match", { table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table2"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.0806666666666667, 5.01892466428164, "Total Gauge r & R", - 0.0806666666666667, 5.01892466428164, "Repeatability", 0, 0, - "Reproducibility", 1.52658333333333, 94.9810753357184, "Part-To-Part", - 1.60725, 100, "Total Variation")) + list(0.0806666666666667, 0.896296296296296, "Total gauge r&R", + 0.0806666666666667, 0.896296296296296, "Repeatability", 0, 0, + "Reproducibility", 8.91933333333333, 99.1037037037037, "Part-To-part", + 9, 100, "Total variation")) }) -test_that("Gauge Evaluation table results match", { +test_that("LF2.8 Historical std. dev. - Gauge evaluation table results match", { table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table3"]][["data"]] jaspTools::expect_equal_tables(table, - list(0.284018778721877, 22.4029566447861, "Total Gauge r & R", - 1.70411267233126, 0.284018778721877, 22.4029566447861, "Repeatability", - 1.70411267233126, 0, 0, "Reproducibility", 0, 1.23554981013852, - 97.458234816622, "Part-To-Part", 7.41329886083112, 1.26777363910124, - 100, "Total Variation", 7.60664183460744)) + list(0.284018778721877, 9.46729262406257, 11.3607511488751, "Total gauge r&R", + 1.70411267233126, 0.284018778721877, 9.46729262406257, 11.3607511488751, + "Repeatability", 1.70411267233126, 0, 0, 0, "Reproducibility", + 0, 2.98652529427315, 99.5508431424384, 119.461011770926, "Part-To-part", + 17.9191517656389, 3, 100, 120, "Total variation", 18)) +}) + +test_that("LF2.9 Historical std. dev. - Range chart by operator plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF2_range-chart-by-operator") +}) + +test_that("LF2.10 Historical std. dev. - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + +test_that("LF2.11 Historical std. dev. - Average chart by operator plot matches", { + plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF2_average-chart-by-operator") +}) + +test_that("LF2.12 Historical std. dev. - Test results for x-bar chart table results match", { + table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("A", "Point 2", "", "Point 3", "", "Point 4", "", "Point 5", "B", + "Point 6", "", "Point 7", "", "Point 8", "", "Point 10", "C", + "Point 11", "", "Point 12", "", "Point 13", "", "Point 15" + )) +}) + +## Report #### + +options <- analysisOptions("msaGaugeRRnonrep") +options$partLongFormat <- "Batch" +options$operatorLongFormat <- "Operator" +options$measurementLongFormat <- "Result" +options$tolerance <- TRUE +options$toleranceValue <- 15 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$report <- TRUE +options$reportGaugeName <- TRUE +options$reportGaugeNameText <- "Test Name" +set.seed(1) + +results <- runAnalysis("msaGaugeRRnonrep", "datasets/msaGaugeRRNested/msaGaugeRRNested_long.csv", options) + +test_that("LF3 Report - Gauge r&R (non-replicable) report plot matches", { + plotName <- results[["results"]][["report"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF3_gauge-r-r-non-replicable-report") +}) + +# Wide format #### + +## Default settings #### +options <- analysisOptions("msaGaugeRRnonrep") +options$dataFormat <- "wideFormat" +options$partWideFormat <- "Batch" +options$operatorWideFormat <- "Operator" +options$measurementsWideFormat <- c("Result1", "Result2") +options$tolerance <- TRUE +options$toleranceValue <- 15 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +set.seed(1) + +results <- runAnalysis("msaGaugeRRnonrep", "datasets/msaGaugeRRNested/msaGaugeRRNested_wide.csv", options) + + +test_that("WF1.1 Default settings - Measurements by operator plot matches", { + plotName <- results[["results"]][["NRoperatorGraph"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_measurements-by-operator") +}) + +test_that("WF1.2 Default settings - Operator A plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_A"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_operator-a") +}) + +test_that("WF1.3 Default settings - Operator B plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_B"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_operator-b") +}) + +test_that("WF1.4 Default settings - Operator C plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_C"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_operator-c") +}) + +test_that("WF1.5 Default settings - Components of variation plot matches", { + plotName <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_components-of-variation") +}) + +test_that("WF1.6 Default settings - Gauge r&R (nested) table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(2, 0.696059139499009, 2.18133333333331, 4.36266666666663, 0.517597080688394, + "Operator", 12, 38.8491735537192, 3.13383333333334, 37.606, + 4.46224072581371e-09, "Batch(Operator)", 15, "", 0.0806666666666664, + 1.21, "", "Repeatability", 29, "", "", 43.1786666666667, "", + "Total")) +}) + +test_that("WF1.7 Default settings - Variance components table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.0806666666666664, 5.01892466428162, "Total gauge r&R", 0.0806666666666664, + 5.01892466428162, "Repeatability", 0, 0, "Reproducibility", + 1.52658333333334, 94.9810753357184, "Part-To-part", 1.60725, + 100, "Total variation")) +}) + +test_that("WF1.8 Default settings - Gauge evaluation table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table3"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.284018778721877, 22.402956644786, 11.3607511488751, "Total gauge r&R", + 1.70411267233126, 0.284018778721877, 22.402956644786, 11.3607511488751, + "Repeatability", 1.70411267233126, 0, 0, 0, "Reproducibility", + 0, 1.23554981013852, 97.458234816622, 49.4219924055408, "Part-To-part", + 7.41329886083113, 1.26777363910124, 100, 50.7109455640496, "Total variation", + 7.60664183460744)) +}) + +test_that("WF1.9 Default settings - Range chart by operator plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_range-chart-by-operator") +}) + +test_that("WF1.10 Default settings - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + +test_that("WF1.11 Default settings - Average chart by operator plot matches", { + plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_average-chart-by-operator") +}) + +test_that("WF1.12 Default settings - Test results for x-bar chart table results match", { + table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("A", "Point 2", "", "Point 3", "", "Point 4", "", "Point 5", "B", + "Point 6", "", "Point 7", "", "Point 8", "", "Point 10", "C", + "Point 11", "", "Point 12", "", "Point 13", "", "Point 15" + )) +}) + +## Historical std. dev. #### + +options <- analysisOptions("msaGaugeRRnonrep") +options$dataFormat <- "wideFormat" +options$partWideFormat <- "Batch" +options$operatorWideFormat <- "Operator" +options$measurementsWideFormat <- c("Result1", "Result2") +options$tolerance <- TRUE +options$toleranceValue <- 15 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$processVariationReference <- "historicalSd" +options$historicalSdValue <- 3 +set.seed(1) + +results <- runAnalysis("msaGaugeRRnonrep", "datasets/msaGaugeRRNested/msaGaugeRRNested_wide.csv", options) + +test_that("WF2.1 Historical std. dev. - Measurements by operator plot matches", { + plotName <- results[["results"]][["NRoperatorGraph"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_measurements-by-operator") +}) + +test_that("WF2.2 Historical std. dev. - Operator A plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_A"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_operator-a") +}) + +test_that("WF2.3 Historical std. dev. - Operator B plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_B"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_operator-b") +}) + +test_that("WF2.4 Historical std. dev. - Operator C plot matches", { + plotName <- results[["results"]][["NRpartOperatorGraph"]][["collection"]][["NRpartOperatorGraph_C"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_operator-c") +}) + +test_that("WF2.5 Historical std. dev. - Components of variation plot matches", { + plotName <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_components-of-variation") +}) + +test_that("WF2.6 Historical std. dev. - Gauge r&R (nested) table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(2, 0.696059139499009, 2.18133333333331, 4.36266666666663, 0.517597080688394, + "Operator", 12, 38.8491735537192, 3.13383333333334, 37.606, + 4.46224072581371e-09, "Batch(Operator)", 15, "", 0.0806666666666664, + 1.21, "", "Repeatability", 29, "", "", 43.1786666666667, "", + "Total")) +}) + +test_that("WF2.7 Historical std. dev. - Variance components table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.0806666666666664, 0.896296296296293, "Total gauge r&R", + 0.0806666666666664, 0.896296296296293, "Repeatability", 0, 0, + "Reproducibility", 8.91933333333333, 99.1037037037037, "Part-To-part", + 9, 100, "Total variation")) +}) + +test_that("WF2.8 Historical std. dev. - Gauge evaluation table results match", { + table <- results[["results"]][["gaugeRRNonRep"]][["collection"]][["gaugeRRNonRep_Table3"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.284018778721877, 9.46729262406256, 11.3607511488751, "Total gauge r&R", + 1.70411267233126, 0.284018778721877, 9.46729262406256, 11.3607511488751, + "Repeatability", 1.70411267233126, 0, 0, 0, "Reproducibility", + 0, 2.98652529427315, 99.5508431424384, 119.461011770926, "Part-To-part", + 17.9191517656389, 3, 100, 120, "Total variation", 18)) +}) + +test_that("WF2.9 Historical std. dev. - Range chart by operator plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_range-chart-by-operator") +}) + +test_that("WF2.10 Historical std. dev. - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + +test_that("WF2.11 Historical std. dev. - Average chart by operator plot matches", { + plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF2_average-chart-by-operator") +}) + +test_that("WF2.12 Historical std. dev. - Test results for x-bar chart table results match", { + table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("A", "Point 2", "", "Point 3", "", "Point 4", "", "Point 5", "B", + "Point 6", "", "Point 7", "", "Point 8", "", "Point 10", "C", + "Point 11", "", "Point 12", "", "Point 13", "", "Point 15" + )) +}) + +## Report #### + +options <- analysisOptions("msaGaugeRRnonrep") +options$dataFormat <- "wideFormat" +options$partWideFormat <- "Batch" +options$operatorWideFormat <- "Operator" +options$measurementsWideFormat <- c("Result1", "Result2") +options$tolerance <- TRUE +options$toleranceValue <- 15 +options$rChart <- TRUE +options$xBarChart <- TRUE +options$partMeasurementPlot <- TRUE +options$partMeasurementPlotAllValues <- TRUE +options$operatorMeasurementPlot <- TRUE +options$report <- TRUE +options$reportGaugeName <- TRUE +options$reportGaugeNameText <- "Test Name" +set.seed(1) + +results <- runAnalysis("msaGaugeRRnonrep", "datasets/msaGaugeRRNested/msaGaugeRRNested_wide.csv", options) + +test_that("WF3 Report - Gauge r&R (non-replicable) report plot matches", { + plotName <- results[["results"]][["report"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF3_gauge-r-r-non-replicable-report") }) diff --git a/tests/testthat/test-msaTestRetest.R b/tests/testthat/test-msaTestRetest.R index ff6c1737..43b9a4a7 100644 --- a/tests/testthat/test-msaTestRetest.R +++ b/tests/testthat/test-msaTestRetest.R @@ -1,10 +1,73 @@ context("[Quality Control] MSA Test Retest") -.numDecimals <-2 +.numDecimals <- 2 + +# Long Format #### + +## Default Settings #### + +options <- analysisOptions("msaTestRetest") +options$dataFormat <- "longFormat" +options$partLongFormat <- "Part" +options$measurementLongFormat <- "Measurement" +options$operator <- "Repetition" +options$manualProcessSd <- TRUE +options$manualProcessSdValue <- 2 +options$tolerance <- TRUE +options$toleranceValue <- 0.5 +options$repeatabilityAndReproducibilityTable <- TRUE +options$runChartPart <- TRUE +options$scatterPlotMeasurement <- TRUE +options$scatterPlotMeasurementFitLine <- TRUE +options$rChart <- TRUE +options$trafficLightChart <- TRUE + +results <- runAnalysis("msaTestRetest", "datasets/msaTestRetest/msaTestRetest_long.csv", options) + +test_that("LF1.1 Default Settings - Run chart of parts plot matches", { + plotName <- results[["results"]][["ScatterOperatorParts"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF1_run-chart-of-parts") +}) + +test_that("LF1.2 Default Settings - Scatterplot of 1st measurement vs 2nd measurement matches", { + plotName <- results[["results"]][["ScatterOperators"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF1_scatterplot-of-1st-measurement-vs-2nd-measurement") +}) + +test_that("LF1.3 Default Settings - Short gauge study table results match", { + table <- results[["results"]][["rAndR2"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.0434914974122558, 2.17457487061279, 0.52189796894707, 2, 0.0499999999999999, + 1.14965, 15, 0.5)) +}) + +test_that("LF1.4 Default Settings - Range chart by part plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF1_range-chart-by-part") +}) + +test_that("LF1.5 Default Settings - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) +}) + +test_that("LF1.6 Default Settings - Traffic chart matches", { + plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "LF1_trafficChart") +}) + +# Wide Format #### + +## Default Settings #### options <- analysisOptions("msaTestRetest") options$dataFormat <- "wideFormat" options$partWideFormat <- "Part" -options$measurementsWideFormat <- c("X1", "X2") +options$measurementsWideFormat <- c("Measurement1", "Measurement2") options$manualProcessSd <- TRUE options$manualProcessSdValue <- 2 options$tolerance <- TRUE @@ -16,36 +79,43 @@ options$scatterPlotMeasurementFitLine <- TRUE options$rChart <- TRUE options$trafficLightChart <- TRUE -results <- runAnalysis("msaTestRetest", "msaTestRetest.csv", options) +results <- runAnalysis("msaTestRetest", "datasets/msaTestRetest/msaTestRetest_wide.csv", options) -test_that("Run chart of parts plot matches", { + +test_that("WF1.1 Default Settings - Run chart of parts plot matches", { plotName <- results[["results"]][["ScatterOperatorParts"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "run-chart-of-parts") + jaspTools::expect_equal_plots(testPlot, "WF1_run-chart-of-parts") }) -test_that("Scatterplot of 1st measurement vs 2nd measurement matches", { +test_that("WF1.2 Default Settings - Scatterplot of 1st measurement vs 2nd measurement matches", { plotName <- results[["results"]][["ScatterOperators"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "scatterplot-of-1st-measurement-vs-2nd-measurement") + jaspTools::expect_equal_plots(testPlot, "WF1_scatterplot-of-1st-measurement-vs-2nd-measurement") }) -test_that("Short gauge study table results match", { +test_that("WF1.3 Default Settings - Short gauge study table results match", { table <- results[["results"]][["rAndR2"]][["data"]] jaspTools::expect_equal_tables(table, list(0.0434914974122558, 2.17457487061279, 0.52189796894707, 2, 0.0499999999999999, 1.14965, 15, 0.5)) }) -test_that("Range chart by part plot matches", { - plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] - testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "range-chart-by-part") +test_that("WF1.4 Default Settings - Range chart by part plot matches", { + plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "WF1_range-chart-by-part") +}) + +test_that("WF1.5 Default Settings - Test results for range chart table results match", { + table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]] + jaspTools::expect_equal_tables(table, + list("No test violations occurred.")) }) -test_that("Traffic light chart matches", { +test_that("WF1.6 Default Settings - Traffic chart matches", { plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_plot"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "Traffic-light-chart") + jaspTools::expect_equal_plots(testPlot, "WF1_traffiChart") }) diff --git a/tests/testthat/test-msaType1Gauge.R b/tests/testthat/test-msaType1Gauge.R index dd1a8d3d..b2aa2de6 100644 --- a/tests/testthat/test-msaType1Gauge.R +++ b/tests/testthat/test-msaType1Gauge.R @@ -1,42 +1,209 @@ -context("[Quality Control] MSA Type 1 Gauge") +context("[Quality Control] MSA - Type 1 Instrument Capability") +.numDecimals <- 2 +set.seed(1) + +# Basic tests #### + +## Standard settings (verified with Minitab) #### options <- analysisOptions("msaType1Gauge") options$measurement <- "dm" options$referenceValue <- -4 options$toleranceRange <- 15 options$histogram <- TRUE -set.seed(1) -results <- runAnalysis("msaType1Gauge", "msaType1.csv", options) +options$biasTable <- TRUE +options$percentToleranceForCg <- 20 +results <- runAnalysis("msaType1Gauge", "datasets/msaType1InstrumentCapability/msaType1.csv", options) - -test_that("Bias Histogram plot matches", { +test_that("1.1 Standard settings - Bias histogram plot matches", { plotName <- results[["results"]][["biasHistogram"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "bias-histogram") + jaspTools::expect_equal_plots(testPlot, "1_bias-histogram") }) -test_that("Run Chart of dm plot matches", { +test_that("1.2 Standard settings - Run chart of dm plot matches", { plotName <- results[["results"]][["biasRun"]][["data"]] testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] - jaspTools::expect_equal_plots(testPlot, "run-chart-of-dm") + jaspTools::expect_equal_plots(testPlot, "1_run-chart-of-dm") }) -test_that("Basic Statistics table results match", { +test_that("1.3 Standard settings - Basic statistics table results match", { table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Basic"]][["data"]] jaspTools::expect_equal_tables(table, list(2.52008746203907, 0.0540000000000003, 0.360000000000002, -3.946, - -4, 0.420014577006512, 15)) + -4, 0.420014577006512, 15, -5.5, -2.5)) }) -test_that("Capability table results match", { +test_that("1.4 Standard settings - Capability table results match", { table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Capability"]][["data"]] jaspTools::expect_equal_tables(table, list(1.19, 1.15, 16.8, 17.43)) }) -test_that("T-Test of Observed Bias Against 0 table results match", { +test_that("1.5 Standard settings - t-test of observed bias against 0 table results match", { table <- results[["results"]][["biasTtest"]][["data"]] jaspTools::expect_equal_tables(table, list(0.0540000000000001, 49, -0.0653668220476197, 0.367744349288335, 0.909105737620188, 0.17336682204762)) }) + +## Alternative settings (verified with Minitab) #### + +options <- analysisOptions("msaType1Gauge") +options$measurement <- "dm" +options$referenceValue <- -4 +options$toleranceRange <- 15 +options$histogram <- TRUE +options$biasTable <- TRUE +options$percentToleranceForCg <- 15 +options$studyVarianceMultiplier <- 4 +results <- runAnalysis("msaType1Gauge", "datasets/msaType1InstrumentCapability/msaType1.csv", options) + +test_that("2.1 Alternative settings - Bias histogram plot matches", { + plotName <- results[["results"]][["biasHistogram"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_bias-histogram") +}) + +test_that("2.2 Alternative settings - Run chart of dm plot matches", { + plotName <- results[["results"]][["biasRun"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "2_run-chart-of-dm") +}) + +test_that("2.3 Alternative settings - Basic statistics table results match", { + table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Basic"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.68005830802605, 0.0540000000000003, 0.360000000000002, -3.946, + -4, 0.420014577006512, 15, -5.125, -2.875)) +}) + +test_that("2.4 Alternative settings - Capability table results match", { + table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Capability"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.34, 1.27, 11.2, 11.77)) +}) + +test_that("2.5 Alternative settings - t-test of observed bias against 0 table results match", { + table <- results[["results"]][["biasTtest"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.0540000000000001, 49, -0.0653668220476197, 0.367744349288335, + 0.909105737620188, 0.17336682204762)) +}) + +# Missing data #### + +## One missing value (verified with Minitab) #### + +options <- analysisOptions("msaType1Gauge") +options$measurement <- "dmMissing1" +options$referenceValue <- -4 +options$toleranceRange <- 15 +options$histogram <- TRUE +options$biasTable <- TRUE +options$percentToleranceForCg <- 20 +results <- runAnalysis("msaType1Gauge", "datasets/msaType1InstrumentCapability/msaType1.csv", options) + +test_that("3.1 Missing 1 value - Bias histogram plot matches", { + plotName <- results[["results"]][["biasHistogram"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "3_bias-histogram") +}) + +test_that("3.2 Missing 1 value - Run chart of dmMissing1 plot matches", { + plotName <- results[["results"]][["biasRun"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "3_run-chart-of-dmmissing1") +}) + +test_that("3.3 Missing 1 value - Basic statistics table results match", { + table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Basic"]][["data"]] + jaspTools::expect_equal_tables(table, + list(2.54588503515868, 0.0530612244897961, 0.353741496598641, -3.9469387755102, + -4, 0.424314172526446, 15, -5.5, -2.5)) +}) + +test_that("3.4 Missing 1 value - Capability table results match", { + table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Capability"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.18, 1.14, 16.97, 17.59)) +}) + +test_that("3.5 Missing 1 value - t-test of observed bias against 0 table results match", { + table <- results[["results"]][["biasTtest"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.053061224489796, 48, -0.0688160360008093, 0.385736270518345, + 0.875362161996656, 0.174938484980401)) +}) + +## Half missing value (verified with Minitab) #### + +options <- analysisOptions("msaType1Gauge") +options$measurement <- "dmMissing25" +options$referenceValue <- -4 +options$toleranceRange <- 15 +options$histogram <- TRUE +options$biasTable <- TRUE +options$percentToleranceForCg <- 20 +results <- runAnalysis("msaType1Gauge", "datasets/msaType1InstrumentCapability/msaType1.csv", options) + +test_that("4.1 Missing half values - Bias histogram plot matches", { + plotName <- results[["results"]][["biasHistogram"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_bias-histogram") +}) + +test_that("4.2 Missing half values - Run chart of dmMissing25 plot matches", { + plotName <- results[["results"]][["biasRun"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "4_run-chart-of-dmmissing25") +}) + +test_that("4.3 Missing half values - Basic statistics table results match", { + table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Basic"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.16189500386222, 0, 0, -4, -4, 0.193649167310371, 15, -5.5, -2.5 + )) +}) + +test_that("4.4 Missing half values - Capability table results match", { + table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Capability"]][["data"]] + jaspTools::expect_equal_tables(table, + list(2.58, 2.58, 7.75, 7.75)) +}) + +test_that("4.5 Missing half values - t-test of observed bias against 0 table results match", { + table <- results[["results"]][["biasTtest"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.06580965841124e-16, 24, -0.0799344475744677, 0.999999999999998, + 2.75190870483584e-15, 0.0799344475744679)) +}) + +## All-but-one missing value #### + +options <- analysisOptions("msaType1Gauge") +options$measurement <- "dmMissing49" +options$referenceValue <- -4 +options$toleranceRange <- 15 +options$histogram <- TRUE +options$biasTable <- TRUE +options$percentToleranceForCg <- 20 +results <- runAnalysis("msaType1Gauge", "datasets/msaType1InstrumentCapability/msaType1.csv", options) + +test_that("5.1 Missing all-but-one values - Run chart of dmMissing49 plot matches", { + plotName <- results[["results"]][["biasRun"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "5_run-chart-of-dmmissing49") +}) + +test_that("5.2 Missing all-but-one values - Basic statistics table results match", { + table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Basic"]][["data"]] + jaspTools::expect_equal_tables(table, + list("", 0.5, 3.33333333333333, -3.5, -4, "", 15, -5.5, -2.5)) +}) + +test_that("5.3 Missing all-but-one values - Capability table results match", { + table <- results[["results"]][["biasTable"]][["collection"]][["biasTable_Capability"]][["data"]] + jaspTools::expect_equal_tables(table, + list("", "", "", "")) +})