diff --git a/R/commonQualityControl.R b/R/commonQualityControl.R index e4dc5a1c..f7c41f4b 100644 --- a/R/commonQualityControl.R +++ b/R/commonQualityControl.R @@ -267,6 +267,136 @@ NelsonLaws <- function(data, allsix = FALSE, chart = "i", xLabels = NULL) { return(list(red_points = red_points, Rules = Rules)) } +ruleList <- list() +ruleList$rule1 <- list() + +ruleList$rule1[["k"]] <- 3 +ruleList$rule1[["enabled"]] <- TRUE + + + +.nelsonLaws <- function(plotStatistics, sigma, center, UCL, LCL, ruleList) { + + # Rule 1: Outside of control limits + if (ruleList[["rule1"]][["enabled"]] == TRUE) { + r1 <- which(plotStatistics < LCL | plotStatistics > UCL) + } + + # Rule 2: k points in a row, on the same side of center line + if (ruleList[["rule2"]][["enabled"]] == TRUE) { + k2 <- ruleList[["rule2"]][["k"]] + sideVector <- ifelse(plotStatistics > center, 1, ifelse(plotStatistics < center, -1, 0)) + rleSides <- rle(sideVector) + r2 <- c() + # Track the current start index for runs + currentIndex <- 1 + # Iterate over the lengths and values of rle + for (i in seq_along(rleSides$lengths)) { + runLength <- rleSides$lengths[i] + runValue <- rleSides$values[i] + # Check if the run is on the same side and the length is >= k + if (runLength >= k2 && runValue != 0) { + # Add indices of this run to the offending indices vector + r2 <- c(r2, currentIndex:(currentIndex + runLength - 1)) + } + # Update the current index + currentIndex <- currentIndex + runLength + } + } + + # Rule 3: k points in a row, all increasing or decreasing + if (ruleList[["rule3"]][["enabled"]] == TRUE) { + k3 <- ruleList[["rule3"]][["k"]] + r3 <- c() + + # Loop through the points to find consecutive increases or decreases + currentIndex <- 1 + consecutiveIncreaseCount <- 0 + consecutiveDecreaseCount <- 0 + + # Iterate over the points, considering each point and the next for comparison + for (i in 1:(length(plotStatistics) - 1)) { + if (plotStatistics[i + 1] > plotStatistics[i]) { + # Increment the consecutive increase count and reset decrease count + consecutiveIncreaseCount <- consecutiveIncreaseCount + 1 + consecutiveDecreaseCount <- 0 + } else if (plotStatistics[i + 1] < plotStatistics[i]) { + # Increment the consecutive decrease count and reset increase count + consecutiveDecreaseCount <- consecutiveDecreaseCount + 1 + consecutiveIncreaseCount <- 0 + } else { + # Reset counts if neither increasing nor decreasing + consecutiveIncreaseCount <- 0 + consecutiveDecreaseCount <- 0 + } + + # Check if the count reaches k and record the offending sequence + if (consecutiveIncreaseCount >= k3) { + startIdx <- currentIndex - consecutiveIncreaseCount + r3 <- c(r3, startIdx + 1:(consecutiveIncreaseCount + 1)) + consecutiveIncreaseCount <- 0 # Reset to find next potential sequence + } + if (consecutiveDecreaseCount >= k3) { + startIdx <- currentIndex - consecutiveDecreaseCount + r3 <- c(r3, startIdx + 1:(consecutiveDecreaseCount + 1)) + consecutiveDecreaseCount <- 0 # Reset to find next potential sequence + } + + # Update currentIndex for the next iteration + currentIndex <- currentIndex + 1 + } + } + + # Rule 4: k points in a row, alternating increase and decrease + # if (ruleList[["rule4"]][["enabled"]] == TRUE) { + # k4 <- ruleList[["rule4"]][["k"]] + # r4 <- c() + # + # # Function to determine if two numbers alternate in increase/decrease pattern + # patternAlternates <- function(x, y) { + # return((x < 0 && y > 0) || (x > 0 && y < 0)) + # } + # + # # Calculate differences between consecutive points + # differences <- diff(plotStatistics) + # + # # Track the start index of the current alternating pattern + # startIdx <- NULL + # sequenceCount <- 0 + # + # for (i in 1:(length(differences) - 1)) { + # if (patternAlternates(differences[i], differences[i + 1])) { + # # If starting a new potential pattern + # if (is.null(startIdx)) { + # startIdx <- i + # } + # sequenceCount <- sequenceCount + 1 + # + # # If a valid sequence is found, capture indices + # if (sequenceCount >= (k4 - 1)) { + # r4 <- c(r4, seq(startIdx, startIdx + sequenceCount + 1)) + # startIdx <- NULL # Reset to find new sequences + # sequenceCount <- 0 + # } + # } else { + # startIdx <- startIdx # Reset if pattern breaks + # sequenceCount <- 0 + # } + # } + # } + + + # Rule 5: k out of k+1 points > 2 std. dev. from center line (same side) + + # Rule 6: k out of k+1 points > 1 std. dev. from center line (same side) + + # Rule 7: k points in a row within 1 std. dev from center line (either side) + + # Rule 8: k points in a row > 1 std. dev. from center line (either side) + + # Rule 9: Benneyan test, k successive points equal to 0 +} + .sdXbar <- function(df, type = c("s", "r"), unbiasingConstantUsed = TRUE) { type <- match.arg(type) diff --git a/inst/qml/variablesChartsSubgroups.qml b/inst/qml/variablesChartsSubgroups.qml index bd4d3014..b6b554a0 100644 --- a/inst/qml/variablesChartsSubgroups.qml +++ b/inst/qml/variablesChartsSubgroups.qml @@ -402,7 +402,7 @@ Form CheckBox { name: "xBarAndSUnbiasingConstant" - label: qsTr("Use unbiasing constant for X-bar & s contorl chart") + label: qsTr("Use unbiasing constant for X-bar & s control chart") checked: true } @@ -414,5 +414,159 @@ Form defaultValue: 3 min: 1 } + + Group + { + title: qsTr("Tests for control charts") + + DropDown + { + name: "testSet" + label: qsTr("Test set") + id: testSet + indexDefaultValue: 0 + values: [ + { label: qsTr("JASP"), value: "jaspDefault"}, + { label: qsTr("Nelson laws"), value: "nelsonLaws"}, + { label: qsTr("Western Electric rules"), value: "westernElectric"}, + { label: qsTr("Custom selection"), value: "custom"} + ] + } + + + CheckBox + { + name: "rule1" + label: qsTr("Points outside of control limits") + checked: true + enabled: testSet.currentValue == "custom" + } + + CheckBox + { + name: "rule2" + label: "" + checked: true + enabled: testSet.currentValue == "custom" + childrenOnSameRow: true + + IntegerField + { + name: "rule2Value" + afterLabel: qsTr("points in a row, on the same side of center line") + fieldWidth: 25 + defaultValue: testSet.currentValue == "nelsonLaws" ? 9 : testSet.currentValue == "westernElectric" ? 8 : 7 + min: 2 + } + } + + CheckBox + { + name: "rule3" + label: "" + checked: testSet.currentValue != "westernElectric" + enabled: testSet.currentValue == "custom" + childrenOnSameRow: true + + IntegerField + { + name: "rule3Value" + afterLabel: qsTr("points in a row, all increasing or decreasing") + fieldWidth: 25 + defaultValue: testSet.currentValue == "nelsonLaws" ? 6 : 7 + min: 2 + } + } + + CheckBox + { + name: "rule4" + label: "" + checked: testSet.currentValue == "nelsonLaws" | testSet.currentValue == "custom" + enabled: testSet.currentValue == "custom" + childrenOnSameRow: true + + IntegerField + { + name: "rule4Value" + afterLabel: qsTr("points in a row, alternating increase and decrease") + fieldWidth: 25 + defaultValue: 14 + min: 2 + } + } + + CheckBox + { + name: "rule5" + label: "" + checked: testSet.currentValue != "jaspDefault" + enabled: testSet.currentValue == "custom" + childrenOnSameRow: true + + IntegerField + { + name: "rule5Value" + afterLabel: qsTr("out of k+1 points > 2 std. dev. from center line (same side)") + fieldWidth: 25 + defaultValue: 2 + min: 2 + } + } + + CheckBox + { + name: "rule6" + label: "" + checked: testSet.currentValue != "jaspDefault" + enabled: testSet.currentValue == "custom" + childrenOnSameRow: true + + IntegerField + { + name: "rule6Value" + afterLabel: qsTr("out of k+1 points > 1 std. dev. from center line (same side)") + fieldWidth: 25 + defaultValue: 4 + min: 2 + } + } + + CheckBox + { + name: "rule7" + label: "" + checked: testSet.currentValue == "nelsonLaws" | testSet.currentValue == "custom" + enabled: testSet.currentValue == "custom" + childrenOnSameRow: true + + IntegerField + { + name: "rule7Value" + afterLabel: qsTr("points in a row < 1 std. dev from center line (either side)") + fieldWidth: 25 + defaultValue: 15 + min: 2 + } + } + + CheckBox + { + name: "rule8" + label: "" + checked: testSet.currentValue == "nelsonLaws" | testSet.currentValue == "custom" + enabled: testSet.currentValue == "custom" + childrenOnSameRow: true + + IntegerField + { + name: "rule8Value" + afterLabel: qsTr("points in a row > 1 std. dev from center line (either side)") + fieldWidth: 25 + defaultValue: 8 + min: 2 + } + } + } } }