MSA updates (#323)

* gauge rr non rep help file * Fix all naming * Type 1 study updates * Gauge r&R crossed updates * Gauge r&R nested traffic light chart * Gauge linearity updates and gauge eval report * Make gauge r&R crossed more robust * Rewrite nested anova * .csv files for testing and test-retest fixes * MSA Type 1 unit tests * gauge lin tests * Unit tests for linearity and gauge rr crossed * gauge rr tests * AAA tests * Final unit tests * Update inst/qml/msaGaugeRR.qml Co-authored-by: Don van den Bergh <[email protected]> * Update R/msaGaugeLinearity.R Co-authored-by: Don van den Bergh <[email protected]> * Update inst/qml/msaGaugeRRnonrep.qml Co-authored-by: Don van den Bergh <[email protected]> * Fix 2867 --------- Co-authored-by: Don van den Bergh <[email protected]>
jasp-stats · Aug 23, 2024 · d8e0d61 · d8e0d61
1 parent 4cfbe35
commit d8e0d61
Show file tree

Hide file tree

Showing 269 changed files with 16,548 additions and 2,437 deletions.
diff --git 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
@@ -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
diff --git 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("<i>p(t</i>-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("<i>p</i>-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("<i>t</i>-statistic"), type = "number")
-  table2$addColumnInfo(name = "SEcoefficient", title = gettext("Std. Error coefficients"), type = "number")
-  table2$addColumnInfo(name = "pvalue",            title = gettext("<i>p</i>"), type = "pvalue")
+  table2$addColumnInfo(name = "SEcoefficient", title = gettext("Std. error"), type = "number")
+  table2$addColumnInfo(name = "Tvalues", title = gettext("<i>t</i>-value"), type = "number")
+  table2$addColumnInfo(name = "pvalue",            title = gettext("<i>p</i>-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,39 +82,39 @@ 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]]))) {
       table2$setError(gettextf("Every unique part must have one corresponding reference value. %1$i reference values were found for %2$s unique parts.", length(unique(dataset[[standards]])), length(unique(dataset[[parts]]))))
       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
   }