diff --git a/DESCRIPTION b/DESCRIPTION
index c290bf5f..253494d8 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -27,6 +27,7 @@ Imports:
jaspBase,
jaspDescriptives,
jaspGraphs,
+ lubridate,
mle.tools,
psych,
qcc,
diff --git a/NAMESPACE b/NAMESPACE
index a5e6edae..ccae865c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -13,6 +13,7 @@ export(msaType1Gauge)
export(probabilityOfDetection)
export(processCapabilityStudies)
export(timeWeightedCharts)
+export(rareEventCharts)
export(variablesChartsIndividuals)
export(variablesChartsSubgroups)
importFrom(jaspBase,.extractErrorMessage)
diff --git a/R/TimeWeightedCharts.R b/R/TimeWeightedCharts.R
index 9f385ade..b9109695 100644
--- a/R/TimeWeightedCharts.R
+++ b/R/TimeWeightedCharts.R
@@ -1,216 +1,222 @@
#' @export
timeWeightedCharts <- function(jaspResults, dataset, options) {
- variables <- options[["measurements"]]
- numeric_variables <- variables[variables != ""]
- dataset <- .readDataSetToEnd(columns.as.numeric = numeric_variables, exclude.na.listwise = numeric_variables)
- #Checking for errors in the dataset
- .hasErrors(dataset, type = c('infinity', 'missingValues'),
- all.target = options[["measurements"]], exitAnalysisIfErrors = TRUE)
-
- ready <- length(variables) > 0
-
- if (length(variables) > 0) {
- #Cusum chart
- if (options[["cumulativeSumChart"]] && is.null(jaspResults[["CusumPlot"]])) {
- jaspResults[["CusumPlot"]] <- createJaspPlot(title = gettext("Cumulative sum chart"), width = 1200, height = 500)
- jaspResults[["CusumPlot"]]$dependOn(c("cumulativeSumChart", "measurements"))
- jaspResults[["CusumPlot"]]$plotObject <- .Cusumchart(dataset = dataset, options = options, ready = ready)
+ wideFormat <- (options[["dataFormat"]] == "wideFormat")
+ # In wide format we have one subgroup per row, else we need a either a grouping variable or later specify subgroup size manually
+ if (wideFormat) {
+ measurements <- unlist(options[["measurementsWideFormat"]])
+ stages <- options[["stagesWideFormat"]]
+ axisLabels <- options[["axisLabels"]]
+ factorVariables <- c(axisLabels, stages)
+ } else {
+ measurements <- options[["measurementLongFormat"]]
+ stages <- options[["stagesLongFormat"]]
+ # Workaround to create subgroups of size 1 in long format while still using axis labels, but not creating a whole separate variable form
+ if (options[["subgroupSizeType"]] == "individual") {
+ axisLabels <- options[["subgroup"]]
+ options[["subgroupSizeType"]] <- "manual"
+ options[["manualSubgroupSizeValue"]] <- 1
+ subgroupVariable <- ""
+ } else {
+ subgroupVariable <- options[["subgroup"]]
+ axisLabels <- ""
}
- #EWMA chart
- if (options[["exponentiallyWeightedMovingAverageChart"]] && is.null(jaspResults[["EWMAPlot"]])) {
- jaspResults[["EWMAPlot"]] <- createJaspPlot(title = gettext("Exponentially weighted moving average chart"), width = 1200, height = 500)
- jaspResults[["EWMAPlot"]]$dependOn(c("ExponentiallyWeightedMovingAverageChart", "measurements"))
- jaspResults[["EWMAPlot"]]$plotObject <- .EWMA(dataset = dataset, options = options, ready = ready)
+ factorVariables <- c(axisLabels, subgroupVariable, stages)
+ }
+
+ measurements <- measurements[measurements != ""]
+ factorVariables <- factorVariables[factorVariables != ""]
+
+ # Check if analysis is ready
+ if (wideFormat) {
+ ready <- length(measurements) >= 1
+ } else if (!wideFormat && options[["subgroupSizeType"]] == "manual"){
+ ready <- length(measurements) == 1
+ } else if (!wideFormat && options[["subgroupSizeType"]] == "groupingVariable") {
+ ready <- length(measurements) == 1 && subgroupVariable != ""
+ }
+
+ # Data reading
+ if (is.null(dataset) && ready) {
+ if (length(factorVariables) >= 1) {
+ dataset <- .readDataSetToEnd(columns.as.numeric = measurements, columns.as.factor = factorVariables)
+ } else {
+ dataset <- .readDataSetToEnd(columns.as.numeric = measurements)
+ }
+ }
+ if (!wideFormat && !identical(subgroupVariable, "")) # empty strings should also be treated as NA
+ dataset[,subgroupVariable][dataset[[subgroupVariable]] == ""] <- NA
+
+ # error handling
+ .hasErrors(dataset, type = c('infinity'),
+ infinity.target = c(measurements, options$subgroup),
+ exitAnalysisIfErrors = TRUE)
+
+ # warning handling
+ if (ready) {
+ plotNotes <- ""
+ if (!identical(stages, "")) {
+ if ((!wideFormat && options[["subgroupSizeType"]] == "manual" &&
+ any(lapply(split(dataset[[stages]], ceiling(seq_along(dataset[[stages]])/options[["manualSubgroupSizeValue"]])), FUN = function(x)length(unique(x))) > 1)) ||
+ (!wideFormat && options[["subgroupSizeType"]] == "groupingVariable" &&
+ any(table(dplyr::count_(dataset, vars = c(stages, subgroupVariable))[subgroupVariable]) > 1))) {
+ plotNotes <- paste0(plotNotes, gettext("One or more subgroups are assigned to more than one stage, only first stage is considered.
"))
+ }
+ if (anyNA(dataset[[stages]])) {
+ nDroppedStageRows <- sum(is.na(dataset[[stages]]))
+ dataset <- dataset[!is.na(dataset[[stages]]),]
+ removalType <- if (wideFormat) "subgroup(s)" else "observation(s)"
+ plotNotes <- paste0(plotNotes, gettextf("Removed %1$i %2$s that were not assigned to any stage.
", nDroppedStageRows, removalType))
+ }
+ }
+
+ if (!wideFormat && options[["subgroupSizeType"]] == "groupingVariable" && anyNA(dataset[[subgroupVariable]])) {
+ nDroppedSubgroupRows <- sum(is.na(dataset[[subgroupVariable]]))
+ dataset <- dataset[!is.na(dataset[[subgroupVariable]]),]
+ plotNotes <- paste0(plotNotes, gettextf("Removed %i observation(s) that were not assigned to any subgroups.
", nDroppedSubgroupRows))
}
- #G chart
- if (options[["gChart"]] && is.null(jaspResults[["GPlot"]])) {
- jaspResults[["GPlot"]] <- createJaspPlot(title = gettext("G chart"), width = 1200, height = 500)
- jaspResults[["GPlot"]]$dependOn(c("gChart", "measurements"))
- jaspResults[["GPlot"]]$plotObject <- .Gchart(dataset = dataset, options = options, ready = ready)$p
+ }
+
+ # Rearrange data if not already wide format (one group per row)
+ if (!wideFormat && ready) {
+ reshapeOutputList <- .reshapeSubgroupDataLongToWide(dataset, measurements, stages = stages, subgroupVariable = subgroupVariable,
+ subgroupSizeType = options[["subgroupSizeType"]],
+ manualSubgroupSizeValue = options[["manualSubgroupSizeValue"]],
+ subgroupVariableMethod = options[["groupingVariableMethod"]])
+ axisLabels <- if (axisLabels == "") reshapeOutputList$axisLabels else dataset[[axisLabels]]
+ dataset <- reshapeOutputList$dataset
+ measurements <- reshapeOutputList$measurements
+ xAxisTitle <- reshapeOutputList$xAxisTitle
+ } else if (wideFormat && ready) {
+ if (axisLabels != "") {
+ xAxisTitle <- options[["axisLabels"]]
+ axisLabels <- dataset[[axisLabels]]
+ } else {
+ xAxisTitle <- gettext("Sample")
}
- #T chart
- # if (options[["tChart"]] && is.null(jaspResults[["TPlot"]])) {
- # jaspResults[["TPlot"]] <- createJaspPlot(title = gettext("T chart"), width = 1200, height = 500)
- # jaspResults[["TPlot"]]$dependOn(c("tChart", "measurements"))
- # jaspResults[["TPlot"]]$plotObject <- .Tchart(dataset = dataset, options = options, ready = ready)$p
- # }
}
-}
-.Cusumchart <- function(dataset, options, ready) {
- if (!ready)
- return()
-
- data1 <- dataset[, options[["measurements"]]]
- sixsigma <- qcc::cusum(data1, decision.interval = options[["cumulativeSumChartNumberSd"]], se.shift = options[["cumulativeSumChartShiftSize"]], plot = FALSE)
- subgroups <- c(1:length(sixsigma$pos))
- data_plot <- data.frame(y_neg = sixsigma$neg , y_pos = sixsigma$pos, x = subgroups)
- center <- 0
- UCL <- sixsigma$decision.interval
- LCL <- -UCL
- yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(LCL, UCL, data_plot$y_neg, data_plot$y_pos))
- yLimits <- range(yBreaks)
- if (length(subgroups) > 60)
- xBreaks <- c(1,jaspGraphs::getPrettyAxisBreaks(subgroups)[-1])
- else
- xBreaks <- c(subgroups)
- xLimits <- c(1,max(xBreaks) + 2.5)
- dfLabel <- data.frame(
- x = max(xLimits - 1),
- y = c(center, UCL, LCL),
- l = c(
- gettextf("CL = %g", round(center, 4)),
- gettextf("UCL = %g", round(UCL, 5)),
- gettextf("LCL = %g", round(LCL, 5))
- )
- )
-
- p <- ggplot2::ggplot(data_plot, ggplot2::aes(x)) +
- ggplot2::geom_hline(yintercept = center, color = 'green') +
- ggplot2::geom_hline(yintercept = c(UCL, LCL), color = "red", linetype = "dashed", size = 1.5) +
- ggplot2::geom_label(data = dfLabel, mapping = ggplot2::aes(x = x, y = y, label = l),inherit.aes = FALSE, size = 4.5) +
- ggplot2::scale_y_continuous(name = gettext("Cumulative sum") ,limits = yLimits, breaks = yBreaks) +
- ggplot2::scale_x_continuous(name = gettext('Subgroups'), breaks = xBreaks, limits = range(xLimits)) +
- jaspGraphs::geom_line(ggplot2::aes(y = y_neg), col = "blue") +
- jaspGraphs::geom_line(ggplot2::aes(y = y_pos), col = "blue")+
- jaspGraphs::geom_point(ggplot2::aes(y = y_neg), size = 4, fill = ifelse(data_plot$y_neg < LCL, 'red', 'blue')) +
- jaspGraphs::geom_point(ggplot2::aes(y = y_pos), size = 4, fill = ifelse(data_plot$y_pos > UCL, 'red', 'blue')) +
- jaspGraphs::geom_rangeframe() +
- jaspGraphs::themeJaspRaw()
-
- return(p)
-}
-.EWMA <- function(dataset, options, ready) {
- if (!ready)
- return()
- decimals <- .numDecimals
- data1 <- dataset[, options[["measurements"]]]
- sixsigma <- qcc::ewma(data1, center = options[["exponentiallyWeightedMovingAverageChartCenter"]] , lambda = options[["exponentiallyWeightedMovingAverageChartLambda"]],
- std.dev = options[["exponentiallyWeightedMovingAverageChartSd"]], nsigmas = options[["exponentiallyWeightedMovingAverageChartSigmaControlLimits"]], plot = FALSE)
- subgroups <- 1:length(sixsigma$sizes)
- center <- sixsigma$center
- UCL <- sixsigma$limits[,2]
- LCL <- sixsigma$limits[,1]
- data_plot <- data.frame(y = sixsigma$y, x = subgroups, UCL = UCL, LCL = LCL)
- yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(LCL, UCL, data_plot$y))
- yLimits <- range(yBreaks)
- if (length(subgroups) > 60)
- xBreaks <- c(1,jaspGraphs::getPrettyAxisBreaks(subgroups)[-1])
- else
- xBreaks <- c(subgroups)
- xLimits <- c(1,max(xBreaks-0.5) * 1.15)
- UCL.label <- center + options[["exponentiallyWeightedMovingAverageChartSigmaControlLimits"]] * sqrt(options[["exponentiallyWeightedMovingAverageChartLambda"]] / (2-options[["exponentiallyWeightedMovingAverageChartLambda"]])) * options[["exponentiallyWeightedMovingAverageChartSd"]]
- LCL.label <- center - options[["exponentiallyWeightedMovingAverageChartSigmaControlLimits"]] * sqrt(options[["exponentiallyWeightedMovingAverageChartLambda"]] / (2-options[["exponentiallyWeightedMovingAverageChartLambda"]])) * options[["exponentiallyWeightedMovingAverageChartSd"]]
- dfLabel <- data.frame(
- x = max(xLimits) * 0.95,
- y = c(center, UCL.label, LCL.label),
- l = c(
- gettextf("CL = %g", round(center, decimals + 1)),
- gettextf("UCL = %g", round(UCL.label, decimals + 2)),
- gettextf("LCL = %g", round(LCL.label, decimals + 2))
- )
- )
-
- p <- ggplot2::ggplot(data_plot, ggplot2::aes(x = x, y = y)) +
- ggplot2::geom_step(ggplot2::aes(x = x, y = UCL, color = "red"),linetype = "dashed", size = 1.5) +
- ggplot2::geom_step(ggplot2::aes(x = x, y = LCL, color = "red"), linetype = "dashed", size = 1.5) +
- ggplot2::geom_hline(yintercept = center, color = 'green') +
- ggplot2::geom_label(data = dfLabel, mapping = ggplot2::aes(x = x, y = y, label = l),inherit.aes = FALSE, size = 4.5) +
- ggplot2::scale_y_continuous(name = gettext("EWMA") ,limits = yLimits, breaks = yBreaks) +
- ggplot2::scale_x_continuous(name = gettext('Subgroup'), breaks = xBreaks, limits = range(xLimits)) +
- ggplot2::geom_line(color = "blue") +
- jaspGraphs::geom_point(size = 4, fill = ifelse(data_plot$y > UCL | data_plot$y < LCL, 'red', 'blue')) +
- jaspGraphs::geom_rangeframe() +
- jaspGraphs::themeJaspRaw()
-
- return(p)
+ #Cusum chart
+ if (options[["cumulativeSumChart"]]) {
+ cusumChart <- .Cusumchart(dataset = dataset, measurements = measurements, stages = stages,
+ axisLabels = axisLabels, options = options, ready = ready)
+ }
+ #EWMA chart
+ if (options[["exponentiallyWeightedMovingAverageChart"]]) {
+ ewmaPlot <- .EWMA(dataset = dataset, measurements = measurements, stages = stages,
+ axisLabels = axisLabels, options = options, ready = ready)
+ }
+
+
+ # Report
+ if (options[["report"]]) {
+ reportPlot <- createJaspPlot(title = gettext("Time weighted charts report"), width = 1250, height = 1000)
+ jaspResults[["report"]] <- reportPlot
+ jaspResults[["report"]]$dependOn(c("dataFormat", "measurementLongFormat", "subgroup", "stagesLongFormat", "measurementsWideFormat",
+ "axisLabels", "stagesWideFormat", "subgroupSizeType", "manualSubgroupSizeValue",
+ "groupingVariableMethod", "cumulativeSumChart", "cumulativeSumChartNumberSd",
+ "cumulativeSumChartShiftSize", "cumulativeSumChartTarget", "cumulativeSumChartSdSource",
+ "cumulativeSumChartSdMethod", "cumulativeSumChartSdValue", "cumulativeSumChartAverageMovingRangeLength",
+ "exponentiallyWeightedMovingAverageChart", "exponentiallyWeightedMovingAverageChartSigmaControlLimits",
+ "exponentiallyWeightedMovingAverageChartLambda", "exponentiallyWeightedMovingAverageChartSdSource",
+ "exponentiallyWeightedMovingAverageChartSdMethod", "exponentiallyWeightedMovingAverageChartSdValue",
+ "exponentiallyWeightedMovingAverageChartMovingRangeLength", "report", "reportMetaData",
+ "reportTitle", "reportTitleText", "reportChartName", "reportChartNameText", "reportSubtitle",
+ "reportSubtitleText", "reportMeasurementName", "reportMeasurementNameText", "reportFootnote",
+ "reportFootnoteText", "reportLocation", "reportLocationText", "reportDate", "reportDateText",
+ "reportPerformedBy", "reportPerformedByText", "reportPrintDate", "reportPrintDateText"))
+
+ # Plot meta data
+ if (options[["reportTitle"]] ) {
+ title <- if (options[["reportTitleText"]] == "") gettext("Time weighted charts report") else options[["reportTitleText"]]
+ } else {
+ title <- ""
+ }
+
+ if (options[["reportMetaData"]]) {
+ text <- c()
+ text <- if (options[["reportChartName"]]) c(text, gettextf("Chart name: %s", options[["reportChartNameText"]])) else text
+ text <- if (options[["reportSubtitle"]]) c(text, gettextf("Sub-title: %s", options[["reportSubtitleText"]])) else text
+ text <- if (options[["reportMeasurementName"]]) c(text, gettextf("Measurement name: %s", options[["reportMeasurementNameText"]])) else text
+ text <- if (options[["reportFootnote"]]) c(text, gettextf("Footnote: %s", options[["reportFootnoteText"]])) else text
+ text <- if (options[["reportLocation"]]) c(text, gettextf("Location: %s", options[["reportLocationText"]])) else text
+ text <- if (options[["reportDate"]]) c(text, gettextf("Date: %s", options[["reportDateText"]])) else text
+ text <- if (options[["reportPerformedBy"]]) c(text, gettextf("Performed by: %s", options[["reportPerformedByText"]])) else text
+ text <- if (options[["reportPrintDate"]]) c(text, gettextf("Print date: %s", options[["reportPrintDateText"]])) else text
+ } else {
+ text <- NULL
+ }
+
+ plots <- list()
+ if (options[["cumulativeSumChart"]])
+ plots[["cusum"]] <- cusumChart$plotObject
+ if (options[["exponentiallyWeightedMovingAverageChart"]])
+ plots[["ewma"]] <- ewmaPlot$plotObject
+ reportPlotObject <- .qcReport(text = text, plots = plots, textMaxRows = 8,
+ reportTitle = title)
+ reportPlot$plotObject <- reportPlotObject
+
+ ###
+ ### If not report mode
+ ###
+ } else {
+ if (options[["cumulativeSumChart"]])
+ jaspResults[["CusumChart"]] <- cusumChart
+ if (options[["exponentiallyWeightedMovingAverageChart"]])
+ jaspResults[["EWMAPlot"]] <- ewmaPlot
+ }
}
-.Gchart <- function(dataset, options, ready){
+
+.Cusumchart <- function(dataset, measurements, stages, axisLabels, options, ready) {
+
+ plot <- createJaspPlot(title = gettext("Cumulative sum chart"), width = 1200, height = 500)
+ plot$dependOn(c("dataFormat", "measurementLongFormat", "subgroup", "stagesLongFormat", "measurementsWideFormat",
+ "axisLabels", "stagesWideFormat", "subgroupSizeType", "manualSubgroupSizeValue",
+ "groupingVariableMethod", "cumulativeSumChart", "cumulativeSumChartNumberSd",
+ "cumulativeSumChartShiftSize", "cumulativeSumChartTarget", "cumulativeSumChartSdSource",
+ "cumulativeSumChartSdMethod", "cumulativeSumChartSdValue", "cumulativeSumChartAverageMovingRangeLength",
+ "report"))
+
if (!ready)
- return()
-
- data1 <- dataset[, options[["measurements"]]]
- subgroups <- c(1:length(data1))
- data_plot <- data.frame(x = subgroups, y = data1)
- center = mean(data1)
- UCL = center+3*sqrt(center*(center + 1))
- LCL = center-3*sqrt(center*(center + 1))
- LCL <- ifelse(LCL < 0 , 0, LCL)
- sixsigma <- list(statistics = data1, limits = data.frame(LCL, UCL), center = center)
- yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(LCL, UCL, data_plot$y))
- yLimits <- range(yBreaks)
- if (length(subgroups) > 60)
- xBreaks <- c(1,jaspGraphs::getPrettyAxisBreaks(subgroups)[-1])
- else
- xBreaks <- c(subgroups)
- xLimits <- c(1,max(xBreaks) + 2.5)
- dfLabel <- data.frame(
- x = max(xLimits - 1),
- y = c(center, UCL, LCL),
- l = c(
- gettextf("CL = %g", round(center, 4)),
- gettextf("UCL = %g", round(UCL, 5)),
- gettextf("LCL = %g", round(LCL, 5))
- )
- )
-
- p <- ggplot2::ggplot(data_plot, ggplot2::aes(x = x, y = y)) +
- ggplot2::geom_line(ggplot2::aes(x = x, y = UCL, color = "red"),linetype = "dashed", size = 1.5) +
- ggplot2::geom_line(ggplot2::aes(x = x, y = LCL, color = "red"), linetype = "dashed", size = 1.5) +
- ggplot2::geom_hline(yintercept = center, color = 'green') +
- ggplot2::geom_label(data = dfLabel, mapping = ggplot2::aes(x = x, y = y, label = l),inherit.aes = FALSE, size = 4.5) +
- ggplot2::scale_y_continuous(name = gettext("Counts") ,limits = yLimits, breaks = yBreaks) +
- ggplot2::scale_x_continuous(name = gettext('Subgroup'), breaks = xBreaks, limits = range(xLimits)) +
- ggplot2::geom_line(color = "blue") +
- jaspGraphs::geom_point(size = 4, fill = ifelse(data_plot$y > UCL | data_plot$y < LCL, 'red', 'blue')) +
- jaspGraphs::geom_rangeframe() +
- jaspGraphs::themeJaspRaw()
-
- return(list(p = p, sixsigma = sixsigma))
+ return(plot)
+
+
+ columnsToPass <- c(measurements, stages)
+ columnsToPass <- columnsToPass[columnsToPass != ""]
+ phase2 <- (options[["cumulativeSumChartSdSource"]] == "historical")
+ plotObject <- .controlChart(dataset[columnsToPass], plotType = "cusum", stages = stages, xBarSdType = options[["cumulativeSumChartSdMethod"]],
+ nSigmasControlLimits = options[["cumulativeSumChartNumberSd"]], xAxisLabels = axisLabels,
+ cusumShiftSize = options[["cumulativeSumChartShiftSize"]], cusumTarget = options[["cumulativeSumChartTarget"]],
+ movingRangeLength = options[["cumulativeSumChartAverageMovingRangeLength"]], phase2 = phase2,
+ phase2Sd = options[["cumulativeSumChartSdValue"]])$plotObject
+
+ plot$plotObject <- plotObject
+ return(plot)
}
-.Tchart <- function(dataset, options){
+
+.EWMA <- function(dataset, measurements, stages, axisLabels, options, ready) {
+
+ plot <- createJaspPlot(title = gettext("Exponentially weighted moving average chart"), width = 1200, height = 500)
+ plot$dependOn(c("dataFormat", "measurementLongFormat", "subgroup", "stagesLongFormat", "measurementsWideFormat",
+ "axisLabels", "stagesWideFormat", "subgroupSizeType", "manualSubgroupSizeValue",
+ "groupingVariableMethod", "exponentiallyWeightedMovingAverageChart",
+ "exponentiallyWeightedMovingAverageChartSigmaControlLimits", "exponentiallyWeightedMovingAverageChartLambda",
+ "exponentiallyWeightedMovingAverageChartSdSource", "exponentiallyWeightedMovingAverageChartSdMethod",
+ "exponentiallyWeightedMovingAverageChartSdValue", "exponentiallyWeightedMovingAverageChartMovingRangeLength",
+ "report"))
+
if (!ready)
- return()
-
- data1 <- dataset[, options[["measurements"]]]
- subgroups <- c(1:length(data1))
- data_plot <- data.frame(x = subgroups , y = data1^0.2777)
- data2 <- data.frame(process = data1)
- MR_T <- qcc::qcc(matrix(cbind(data2$process[1:length(data2$process)-1], data2$process[2:length(data2$process)]), ncol=2)
- , type="R", plot = FALSE)$statistics
- center = mean(data_plot$y)^3.6
- UCL = (mean(data_plot$y) + 2.66 * mean(MR_T))^3.6
- LCL = (mean(data_plot$y, na.rm = TRUE) - 2.66 * mean(MR_T, na.rm =))^3.6
- LCL <- ifelse(LCL < 0 , 0, LCL)
- sixsigma <- list(statistics = data1, limits = data.frame(LCL, UCL), center = center)
- yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(LCL, UCL, data_plot$y))
- yLimits <- range(yBreaks)
- if (length(subgroups) > 60)
- xBreaks <- c(1,jaspGraphs::getPrettyAxisBreaks(subgroups)[-1])
- else
- xBreaks <- c(subgroups)
- xLimits <- c(1,max(xBreaks) + 2.5)
- dfLabel <- data.frame(
- x = max(xLimits - 1),
- y = c(center, UCL, LCL),
- l = c(
- gettextf("CL = %g", round(center, 4)),
- gettextf("UCL = %g", round(UCL, 5)),
- gettextf("LCL = %g", round(LCL, 5))
- )
- )
-
- p <- ggplot2::ggplot(data_plot, ggplot2::aes(x = x, y = y)) +
- ggplot2::geom_line(ggplot2::aes(x = x, y = UCL, color = "red"),linetype = "dashed", linewidth = 1.5) +
- ggplot2::geom_line(ggplot2::aes(x = x, y = LCL, color = "red"), linetype = "dashed", linewidth = 1.5) +
- ggplot2::geom_hline(yintercept = center, color = 'green') +
- ggplot2::geom_label(data = dfLabel, mapping = ggplot2::aes(x = x, y = y, label = l), inherit.aes = FALSE, size = 4.5) +
- ggplot2::scale_y_continuous(name = gettext("Counts") ,limits = yLimits, breaks = yBreaks) +
- ggplot2::scale_x_continuous(name = gettext('Subgroup'), breaks = xBreaks, limits = range(xLimits)) +
- ggplot2::geom_line(color = "blue") +
- jaspGraphs::geom_point(size = 4, fill = ifelse(data_plot$y > UCL | data_plot$y < LCL, 'red', 'blue')) +
- jaspGraphs::geom_rangeframe() +
- jaspGraphs::themeJaspRaw()
-
- return(list(p = p, sixsigma = sixsigma))
+ return(plot)
+
+ columnsToPass <- c(measurements, stages)
+ columnsToPass <- columnsToPass[columnsToPass != ""]
+ phase2 <- (options[["exponentiallyWeightedMovingAverageChartSdSource"]] == "historical")
+ plotObject <- .controlChart(dataset[columnsToPass], plotType = "ewma", stages = stages, xBarSdType = options[["exponentiallyWeightedMovingAverageChartSdMethod"]],
+ nSigmasControlLimits = options[["exponentiallyWeightedMovingAverageChartSigmaControlLimits"]],
+ xAxisLabels = axisLabels, movingRangeLength = options[["exponentiallyWeightedMovingAverageChartMovingRangeLength"]],
+ ewmaLambda = options[["exponentiallyWeightedMovingAverageChartLambda"]], phase2 = phase2,
+ phase2Sd = options[["exponentiallyWeightedMovingAverageChartSdValue"]])$plotObject
+
+ plot$plotObject <- plotObject
+ return(plot)
}
+
diff --git a/R/commonQualityControl.R b/R/commonQualityControl.R
index 03435fe3..04225272 100644
--- a/R/commonQualityControl.R
+++ b/R/commonQualityControl.R
@@ -225,10 +225,10 @@ NelsonLaws <- function(data, allsix = FALSE, chart = "i", xLabels = NULL) {
warnings[i,] <- warningsRaw
}
} else {
- lcl <- ifelse(is.nan(data$limits[1,1]) || is.na(data$limits[1,1]), NA, data$limits[1,1])
- ucl <- ifelse(is.nan(data$limits[1,2]) || is.na(data$limits[1,2]), NA, data$limits[1,2])
- warnings <- Rspc::EvaluateRules(x = data$statistics, type = chart, lcl = lcl, ucl = ucl, cl = data$center[1], parRules = pars,
- whichRules = c(1:3,5,7:8))
+ lcl <- ifelse(is.nan(data$limits[1,1]) || is.na(data$limits[1,1]), NA, data$limits[1,1])
+ ucl <- ifelse(is.nan(data$limits[1,2]) || is.na(data$limits[1,2]), NA, data$limits[1,2])
+ warnings <- Rspc::EvaluateRules(x = data$statistics, type = chart, lcl = lcl, ucl = ucl, cl = data$center[1], parRules = pars,
+ whichRules = c(1:3,5,7:8))
}
if (allsix) {
@@ -272,7 +272,7 @@ NelsonLaws <- function(data, allsix = FALSE, chart = "i", xLabels = NULL) {
# exclude groups with single observation from calculation
rowRemovalIndex <- which(apply(df, 1, function(x) sum(!is.na(x)) < 2)) # get index of rows with less than 2 obs.
- if (length(rowRemovalIndex) > 0)
+ if (length(rowRemovalIndex) > 0)
df <- df[-rowRemovalIndex, ]
# return sdWithin = 0 if no groups have more than 1 obs
@@ -318,6 +318,8 @@ NelsonLaws <- function(data, allsix = FALSE, chart = "i", xLabels = NULL) {
KnownControlStats.RS <- function(N, sigma = 3) {
+ # d2 and d3 are unbiasing constants as reported in D. J. Wheeler and D. S. Chambers. (1992). Understanding Statistical Process Control, Second Edition, SPC Press, Inc.
+
Data.d3 <- data.frame(
n = 0:25,
d3 = c(NA, NA, 0.8525 ,0.8884, 0.8798, 0.8641, 0.8480, 0.8332, 0.8198, 0.8078, 0.7971, 0.7873, 0.7785, 0.7704, 0.7630,
@@ -326,9 +328,9 @@ KnownControlStats.RS <- function(N, sigma = 3) {
Data.d2 <- data.frame(
n = 0:50,
d2 = c(NA, NA, 1.128, 1.693 ,2.059, 2.326, 2.534, 2.704, 2.847, 2.970, 3.078, 3.173, 3.258, 3.336, 3.407, 3.472, 3.532,
- 3.588 ,3.640 ,3.689, 3.735, 3.778, 3.819, 3.858, 3.895, 3.931, 3.964, 3.997, 4.027, 4.057, 4.086, 4.113,
- 4.139 ,4.165 ,4.189, 4.213, 4.236, 4.259, 4.280, 4.301, 4.322, 4.341, 4.361, 4.379, 4.398, 4.415, 4.433,
- 4.450 ,4.466, 4.482, 4.498))
+ 3.588 ,3.640 ,3.689, 3.735, 3.778, 3.819, 3.858, 3.895, 3.931, 3.964, 3.997, 4.027, 4.057, 4.086, 4.113,
+ 4.139 ,4.165 ,4.189, 4.213, 4.236, 4.259, 4.280, 4.301, 4.322, 4.341, 4.361, 4.379, 4.398, 4.415, 4.433,
+ 4.450 ,4.466, 4.482, 4.498))
if (N > 25 && N <= 50){
d3 <- 0.80818 - 0.0051871 * N + 0.00005098 * N^2 - 0.00000019 * N^3
@@ -393,24 +395,32 @@ KnownControlStats.RS <- function(N, sigma = 3) {
return(list(LCL = LCLvector, UCL = UCLvector))
}
-.controlChart <- function(dataset, plotType = c("xBar", "R", "I", "MR", "MMR", "s"),
- stages = "",
- xBarSdType = c("r", "s"),
- nSigmasControlLimits = 3,
- phase2 = FALSE,
- phase2Mu = "",
- phase2Sd = "",
- fixedSubgroupSize = "",
- warningLimits = FALSE,
- specificationLimits = NA,
- xAxisLabels = "",
- tableLabels = "",
- xAxisTitle = gettext("Sample"),
- movingRangeLength = 2,
- clLabelSize = 4.5,
- stagesSeparateCalculation = TRUE,
- unbiasingConstantUsed = TRUE
- ) {
+.controlChart <- function(dataset, plotType = c("xBar", "R", "I", "MR", "MMR", "s", "cusum", "ewma", "g", "t"),
+ stages = "",
+ xBarSdType = c("r", "s"),
+ nSigmasControlLimits = 3,
+ phase2 = FALSE,
+ phase2Mu = "",
+ phase2Sd = "",
+ fixedSubgroupSize = "",
+ warningLimits = FALSE,
+ specificationLimits = NA,
+ xAxisLabels = "",
+ tableLabels = "",
+ xAxisTitle = gettext("Sample"),
+ movingRangeLength = 2,
+ clLabelSize = 4.5,
+ stagesSeparateCalculation = TRUE,
+ unbiasingConstantUsed = TRUE,
+ cusumShiftSize = 0.5,
+ cusumTarget = 0,
+ ewmaLambda = 0.3,
+ gAndtUnit = c("days", "hours", "minutes", "opportunities"),
+ phase2gChartProportion = 0.5,
+ tChartDistribution = c("weibull", "exponential"),
+ phase2tChartDistributionShape = 1,
+ phase2tChartDistributionScale = 3
+) {
plotType <- match.arg(plotType)
# This function returns all the needed data for the plot and table: data for the points, the limits, the labels and a list of point violations for the table
@@ -418,7 +428,11 @@ KnownControlStats.RS <- function(N, sigma = 3) {
nSigmasControlLimits = nSigmasControlLimits, phase2 = phase2,
phase2Mu = phase2Mu, phase2Sd = phase2Sd, fixedSubgroupSize = fixedSubgroupSize,
warningLimits = warningLimits, movingRangeLength = movingRangeLength,
- stagesSeparateCalculation = stagesSeparateCalculation, unbiasingConstantUsed = unbiasingConstantUsed)
+ stagesSeparateCalculation = stagesSeparateCalculation, unbiasingConstantUsed = unbiasingConstantUsed,
+ cusumShiftSize = cusumShiftSize, cusumTarget = cusumTarget, ewmaLambda = ewmaLambda,
+ tChartDistribution = tChartDistribution, phase2tChartDistributionShape = phase2tChartDistributionShape,
+ phase2tChartDistributionScale = phase2tChartDistributionScale,
+ phase2gChartProportion = phase2gChartProportion)
# This function turns the point violation list into a JASP table
@@ -430,25 +444,32 @@ KnownControlStats.RS <- function(N, sigma = 3) {
stageLabels = controlChartData$stageLabels, clLabels = controlChartData$clLabels,
plotType = plotType, stages = stages, phase2 = phase2, warningLimits = warningLimits,
xAxisLabels = xAxisLabels, xAxisTitle = xAxisTitle, clLabelSize = clLabelSize,
- specificationLimits = specificationLimits)
+ specificationLimits = specificationLimits, gAndtUnit = gAndtUnit)
return(list(plotObject = plotObject, table = table, controlChartData = controlChartData))
}
-.controlChart_calculations <- function(dataset, plotType = c("xBar", "R", "I", "MR", "MMR", "s"),
- stages = "",
- xBarSdType = c("r", "s"),
- nSigmasControlLimits = 3,
- phase2 = FALSE,
- phase2Mu = "",
- phase2Sd = "",
- fixedSubgroupSize = "",
- warningLimits = FALSE,
- movingRangeLength = 2,
- stagesSeparateCalculation = TRUE,
- unbiasingConstantUsed = TRUE
- ) {
+.controlChart_calculations <- function(dataset, plotType = c("xBar", "R", "I", "MR", "MMR", "s", "cusum", "ewma", "g", "t"),
+ stages = "",
+ xBarSdType = c("r", "s"),
+ nSigmasControlLimits = 3,
+ phase2 = FALSE,
+ phase2Mu = "",
+ phase2Sd = "",
+ fixedSubgroupSize = "",
+ warningLimits = FALSE,
+ movingRangeLength = 2,
+ stagesSeparateCalculation = TRUE,
+ unbiasingConstantUsed = TRUE,
+ cusumShiftSize = 0.5,
+ cusumTarget = 0,
+ ewmaLambda = 0.3,
+ phase2gChartProportion = 0.5,
+ tChartDistribution = c("weibull", "exponential"),
+ phase2tChartDistributionShape = 1,
+ phase2tChartDistributionScale = 3
+) {
plotType <- match.arg(plotType)
if (identical(stages, "")) {
nStages <- 1
@@ -512,11 +533,11 @@ KnownControlStats.RS <- function(N, sigma = 3) {
LCL <- limits[1]
UCL <- limits[2]
center <- qccObject$center
- ###
- ### Calculations for R chart
- ###
+ ###
+ ### Calculations for R chart
+ ###
} else if (plotType == "R") {
- n <- if (!identical(fixedSubgroupSize, "")) fixedSubgroupSize else apply(dataCurrentStage, 1, function(x) return(sum(!is.na(x)))) # returns the number of non NA values per row
+ n <- if (!identical(fixedSubgroupSize, "")) fixedSubgroupSize else rowSums(!is.na(dataCurrentStage)) # returns the number of non NA values per row
# manually calculate mean and sd as the package gives wrong results with NAs
if(phase2) {
sigma <- phase2Sd
@@ -537,9 +558,9 @@ KnownControlStats.RS <- function(N, sigma = 3) {
center <- mu
UCL <- limits$UCL
LCL <- limits$LCL
- ###
- ### Calculations for X-bar chart
- ###
+ ###
+ ### Calculations for X-bar chart
+ ###
} else if (plotType == "xBar") {
xBarSdType <- match.arg(xBarSdType)
if (phase2) {
@@ -556,7 +577,7 @@ KnownControlStats.RS <- function(N, sigma = 3) {
}
qccObject <- qcc::qcc(dataCurrentStage, type ='xbar', plot = FALSE, center = mu, sizes = ncol(dataCurrentStage), std.dev = sigma, nsigmas = nSigmasControlLimits)
plotStatistic <- qccObject$statistics
- n <- if (!identical(fixedSubgroupSize, "")) fixedSubgroupSize else apply(dataCurrentStage, 1, function(x) return(sum(!is.na(x)))) # returns the number of non NA values per row
+ n <- if (!identical(fixedSubgroupSize, "")) fixedSubgroupSize else rowSums(!is.na(dataCurrentStage)) # returns the number of non NA values per row
limits <- .controlLimits(mu, sigma, n = n, type = "xbar", k = nSigmasControlLimits)
center <- mu
UCL <- limits$UCL
@@ -569,11 +590,11 @@ KnownControlStats.RS <- function(N, sigma = 3) {
LWL1 <- WL1$LCL
UWL2 <- WL2$UCL
LWL2 <- WL2$LCL
- ###
- ### Calculations for S chart
- ###
+ ###
+ ### Calculations for S chart
+ ###
} else if (plotType == "s") {
- if(phase2) {
+ if (phase2) {
sigma <- phase2Sd
} else if (stagesSeparateCalculation) {
sigma <- .sdXbar(df = dataCurrentStage, type = "s", unbiasingConstantUsed = unbiasingConstantUsed)
@@ -583,7 +604,7 @@ KnownControlStats.RS <- function(N, sigma = 3) {
}
qccObject <- qcc::qcc(dataCurrentStage, type ='S', plot = FALSE, center = sigma, sizes = ncol(dataCurrentStage), nsigmas = nSigmasControlLimits)
plotStatistic <- qccObject$statistics
- n <- if (!identical(fixedSubgroupSize, "")) fixedSubgroupSize else apply(dataCurrentStage, 1, function(x) return(sum(!is.na(x)))) # returns the number of non NA values per row
+ n <- if (!identical(fixedSubgroupSize, "")) fixedSubgroupSize else rowSums(!is.na(dataCurrentStage)) # returns the number of non NA values per row
limits <- .controlLimits(sigma = sigma, n = n, type = "s", unbiasingConstantUsed = unbiasingConstantUsed, k = nSigmasControlLimits)
if (unbiasingConstantUsed) {
c4s <- sapply(n, function(x) return(KnownControlStats.RS(x, 0)$constants[3]))
@@ -593,15 +614,109 @@ KnownControlStats.RS <- function(N, sigma = 3) {
}
UCL <- limits$UCL
LCL <- limits$LCL
+ ###
+ ### Calculations for cusum chart
+ ###
+ } else if (plotType == "cusum") {
+ n <- if (!identical(fixedSubgroupSize, "")) fixedSubgroupSize else rowSums(!is.na(dataCurrentStage)) # returns the number of non NA values per row
+ # sigma for subgroup size = 1 is calculated as the average moving range sd
+ if (phase2) {
+ sigma <- as.numeric(phase2Sd)
+ } else if (all(n == 1)) {
+ k <- movingRangeLength
+ dataCurrentStageVector <- unlist(dataCurrentStage)
+ mrMatrix <- matrix(dataCurrentStageVector[seq((k), length(dataCurrentStageVector))]) # remove first k - 1 elements
+ for (j in seq(1, k-1)) {
+ mrMatrix <- cbind(mrMatrix, matrix(dataCurrentStageVector[seq(k-j, length(dataCurrentStageVector)-j)]))
+ }
+ meanMovingRange <- mean(.rowRanges(mrMatrix)$ranges, na.rm = TRUE)
+ d2 <- KnownControlStats.RS(k)$constants[1]
+ sigma <- meanMovingRange/d2
+ # sigma for subgroup size > 1
+ } else {
+ sigma <- .sdXbar(dataCurrentStage, type = xBarSdType, unbiasingConstantUsed = unbiasingConstantUsed)
+ }
+ plotStatisticUpper <- .cusumPoints(dataCurrentStage, sigma, n, cusumTarget, cusumShiftSize, cuType = "upper")
+ plotStatisticLower <- .cusumPoints(dataCurrentStage, sigma, n, cusumTarget, cusumShiftSize, cuType = "lower")
+ plotStatistic <- c(plotStatisticUpper, plotStatisticLower)
+ UCL <- nSigmasControlLimits*sigma/sqrt(n)
+ LCL <- -UCL
+ center <- 0 # not to be confused with the target, even if target != 0, the center line of the plot should be at 0
+ ###
+ ### Calculations for ewma chart
+ ###
+ } else if (plotType == "ewma") {
+ n <- if (!identical(fixedSubgroupSize, "")) fixedSubgroupSize else rowSums(!is.na(dataCurrentStage)) # returns the number of non NA values per row
+ if (phase2) {
+ sigma <- as.numeric(phase2Sd)
+ } else if (all(n == 1)) {
+ k <- movingRangeLength
+ dataCurrentStageVector <- unlist(dataCurrentStage)
+ mrMatrix <- matrix(dataCurrentStageVector[seq((k), length(dataCurrentStageVector))]) # remove first k - 1 elements
+ for (j in seq(1, k-1)) {
+ mrMatrix <- cbind(mrMatrix, matrix(dataCurrentStageVector[seq(k-j, length(dataCurrentStageVector)-j)]))
+ }
+ meanMovingRange <- mean(.rowRanges(mrMatrix)$ranges, na.rm = TRUE)
+ d2 <- KnownControlStats.RS(k)$constants[1]
+ sigma <- meanMovingRange/d2
+ # sigma for subgroup size > 1
+ } else {
+ sigma <- .sdXbar(dataCurrentStage, type = xBarSdType, unbiasingConstantUsed = unbiasingConstantUsed)
+ }
+ plotStatistic <- .ewmaPlotStatistic(data = dataCurrentStage, lambda = ewmaLambda)
+ center <- mean(unlist(dataCurrentStage), na.rm = TRUE)
+ individualPointSigmas <- .ewmaPointSigmas(n = n, sigma = sigma, lambda = ewmaLambda)
+ UCL <- center + individualPointSigmas * nSigmasControlLimits
+ LCL <- center - individualPointSigmas * nSigmasControlLimits
+ ###
+ ### Calculations for g chart
+ ###
+ } else if (plotType == "g") {
+ plotStatistic <- unname(unlist(dataCurrentStage))
+ gChartStatistics <- .gChartStatistics(intervals = plotStatistic, phase2Proportion = if(phase2) phase2gChartProportion else "")
+ center <- gChartStatistics$CL
+ UCL <- gChartStatistics$UCL
+ LCL <- gChartStatistics$LCL
+ p <- gChartStatistics$p
+ ###
+ ### Calculations for t chart
+ ###
+ } else if (plotType == "t") {
+ plotStatistic <- unname(unlist(dataCurrentStage))
+ if (any(plotStatistic[!is.na(plotStatistic)] == 0)) {
+ zeroCorrectionIndices <- which(plotStatistic == 0, arr.ind = TRUE)
+ plotStatistic[zeroCorrectionIndices] <- min(plotStatistic[plotStatistic > 0], na.rm = TRUE)/2
+ }
+
+ if (!phase2) {
+ distributionPars <- .distributionParameters(plotStatistic[!is.na(plotStatistic)], distribution = tChartDistribution)
+ shape <- distributionPars$beta
+ scale <- distributionPars$theta
+ } else {
+ shape <- if (tChartDistribution == "exponential") 1 else phase2tChartDistributionShape
+ scale <- phase2tChartDistributionScale
+ }
+ center <- qweibull(p = .5, shape = shape, scale = scale)
+ UCL <- qweibull(p = pnorm(3), shape = shape, scale = scale)
+ LCL <- qweibull(p = pnorm(-3), shape = shape, scale = scale)
}
if (i != 1) {
+ if (plotType == "cusum") {
+ subgroups <- rep(seq_along(plotStatisticUpper), 2) + max(plotData$subgroup)
+ } else {
subgroups <- seq(max(plotData$subgroup) + 1, max(plotData$subgroup) + length(plotStatistic))
+ }
+
dfStageLabels <- rbind(dfStageLabels, data.frame(x = max(plotData$subgroup) + length(subgroups)/2,
y = NA, # the y value will be filled in later
label = stage,
separationLine = max(plotData$subgroup) + .5))
} else {
- subgroups <- seq_along(plotStatistic)
+ if (plotType == "cusum") {
+ subgroups <- rep(seq_along(plotStatisticUpper), 2)
+ } else {
+ subgroups <- seq_along(plotStatistic)
+ }
dfStageLabels <- rbind(dfStageLabels, data.frame(x = max(subgroups)/2 + 0.5,
y = NA, # the y value will be filled in later
label = stage,
@@ -611,8 +726,11 @@ KnownControlStats.RS <- function(N, sigma = 3) {
if (length(na.omit(plotStatistic)) > 1) {
if (plotType == "MR" || plotType == "MMR") {
dotColor <- ifelse(c(rep(NA, k-1), NelsonLaws(qccObject)$red_points), 'red', 'blue')
+ } else if (plotType == "cusum" || plotType == "ewma" || plotType == "g" || plotType == "t") {
+ dotColor <- ifelse(plotStatistic > UCL | plotStatistic < LCL, "red", "blue")
+ dotColor[is.na(dotColor)] <- "blue"
} else {
- dotColor <- ifelse(NelsonLaws(qccObject, allsix = plotType == "I")$red_points, 'red', 'blue')
+ dotColor <- ifelse(NelsonLaws(qccObject, allsix = (plotType == "I"))$red_points, 'red', 'blue')
}
} else {
dotColor <- ifelse(plotStatistic > UCL | plotStatistic < LCL, "red", "blue")
@@ -620,7 +738,7 @@ KnownControlStats.RS <- function(N, sigma = 3) {
}
# if more than half of the dots are violations, do not show red dots.
nOutOfLimits <- sum(dotColor[!is.na(dotColor)] == "red")
- if (nOutOfLimits > length(qccObject$statistics)/2)
+ if (nOutOfLimits > length(plotStatistic)/2)
dotColor <- "blue"
stagePlotData <- data.frame("plotStatistic" = plotStatistic,
@@ -674,11 +792,15 @@ KnownControlStats.RS <- function(N, sigma = 3) {
tableLabelsCurrentStage <- subgroups
if (plotType == "MR" || plotType == "MMR")
tableLabelsCurrentStage <- tableLabelsCurrentStage[-seq(1, k-1)]
- tableList[[i]] <- .NelsonTableList(qccObject = qccObject, type = plotType, labels = tableLabelsCurrentStage)
- tableListLengths <- sapply(tableList[[i]], length)
- if (any(tableListLengths > 0)) {
- tableList[[i]][["stage"]] <- as.character(stage)
- tableList[[i]] <- lapply(tableList[[i]], "length<-", max(lengths(tableList[[i]]))) # this fills up all elements of the list with NAs so all elements are the same size
+ if (plotType == "cusum" || plotType == "ewma" || plotType == "g" || plotType == "t") {
+ tableList[[i]] <- c() # pass empty vector for now, until Nelson Laws are updated and can handle other input than QCC objects
+ } else {
+ tableList[[i]] <- .NelsonTableList(qccObject = qccObject, type = plotType, labels = tableLabelsCurrentStage)
+ tableListLengths <- sapply(tableList[[i]], length)
+ if (any(tableListLengths > 0)) {
+ tableList[[i]][["stage"]] <- as.character(stage)
+ tableList[[i]] <- lapply(tableList[[i]], "length<-", max(lengths(tableList[[i]]))) # this fills up all elements of the list with NAs so all elements are the same size
+ }
}
}
return(list("pointData" = plotData,
@@ -687,11 +809,11 @@ KnownControlStats.RS <- function(N, sigma = 3) {
"stageLabels" = dfStageLabels,
"violationTable" = tableList,
"sd" = sigma
- ))
+ ))
}
.controlChart_table <- function(tableList,
- plotType = c("xBar", "R", "I", "MR", "MMR", "s"),
+ plotType = c("xBar", "R", "I", "MR", "MMR", "s", "cusum", "ewma", "g", "t"),
stages = "",
tableLabels = "") {
plotType <- match.arg(plotType)
@@ -701,12 +823,16 @@ KnownControlStats.RS <- function(N, sigma = 3) {
"I" = "individuals",
"MR" = "moving range",
"MMR" = "moving range",
- "s" = "s"
+ "s" = "s",
+ "cusum" = "cumulative sum",
+ "ewma" = "exponentially weighted moving average",
+ "g" = "g",
+ "t" = "t"
)
table <- createJaspTable(title = gettextf("Test results for %1$s chart", tableTitle))
table$showSpecifiedColumnsOnly <- TRUE
tableListVectorized <- unlist(tableList, recursive = FALSE)
- tableLongestVector <- max(sapply(tableListVectorized, length))
+ tableLongestVector <- if (is.null(tableListVectorized)) 0 else max(sapply(tableListVectorized, length))
if (tableLongestVector > 0) {
# combine the tests for different stages in same column
tableListCombined <- tapply(tableListVectorized, names(tableListVectorized), function(x) unlist(x, FALSE, FALSE))
@@ -761,14 +887,15 @@ KnownControlStats.RS <- function(N, sigma = 3) {
}
.controlChart_plotting <- function(pointData, clData, stageLabels, clLabels,
- plotType = c("xBar", "R", "I", "MR", "MMR", "s"),
- stages = "",
- phase2 = FALSE,
- warningLimits = FALSE,
+ plotType = c("xBar", "R", "I", "MR", "MMR", "s", "cusum", "ewma", "g", "t"),
+ stages = "",
+ phase2 = FALSE,
+ warningLimits = FALSE,
specificationLimits = NA,
- xAxisLabels = "",
- xAxisTitle = "",
- clLabelSize = 4.5) {
+ xAxisLabels = "",
+ xAxisTitle = "",
+ clLabelSize = 4.5,
+ gAndtUnit = c("days", "hours", "minutes", "opportunities")) {
plotType <- match.arg(plotType)
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
@@ -787,13 +914,20 @@ KnownControlStats.RS <- function(N, sigma = 3) {
xLabels <- xBreaks
}
- yTitle <- switch (plotType,
- "xBar" = "Sample average",
- "R" = "Sample range",
- "I" = "Individual value",
- "MR" = "Moving range",
- "MMR" = "Moving range of subgroup mean",
- "s" = "Sample std. dev.")
+ if (plotType == "g" || plotType == "t") {
+ unitString <- paste0(toupper(substr(gAndtUnit, 1, 1)), substr(gAndtUnit, 2, nchar(gAndtUnit)))
+ yTitle <- gettextf("%1$s between events", unitString)
+ } else {
+ yTitle <- switch (plotType,
+ "xBar" = gettext("Sample average"),
+ "R" = gettext("Sample range"),
+ "I" = gettext("Individual value"),
+ "MR" = gettext("Moving range"),
+ "MMR" = gettext("Moving range of subgroup mean"),
+ "s" = gettext("Sample std. dev."),
+ "cusum" = gettext("Cumulative sum"),
+ "ewma" = gettext("Exponentially weighted moving average"))
+ }
lineType <- if (phase2) "solid" else "dashed"
# Create plot
plotObject <- ggplot2::ggplot(clData, ggplot2::aes(x = subgroup, group = stage)) +
@@ -815,7 +949,7 @@ KnownControlStats.RS <- function(N, sigma = 3) {
plotObject <- plotObject + ggplot2::geom_line(data = lslLineDf, mapping = ggplot2::aes(x = xPos, y = yPos),
inherit.aes = FALSE, linewidth = 1.5, col = "darkred", na.rm = TRUE) +
ggplot2::geom_label(data = lslLabelDf, mapping = ggplot2::aes(x = xPos, y = yPos, label = label),
- inherit.aes = FALSE, size = clLabelSize, hjust = "inward", na.rm = TRUE)
+ inherit.aes = FALSE, size = clLabelSize, hjust = "inward", na.rm = TRUE)
}
if (!is.na(targetYPos)) {
targetLineDf <- data.frame(xPos = xRange, yPos = rep(targetYPos, each = 2))
@@ -847,15 +981,38 @@ KnownControlStats.RS <- function(N, sigma = 3) {
if (!identical(stages, "")) {
stageLabels$y <- max(yLimits)
plotObject <- plotObject + ggplot2::geom_vline(xintercept = na.omit(stageLabels[["separationLine"]])) +
- ggplot2::geom_text(data = stageLabels, mapping = ggplot2::aes(x = x, y = y, label = label, na.rm = TRUE),
+ ggplot2::geom_text(data = stageLabels, mapping = ggplot2::aes(x = x, y = y, label = label),
size = 6, fontface = "bold", inherit.aes = FALSE)
}
plotObject <- plotObject + ggplot2::geom_label(data = clLabels, mapping = ggplot2::aes(x = x, y = y, label = label),
inherit.aes = FALSE, size = clLabelSize, na.rm = TRUE) +
ggplot2::scale_y_continuous(name = yTitle, breaks = yBreaks, limits = yLimits) +
- ggplot2::scale_x_continuous(name = xAxisTitle, breaks = xBreaks, limits = xLimits, labels = xLabels) +
- jaspGraphs::geom_line(pointData, mapping = ggplot2::aes(x = subgroup, y = plotStatistic, group = stage), color = "blue",
- na.rm = TRUE) +
+ ggplot2::scale_x_continuous(name = xAxisTitle, breaks = xBreaks, limits = xLimits, labels = xLabels)
+ if (plotType != "cusum") {
+ plotObject <- plotObject +
+ jaspGraphs::geom_line(pointData, mapping = ggplot2::aes(x = subgroup, y = plotStatistic, group = stage), color = "blue",
+ na.rm = TRUE)
+ } else {
+ # since the upper and lower part of the cusum chart are in the same df, we split the first and second half; if there are stages, do this for each stage
+ # loop over stages
+ for (stage_i in unique(pointData[["stage"]])) {
+ pointDataSubset <- subset.data.frame(pointData, pointData$stage == stage_i)
+ if (length(pointDataSubset$subgroup) %% 2 != 0)
+ stop("Data provided to cusum plot function is not symmetric, i.e., unequal amount of points above and below 0.")
+ nSubgroupsStage <- length(pointDataSubset$subgroup)/2 # the data should always be symmetrical, hence we can divide by two
+ firstHalf <- seq(1, nSubgroupsStage)
+ secondHalf <- firstHalf + nSubgroupsStage
+ pointDataFirstHalf <- pointDataSubset[firstHalf,]
+ pointDataSecondHalf <- pointDataSubset[secondHalf,]
+ plotObject <- plotObject +
+ jaspGraphs::geom_line(pointDataFirstHalf, mapping = ggplot2::aes(x = subgroup, y = plotStatistic, group = stage), color = "blue",
+ na.rm = TRUE) +
+ jaspGraphs::geom_line(pointDataSecondHalf, mapping = ggplot2::aes(x = subgroup, y = plotStatistic, group = stage), color = "blue",
+ na.rm = TRUE)
+ }
+
+ }
+ plotObject <- plotObject +
jaspGraphs::geom_point(pointData, mapping = ggplot2::aes(x = subgroup, y = plotStatistic, group = stage),
size = 4, fill = pointData$dotColor, inherit.aes = TRUE, na.rm = TRUE) +
jaspGraphs::geom_rangeframe() +
@@ -889,3 +1046,141 @@ KnownControlStats.RS <- function(N, sigma = 3) {
return(violationsList)
}
+
+.cusumPoints <- function(data, sigma, n, target, shiftSize, cuType = c("lower", "upper")) {
+ cuType <- match.arg(cuType)
+
+ # Initialize vector and first point
+ cuSumPoints <- c()
+ rowMeanInitial <- if (length(data[1,]) == 1) data[1,] else rowMeans(data[1,], na.rm = T)
+ if (cuType == "lower") {
+ initialPoint <- rowMeanInitial - (target - shiftSize*(sigma/sqrt(n[1])))
+ cuSumPoints[1] <- min(0, initialPoint)
+ } else {
+ initialPoint <- rowMeanInitial - (target + shiftSize*(sigma/sqrt(n[1])))
+ cuSumPoints[1] <- max(0, initialPoint)
+ }
+
+ # Loop over remaining data
+ for (i in seq(2, nrow(data))) {
+ rowMean_i <- if (length(data[i,]) == 1) data[i,] else rowMeans(data[i,], na.rm = TRUE)
+ if (cuType == "lower") {
+ cuSumPoint <- cuSumPoints[i-1] + rowMean_i - (target - shiftSize*(sigma/sqrt(n[i])))
+ cuSumPoints[i] <- min(0, cuSumPoint)
+ } else {
+ cuSumPoint <- cuSumPoints[i-1] + rowMean_i - (target + shiftSize*(sigma/sqrt(n[i])))
+ cuSumPoints[i] <- max(0, cuSumPoint)
+ }
+ }
+ return(cuSumPoints)
+}
+
+.ewmaPlotStatistic <- function(data, lambda) {
+ ewmaPoints <- c()
+ initialPoint <- mean(unlist(data), na.rm = TRUE)
+ rowMeanVector <- if (ncol(data) == 1) unlist(data) else rowMeans(data, na.rm = TRUE)
+ for (i in seq(1, nrow(data))) {
+ previousPoint <- if (i == 1) initialPoint else ewmaPoints[i - 1]
+ ewmaPoint <- lambda * rowMeanVector[i] + (1 - lambda) * previousPoint
+ ewmaPoints[i] <- ewmaPoint
+ }
+ return(ewmaPoints)
+}
+
+.ewmaPointSigmas <- function(n = n, sigma = sigma, lambda = ewmaLambda) {
+ ewmaPointSigmas <- c()
+ initialPoint <- (lambda * sigma) / sqrt(n[1])
+ ewmaPointSigmas[1] <- initialPoint
+ for (i in seq(2, length(n))) {
+ nVector <- n[seq(i-1, 1)]
+ exponentVector <- 2*seq(1, i-1)
+ exponentiallyWeightedVector <- ((1 - lambda)^(exponentVector)) / nVector
+ ewmaPointSigma <- sigma * lambda * sqrt(sum(1/n[i], exponentiallyWeightedVector))
+ ewmaPointSigmas[i] <- ewmaPointSigma
+ }
+ return(ewmaPointSigmas)
+}
+
+.gChartStatistics <- function(intervals, phase2Proportion = "") {
+ intervalsMean <- mean(intervals, na.rm = TRUE)
+ n <- sum(!is.na(intervals))
+ p <- if (identical(phase2Proportion, "")) ((n - 1) / n) / (intervalsMean + 1) else phase2Proportion
+
+ # calculate CL
+ p2a <- pgeom(qgeom(0.5, prob = p) - 1, prob = p, lower.tail = T) # p2a is the CDF at G2a
+ p2b <- pgeom(qgeom(0.5, prob = p), prob = p, lower.tail = T) # p2b is the CDF at G2b
+ # Find G2a and G2b
+ G2a <- qgeom(p2a, prob = p) + 1 # Add 1 to get trials count
+ G2b <- G2a + 1 # Since G2b = G2a + 1
+ # Perform linear interpolation to find G2
+ G2 <- G2a + (0.5 - p2a) / (p2b - p2a)
+ # Calculate CL = G2 - 1
+ CL <- G2 - 1
+
+ # calculate LCL
+ p1a <- pgeom(qgeom(0.99865, prob = p, lower.tail = F) - 1, prob = p, lower.tail = T)
+ p1b <- pgeom(qgeom(0.99865, prob = p, lower.tail = F), prob = p, lower.tail = T)
+ # Find G2a and G2b
+ G1a <- qgeom(p1a, prob = p) + 1
+ G1b <- G1a + 1
+ # Perform linear interpolation to find G1
+ G1 <- G1a + (0.00135 - p1a) / (p1b - p1a)
+ LCL <- G1 - 1
+ LCL <- max(0, LCL)
+
+ # calculate UCL
+ p3a <- pgeom(qgeom(0.00135, prob = p, lower.tail = F) - 1, prob = p, lower.tail = T) # p2a is the CDF at G2a
+ p3b <- pgeom(qgeom(0.00135, prob = p, lower.tail = F), prob = p, lower.tail = T) # p2b is the CDF at G2b
+ # Find G2a and G2b
+ G3a <- qgeom(p3a, prob = p) + 1 # Add 1 to get trials count
+ G3b <- G3a + 1 # Since G2b = G2a + 1
+ # Perform linear interpolation to find G2
+ G3 <- G3a + (0.99865 - p3a) / (p3b - p3a)
+ UCL <- G3 - 1
+
+ return(list(p = p, CL = CL, UCL = UCL, LCL = LCL))
+}
+
+.distributionParameters <- function(data, distribution = c("lognormal", "weibull", "3ParameterLognormal", "3ParameterWeibull", "exponential")){
+ if (distribution == "lognormal") {
+ fit_Lnorm <- try(EnvStats::elnorm(data))
+ if (jaspBase::isTryError(fit_Lnorm))
+ stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
+ beta <- fit_Lnorm$parameters[1]
+ theta <- fit_Lnorm$parameters[2]
+ } else if (distribution == "weibull") {
+ fit_Weibull <- try(fitdistrplus::fitdist(data, "weibull", method = "mle",
+ control = list(maxit = 500, abstol = .Machine$double.eps, reltol = .Machine$double.eps)))
+ if (jaspBase::isTryError(fit_Weibull))
+ stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
+ beta <- fit_Weibull$estimate[[1]]
+ theta <- fit_Weibull$estimate[[2]]
+ } else if(distribution == "3ParameterLognormal") {
+ temp <- try(EnvStats::elnorm3(data))
+ if (jaspBase::isTryError(temp))
+ stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
+ beta <- temp$parameters[[1]]
+ theta <- temp$parameters[[2]]
+ threshold <- temp$parameters[[3]]
+ } else if(distribution == "3ParameterWeibull") {
+ temp <- try(MASS::fitdistr(data, function(x, shape, scale, thres)
+ dweibull(x-thres, shape, scale), list(shape = 0.1, scale = 1, thres = 0)))
+ if (jaspBase::isTryError(temp))
+ stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
+ beta <- temp$estimate[1]
+ theta <- temp$estimate[2]
+ threshold <- temp$estimate[3]
+ } else if (distribution == "exponential") {
+ fit_Weibull <- try(fitdistrplus::fitdist(data, "weibull", method = "mle", fix.arg = list("shape" = 1),
+ control = list(maxit = 500, abstol = .Machine$double.eps, reltol = .Machine$double.eps)))
+ if (jaspBase::isTryError(fit_Weibull))
+ stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
+ beta <- 1
+ theta <- fit_Weibull$estimate[[1]]
+ }
+ list <- list(beta = beta,
+ theta = theta)
+ if(distribution == '3ParameterWeibull' | distribution == "3ParameterLognormal")
+ list['threshold'] <- threshold
+ return(list)
+}
diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R
index a9b900c9..ba7c3e22 100644
--- a/R/processCapabilityStudies.R
+++ b/R/processCapabilityStudies.R
@@ -655,6 +655,13 @@ processCapabilityStudies <- function(jaspResults, dataset, options) {
xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(plotData[["x"]], min(plotData[["x"]]) - 1 * sdo, max(plotData[["x"]]) + 1 * sdo), min.n = 4)
xLimits <- range(xBreaks)
+ if (options[["lowerSpecificationLimit"]] && options[["processCapabilityPlotSpecificationLimits"]])
+ xLimits <- range(xLimits, options[["lowerSpecificationLimitValue"]])
+ if (options[["upperSpecificationLimit"]] && options[["processCapabilityPlotSpecificationLimits"]])
+ xLimits <- range(xLimits, options[["upperSpecificationLimitValue"]])
+ if (options[["target"]] && options[["processCapabilityPlotSpecificationLimits"]])
+ xLimits <- range(xLimits, options[["target"]])
+
nBins <- options[["processCapabilityPlotBinNumber"]]
h <- hist(allData, plot = FALSE, breaks = nBins)
binWidth <- (h$breaks[2] - h$breaks[1])
@@ -2379,40 +2386,5 @@ processCapabilityStudies <- function(jaspResults, dataset, options) {
return(plotList)
}
-.distributionParameters <- function(data, distribution = c("lognormal", "weibull", "3ParameterLognormal", "3ParameterWeibull")){
- if (distribution == "lognormal") {
- fit_Lnorm <- try(EnvStats::elnorm(data))
- if (jaspBase::isTryError(fit_Lnorm))
- stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
- beta <- fit_Lnorm$parameters[1]
- theta <- fit_Lnorm$parameters[2]
- } else if (distribution == "weibull") {
- fit_Weibull <- try(fitdistrplus::fitdist(data, "weibull", method = "mle",
- control = list(maxit = 500, abstol = .Machine$double.eps, reltol = .Machine$double.eps)))
- if (jaspBase::isTryError(fit_Weibull))
- stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
- beta <- fit_Weibull$estimate[[1]]
- theta <- fit_Weibull$estimate[[2]]
- } else if(distribution == "3ParameterLognormal") {
- temp <- try(EnvStats::elnorm3(data))
- if (jaspBase::isTryError(temp))
- stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
- beta <- temp$parameters[[1]]
- theta <- temp$parameters[[2]]
- threshold <- temp$parameters[[3]]
- } else if(distribution == "3ParameterWeibull") {
- temp <- try(MASS::fitdistr(data, function(x, shape, scale, thres)
- dweibull(x-thres, shape, scale), list(shape = 0.1, scale = 1, thres = 0)))
- if (jaspBase::isTryError(temp))
- stop(gettext("Parameter estimation failed. Values might be too extreme. Try a different distribution."), call. = FALSE)
- beta <- temp$estimate[1]
- theta <- temp$estimate[2]
- threshold <- temp$estimate[3]
- }
- list <- list(beta = beta,
- theta = theta)
- if(distribution == '3ParameterWeibull' | distribution == "3ParameterLognormal")
- list['threshold'] <- threshold
- return(list)
-}
+
diff --git a/R/rareEventCharts.R b/R/rareEventCharts.R
new file mode 100644
index 00000000..dcd1224e
--- /dev/null
+++ b/R/rareEventCharts.R
@@ -0,0 +1,248 @@
+#
+# Copyright (C) 2013-2018 University of Amsterdam
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+#
+
+#' @export
+rareEventCharts <- function(jaspResults, dataset, options) {
+ # reading variables in from the GUI
+ variable <- unlist(options[["variable"]])
+ stages <- unlist(options[["stage"]])
+ variable <- variable[variable != ""]
+ stages <- stages[stages != ""]
+
+ if (options[["dataType"]] == "dataTypeDates" || options[["dataType"]] == "dataTypeInterval" && options[["dataTypeIntervalType"]] == "dataTypeIntervalTypeTime") {
+ numericVariables <- NULL
+ factorVariables <- c(variable, stages)
+ } else {
+ numericVariables <- variable
+ factorVariables <- stages
+ }
+
+ ready <- length(variable) == 1
+
+ if (is.null(dataset)) {
+ dataset <- .readDataSetToEnd(columns.as.factor = factorVariables, columns.as.numeric = numericVariables)
+ }
+
+
+ # Checking for errors in the dataset
+ .hasErrors(dataset, type = c('infinity'),
+ infinity.target = c(options$variable),
+ exitAnalysisIfErrors = TRUE)
+
+ if (ready) {
+ # If variable is date/time transform into day, hour and minute intervals
+ if (options[["dataType"]] == "dataTypeDates") {
+ timepoints <- dataset[[variable]]
+ timeStructure <- options[["dataTypeDatesStructure"]]
+ timeFormat <- switch(timeStructure,
+ "dateTime" = paste(options[["dataTypeDatesFormatDate"]], options[["dataTypeDatesFormatTime"]]),
+ "timeDate" = paste(options[["dataTypeDatesFormatTime"]], options[["dataTypeDatesFormatDate"]]),
+ "dateOnly" = options[["dataTypeDatesFormatDate"]],
+ "timeOnly" = options[["dataTypeDatesFormatTime"]])
+ timepoints <- lubridate::parse_date_time(timepoints, orders = timeFormat) # returns all data in HMS format
+ timepointsLag1 <- c(NA, timepoints[seq(1, length(timepoints) - 1)]) # because of the NA, everything is converted to seconds
+ if (length(stages) == 1) { # remove the first value of each stage, as it is a new beginning
+ stageSwitchPositions <- which(diff(as.numeric(dataset[[stages]])) != 0) + 1
+ timepointsLag1[stageSwitchPositions] <- NA
+ }
+ intervalsMinutes <- as.numeric(timepoints - timepointsLag1)/60
+ intervalsHours <- intervalsMinutes/60
+ intervalsDays <- intervalsHours/24
+ } else if (options[["dataType"]] == "dataTypeInterval" && options[["dataTypeIntervalType"]] == "time") {
+ timepoints <- dataset[[variable]]
+ timeFormat <- options[["dataTypeIntervalTimeFormat"]]
+ timepoints <- lubridate::parse_date_time(timepoints, orders = timeFormat) # returns all data in HMS format
+ intervalsMinutes <- as.numeric(timepoints - lubridate::as_datetime("0000-01-01 UTC")) # transform to minutes
+ intervalsHours <- intervalsMinutes/60
+ }
+
+ # if intervals are all NA, throw error
+ if ((options[["dataType"]] == "dataTypeDates" || options[["dataType"]] == "dataTypeInterval" && options[["dataTypeIntervalType"]] == "time") &&
+ all(is.na(timepoints))) {
+ errorPlot <- createJaspPlot(title = gettext("Rare event charts"), width = 1200, height = 500)
+ errorPlot$dependOn(c("variable", "stage", "dataType", "dataTypeDatesStructure", "dataTypeDatesFormatDate",
+ "dataTypeDatesFormatTime", "dataTypeIntervalType", "dataTypeIntervalTimeFormat"))
+ errorPlot$setError(gettext("Date/time conversion returned no valid values. Did you select the correct date/time format?"))
+ jaspResults[["errorPlot"]] <- errorPlot
+ return()
+ }
+
+ # Get the interval type, depending on the input type and, if applicable, the calculated intervals
+ if (options[["dataType"]] == "dataTypeInterval") {
+ if (options[["dataTypeIntervalType"]] == "opportunities") {
+ intervals <- as.numeric(dataset[[variable]])
+ intervalType <- "opportunities"
+ } else if (options[["dataTypeIntervalType"]] == "hours") {
+ intervals <- as.numeric(dataset[[variable]])
+ intervalType <- "hours"
+ } else if (options[["dataTypeIntervalType"]] == "days") {
+ intervals <- as.numeric(dataset[[variable]])
+ intervalType <- "days"
+ } else if (options[["dataTypeIntervalType"]] == "time") {
+ intervals <- if (all(intervalsHours < 1, na.rm = TRUE)) intervalsMinutes else intervalsHours
+ intervalType <- if (all(intervalsHours < 1, na.rm = TRUE)) "minutes" else "hours"
+ }
+ } else if (options[["dataType"]] == "dataTypeDates") {
+ if (all(intervalsDays < 1, na.rm = TRUE) && all(intervalsHours < 1, na.rm = TRUE)) {
+ intervals <- intervalsMinutes
+ intervalType <- "minutes"
+ } else if (all(intervalsDays < 1, na.rm = TRUE)) {
+ intervals <- intervalsHours
+ intervalType <- "hours"
+ } else {
+ intervals <- intervalsDays
+ intervalType <- "days"
+ }
+ }
+
+ # if intervals contains any negative values, throw error
+ if (any(intervals < 0, na.rm = TRUE)) {
+ errorPlot <- createJaspPlot(title = gettext("Rare event charts"), width = 1200, height = 500)
+ errorPlot$dependOn(c("variable", "stage", "dataType", "dataTypeDatesStructure", "dataTypeDatesFormatDate",
+ "dataTypeDatesFormatTime", "dataTypeIntervalType", "dataTypeIntervalTimeFormat"))
+ errorPlot$setError(gettext("Negative values for time/intervals detected, calculation is not possible."))
+ jaspResults[["errorPlot"]] <- errorPlot
+ return()
+ }
+
+ if (length(stages) == 1) {
+ dataset <- data.frame(x1 = intervals, x2 = dataset[[stages]])
+ colnames(dataset) <- c(variable, stages)
+ } else {
+ dataset <- data.frame(x1 = intervals)
+ colnames(dataset) <- variable
+ stages <- ""
+ }
+ }
+
+ # G chart
+ if (options[["gChart"]]) {
+ gChart <- .gChart(dataset, variable, stages, intervalType, options, ready)
+ }
+
+ # T chart
+ if (options[["tChart"]]) {
+ tChart <- .tChart(dataset, variable, stages, intervalType, options, ready)
+ }
+
+
+ # Report
+ if (options[["report"]]) {
+ reportPlot <- createJaspPlot(title = gettext("Rare event charts report"), width = 1250, height = 1000)
+ jaspResults[["report"]] <- reportPlot
+ jaspResults[["report"]]$dependOn(c("variable", "stage", "dataType", "dataTypeDatesStructure", "dataTypeDatesFormatDate",
+ "dataTypeDatesFormatTime", "dataTypeIntervalType", "dataTypeIntervalTimeFormat",
+ "gChart", "gChartProportionSource", "gChartHistoricalProportion", "tChart",
+ "tChartDistribution", "tChartDistributionParameterSource", "tChartHistoricalParametersWeibullShape",
+ "tChartHistoricalParametersScale", "report", "reportMetaData",
+ "reportTitle", "reportTitleText", "reportChartName", "reportChartNameText", "reportSubtitle",
+ "reportSubtitleText", "reportMeasurementName", "reportMeasurementNameText", "reportFootnote",
+ "reportFootnoteText", "reportLocation", "reportLocationText", "reportDate", "reportDateText",
+ "reportPerformedBy", "reportPerformedByText", "reportPrintDate", "reportPrintDateText"))
+
+ # Plot meta data
+ if (options[["reportTitle"]] ) {
+ title <- if (options[["reportTitleText"]] == "") gettext("Rare event charts report") else options[["reportTitleText"]]
+ } else {
+ title <- ""
+ }
+
+ if (options[["reportMetaData"]]) {
+ text <- c()
+ text <- if (options[["reportChartName"]]) c(text, gettextf("Chart name: %s", options[["reportChartNameText"]])) else text
+ text <- if (options[["reportSubtitle"]]) c(text, gettextf("Sub-title: %s", options[["reportSubtitleText"]])) else text
+ text <- if (options[["reportMeasurementName"]]) c(text, gettextf("Measurement name: %s", options[["reportMeasurementNameText"]])) else text
+ text <- if (options[["reportFootnote"]]) c(text, gettextf("Footnote: %s", options[["reportFootnoteText"]])) else text
+ text <- if (options[["reportLocation"]]) c(text, gettextf("Location: %s", options[["reportLocationText"]])) else text
+ text <- if (options[["reportDate"]]) c(text, gettextf("Date: %s", options[["reportDateText"]])) else text
+ text <- if (options[["reportPerformedBy"]]) c(text, gettextf("Performed by: %s", options[["reportPerformedByText"]])) else text
+ text <- if (options[["reportPrintDate"]]) c(text, gettextf("Print date: %s", options[["reportPrintDateText"]])) else text
+ } else {
+ text <- NULL
+ }
+
+ plots <- list()
+ if (options[["gChart"]])
+ plots[["gChart"]] <- gChart$plotObject
+ if (options[["tChart"]])
+ plots[["tChart"]] <- tChart$plotObject
+ reportPlotObject <- .qcReport(text = text, plots = plots, textMaxRows = 8,
+ reportTitle = title)
+ reportPlot$plotObject <- reportPlotObject
+
+ ###
+ ### If not report mode
+ ###
+ } else {
+ if (options[["gChart"]])
+ jaspResults[["gChart"]] <- gChart
+ if (options[["tChart"]])
+ jaspResults[["tChart"]] <- tChart
+ }
+
+}
+
+
+.gChart <- function(dataset,
+ variable,
+ stages = NULL,
+ intervalType = c("days", "hours", "minutes", "opportunities"),
+ options, ready) {
+ plot <- createJaspPlot(title = gettext("G chart"), width = 1200, height = 500)
+ plot$dependOn(c("variable", "stage", "dataType", "dataTypeDatesStructure", "dataTypeDatesFormatDate",
+ "dataTypeDatesFormatTime", "dataTypeIntervalType", "dataTypeIntervalTimeFormat",
+ "gChart", "gChartProportionSource", "gChartHistoricalProportion", "report"))
+
+ if (!ready)
+ return(plot)
+
+ columnsToPass <- c(variable, stages)
+ columnsToPass <- columnsToPass[columnsToPass != ""]
+ phase2 <- options[["gChartProportionSource"]] == "historical"
+ plotObject <- .controlChart(dataset[columnsToPass], plotType = "g", stages = stages, gAndtUnit = intervalType,
+ phase2 = phase2, phase2gChartProportion = options[["gChartHistoricalProportion"]])$plotObject
+ plot$plotObject <- plotObject
+
+ return(plot)
+}
+
+.tChart <- function(dataset,
+ variable,
+ stages = NULL,
+ intervalType = c("days", "hours", "minutes", "opportunities"),
+ options, ready) {
+ plot <- createJaspPlot(title = gettext("T chart"), width = 1200, height = 500)
+ plot$dependOn(c("variable", "stage", "dataType", "dataTypeDatesStructure", "dataTypeDatesFormatDate",
+ "dataTypeDatesFormatTime", "dataTypeIntervalType", "dataTypeIntervalTimeFormat", "tChart",
+ "tChartDistribution", "tChartDistributionParameterSource", "tChartHistoricalParametersWeibullShape",
+ "tChartHistoricalParametersScale", "report"))
+
+ if (!ready)
+ return(plot)
+
+ columnsToPass <- c(variable, stages)
+ columnsToPass <- columnsToPass[columnsToPass != ""]
+ phase2 <- options[["tChartDistributionParameterSource"]] == "historical"
+ plotObject <- .controlChart(dataset[columnsToPass], plotType = "t", stages = stages, gAndtUnit = intervalType,
+ tChartDistribution = options[["tChartDistribution"]],
+ phase2tChartDistributionShape = options[["tChartHistoricalParametersWeibullShape"]],
+ phase2tChartDistributionScale = options[["tChartHistoricalParametersScale"]],
+ phase2 = phase2)$plotObject
+ plot$plotObject <- plotObject
+
+ return(plot)
+}
diff --git a/inst/Description.qml b/inst/Description.qml
index 4c15e047..7babc83f 100644
--- a/inst/Description.qml
+++ b/inst/Description.qml
@@ -26,7 +26,7 @@ Description
}
Analysis
{
- title: qsTr("Type 2 Gauge r&R Study")
+ title: qsTr("Type 2 and 3 Gauge r&R Study")
func: "msaGaugeRR"
}
Analysis
@@ -82,6 +82,12 @@ Description
func: "timeWeightedCharts"
}
+ Analysis
+ {
+ title: qsTr("Rare Event Charts")
+ func: "rareEventCharts"
+ }
+
GroupTitle
{
title: qsTr("Capability Analysis")
diff --git a/inst/help/attributesCharts.md b/inst/help/attributesCharts.md
index adee68ea..c7e711b7 100644
--- a/inst/help/attributesCharts.md
+++ b/inst/help/attributesCharts.md
@@ -1,52 +1,69 @@
Attribute Charts
==========================
-Control charts are a set of tools used to model the variation of a process, thereby indicating its stability and establishing a state of statistical control.
-Attribute charts are used for discrete data and model the stability of the process based on the sample size collected and the count of defectives\defects.
+A Shewhart control chart is a graph used to study how a process changes over time. The obtained measurements can be either variables or attributes data, and subgroups are taken from the process at regular intervals. From each subgroup one or more statistical measures (such as average, dispersion, or proportion) are plotted in time order. Each chart always has a central line usually the average of the subgroup statistic or may be based on past experience, if the process is in a state of statistical control. The control chart has two statistically determined boundaries, one on either side of the central line, which are called the upper control limit (UCL) and the lower control limit (LCL). They are typically based on and placed at a distance of three times the standard deviation of the statistic being plotted. By comparing current data to these lines, conclusions can be drawn about whether the process variation is consistent (i.e., in control) or is unpredictable (i.e., out of control, and affected by special causes of variation). Control charts for variables data are always used in pairs. The top chart monitors the averages i.e., the centring of the data from the process. The bottom chart monitors the ranges i.e., the spread of the distribution. Control charts for attributes data consist of a single chart. Attributes data represent observations obtained by noting the presence or absence of some characteristic (attributes) in each of the items in the subgroup under consideration, then counting how many items do or do not possess the attribute, or how many such events occur in the item, group or area. Attributes data are generally rapid and inexpensive to obtain and often do not require specialised collection skills.
+
+The assumed distribution for attributes data has only one independent parameter, the average level. The p and np control charts are based on the binomial distribution (for defectives), while the u and c control charts are based on the Poisson distribution (for defects).There are many types of count based data that cannot be characterised by either a binomial (p and np) or a Poisson (u and c) distribution. When such data are placed on p, np, u, or c control charts the limits based on these models would be wrong. The Laney p′ (p prime) and u′ (u prime) charts are used to monitor attributes data if the sample sizes are variable and often very large. In such cases, it is common for the average proportion or rate to vary over the sampling period, a phenomenon known as overdispersion. Overdispersion means the sample-to-sample variation (i.e., the between sample variation) is much larger than the variation within the sample. Underdispersion is the opposite.
+
+Unlike the attributes control charts, the X-mR control chart makes no assumptions about the relationship between the location and the dispersion parameter. It directly measures the location with the average and the dispersion with the moving ranges. Thus, while the p, np, u, and c control charts use “theoretical” limits, the X-mR control chart uses “empirical” limits. X-mR control charts are used if the sample sizes are reasonable constant. Laney control charts are used if sample sizes vary; if the sample size is constant the Laney control chart is exactly the same as the X mR control chart.
+
## Assumptions
-------
-The assumptions for attribute charts are:
-- np/c chart: the sample size used for data collection is equal.
-- p/u chart: the sample size used for data collection is inequal.
-- Laney p'/u': the data are overdispersed or underdispersed.
+The assumptions for attributes control charts are:
+- p/np control chart are used if the observed data are approximately binomial distributed;
+- u/c control chart are used if the observed data are approximately Poisson distributed;
+- np/c control chart: the subgroup size used for data collection is constant;
+- p/u control chart: the subgroup size used for data collection is either variable or constant;
+- Laney p'/u': the observed data cannot be modelled by either a binomial or a Poisson distribution and the subgroup size is variable.
## Input
-------
### Assignment Box
-- Defectives\Defects: the observations collected from a process.
+- Defectives/Defects: the number of observations collected from a process that do or do not possess the attribute.
- Sample: sample size of each observation.
## Output
-------
### Charts
-Defectives charts: Defectives charts are used in products that are either defective or not defective (binary).
-- np chart: plots the count of non-conforming (defective) products.
-- p chart: displays changes in the proportion of non-conforming (defective) products, rejects or unacceptable outcomes.
-- Laney p' chart: plots the variation adjusted proportion of non-conforming (defective) products.
+Defectives charts: Defectives charts are used for products that are either defective or not defective (binary).
+ - p chart, which charts the proportion of non-conforming (defective) products, rejects or unacceptable outcomes, or conforming/accepted items in each subgroup.
+ - np chart, which charts the number of non-conforming (defective) products or only the conforming items in each subgroup.
+ - Laney p' chart, which charts the variation proportion of non-conforming (defective) products in each subgroup with adjusted control limits.
-Defects charts: In the case of defectives charts the product may have multiple defects per unit (non-binary).
-- c chart: plots the count of defects or non-conformities in a sample over time.
-- u chart: plots the proportion of defects or non-conformities in a sample over time.
-- Laney u' chart: plots the variation adjusted proportion of defects or non-conformities in products over time.
+Defects charts: Defects charts are used for products that have multiple defects per unit (the possible occurrences could be infinite).
+ - u chart, which charts the proportion of defects or non-conformities in each subgroup. Subgroup size is variable.
+ - chart, which charts the number of defects or non-conformities in each subgroup. Subgroup size is constant.
+ - Laney u' chart, which charts the variation proportion of defects or non-conformities in products in each subgroup with adjusted control limits.
+
+X-mR chart, which charts the process values (individuals) and moving range (mR) over time.
-X-mR chart: plots the process's values (Individual) and moving range (MR) over time.
### Out-of-control Signals
-------
-_Statistical process control handbook page 23:_
+ To indicate special cause variation the following unnatural patterns are used:
+
+- Signal 1: One point beyond the control limits (sporadic issue). One point more than three standard deviations from the central line equivalent to violation of UCL or LCL.
+- Signal 2: Seven consecutive points above or below the central line (mean shift). Seven points in a row on same side of centre line equivalent to a run above or below centre line.
+- Signal 3: A run up or down of seven consecutive points (trend). Seven points in a row all increasing or all decreasing equivalent to a run downward or upward.
+- Signal 4: Two out of three consecutive points beyond the warning (two sigma) limits (increasing variation).
+- Signal 5:Hugging the central line, this is indicated when 15 consecutive points are within the one sigma limits (reducing variation).
+- Signal 6: Eight consecutive points are beyond the one sigma limits, regardless of which side of the central line (bimodal distribution).
+
+The lack of control in both average and variation charts is generally found in the initial stages of setting up of control charts, sometimes called Phase 1 control charts. Using all six signals is only applicable for the average chart during Phase 1 when the control chart is used as an analysis tool. The first three signals are used always, for variables as well as attributes control charts.
+
+In the case that the data of the individual and moving Range chart (X-mR chart) violate the pre assumption (normality and independently distributed) only signal 1 is applied. Autocorrelation is an indication of that.
-- Test 1: One point beyond the control limits (sporadic issue).
-- Test 2: Seven consecutive points above or below the central line (mean shift).
-- Test 3: A run up or down of seven consecutive points (trend).
-- Test 4: Two out of three consecutive points beyond the warning (two sigma) limits (increasing variation).
-- Test 5:Hugging the central line, this is indicated when 15 consecutive points are within the one sigma limits (reducing variation).
-- Test 6: Eight consecutive points are beyond the one sigma limits, regardless of which side of the central line (bimodal distribution).
## References
-------
-- Duncan, A.J. (1986), Quality control and industrial statistics, Richard D. Irwin, Inc., and Automotive Industry Action Group (July 2005), Statistical process control (SPC) – Reference manual, AIAG.
-- Dodson, B., Lynch, D., Weidenbacher, M., & Klerx, R. (2009).*Statistical process control handbook*. SKF group.
+
+- Duncan, A.J. (1986), *Quality control and industrial statistics*, Richard D. Irwin, Inc.
+- Automotive Industry Action Group, *Statistical Process Control – Reference Manual* (July 2005, 2nd Edition)
+- SKF Quality Techniques, Klerx, R., Dodson, B., and Dumont, D., QT 1 – *Process capability studies* (PUB GQ/P9 10347/1 EN – December 2021)
+- SKF Quality Techniques, Dodson, B., Lynch, D., Weidenbacher, M., and Klerx, R., QT 2 – *Statistical process control* (PUB GQS/P9 18343 EN – April 2019)
+- International Organization for Standardization, *Control charts – Part 2: Shewhart control charts*, ISO 7870-2:2023 (E)
+
## R Packages
-------
diff --git a/inst/help/rareEventCharts.md b/inst/help/rareEventCharts.md
new file mode 100644
index 00000000..337355fe
--- /dev/null
+++ b/inst/help/rareEventCharts.md
@@ -0,0 +1,57 @@
+Rare Event Charts
+==========================
+Two very effective alternatives to the Shewhart control chart may be used when monitoring rare events or when small process shifts are of interest: the g chart and the t chart. These charts are particularly useful for situations where events occur infrequently and traditional Shewhart control charts may not be as effective. The g and t charts belong to the broader category of rare event control charts and are designed to handle scenarios where monitoring time between events or the number of opportunities between events is more meaningful than tracking continuous data points.
+
+- **G Chart**: Used to monitor the number of opportunities (such as units produced or time intervals) between rare events. It is particularly effective in processes where defects are infrequent and the main interest is in the distance between these occurrences.
+
+- **T Chart**: Used to monitor the time between rare events. This chart is suitable for processes where time intervals are of interest, such as monitoring the time between machine breakdowns, customer complaints, or other rare events.
+
+The g and t charts are essential tools in Statistical Quality Control (SQC) when dealing with rare events, providing a more sensitive approach to detect shifts in processes where events do not occur frequently enough for traditional methods to be effective.
+
+## Input
+--------
+
+### Assignment box
+--------
+- Variable: either the timepoint when the event took place or the intervals beetween events.
+- Stages: a column to split the analysis into multiple parts by assigning a stage to each subgroup.
+
+### Data type
+-------
+- Date/time: if your data specify a timepoint at which the event took place.
+ - Structure: the structure of your timepoints, either only dates (e.g., 01/12), only time (e.g., 12:30), date and time (e.g., 01/12 12:30), or time and date (e.g., 12:30 01/12).
+ - Date format: the date format in your data, where D = day, M = month, Y = year, thus, DMY = Day Month Year, for example 30/12/2024. The symbol used as separator does not matter.
+ - Time format: the time format in your data, where H = hour, M = minute, S = second, thus, HMS = Hour Minute Second, for example 01:02:03. The symbol used as separator does not matter. Ip and IpM refer to integer hours and integer hours with minutes, for example, 12pm or 12:30pm.
+- Interval between events: if your data specify the time or number of opportunities between events.
+ - Interval type: the unit in which your interval is expressed. Opportunities, hours (decimal) and days (decimal) are read as is, where times are treated as decimal, so 1.25 hours = 1 hour 15 minutes. If you select time as interval type, you will need to specify the time format, as explained above.
+
+### Chart options
+--------
+- G chart: select to display a G chart.
+ - Proportion estimated from data: the proportion is calculated from the data and used for all other calculations of the G chart.
+ - Proportion historical: a historical proportion value is used for all other calculations of the G chart.
+
+- T chart: select to display a T chart.
+ - Based on Weibull/exponential distribution: the distribution function that used to calculate the control limits in the T chart.
+ - Distribution parameters estimed from data: the distribution parameters for the Weibull/exponentital distribution are calculated from the data (best fit) and used for all other calculations of the T chart.
+ - Distribution parameters historical: historical distribution parameters for the Weibull/exponentital distribution are provided and used for all other calculations of the T chart.
+
+## Output
+--------
+### Charts
+--------
+- G chart: A graphical representation showing the number of time units or opportunities between rare events, highlighting any deviations from expected intervals that might indicate a process shift.
+
+- T chart: A graphical representation showing the time intervals between rare events, allowing for easy identification of shifts in the process that could signify increased risk or process degradation.
+
+
+## References
+--------
+- Montgomery, D. C. (2009). *Introduction to Statistical Quality Control*. John Wiley & Sons.
+
+## R Packages
+-------
+- ggplot2
+- qcc
+- jaspGraphs
+- ggrepel
diff --git a/inst/help/timeWeightedCharts.md b/inst/help/timeWeightedCharts.md
new file mode 100644
index 00000000..d8837193
--- /dev/null
+++ b/inst/help/timeWeightedCharts.md
@@ -0,0 +1,83 @@
+Time Weighted Charts
+==========================
+Two very effective alternatives to the Shewhart control chart may be used when small process shifts are of interest: the cumulative sum (CUSUM) control chart, and the exponentially weighted moving average (EWMA) control chart. CUSUM and EWMA control charts are excellent alternatives to the Shewhart control chart for phase II process monitoring situations. Collectively, the CUSUM and EWMA control chart are sometimes called time-weighted control charts.
+
+The cumulative sum chart and the exponentially weighted moving average (EWMA) charts are also monitors the mean of the process, but the basic difference is unlike X-bar charts they consider the previous value means at each point. Moreover, these charts are considered as a reliable estimate when correct standard deviation exists.
+
+## CUSUM control chart
+--------
+### Features of cumulative sum (CUSUM) control charts
+--------
+A CUSUM control chart is essentially a running total of deviations from some preselected reference value. The mean of any group of consecutive values is represented visually by the current slope of the graph. The basic advantage of a CUSUM chart is that it is more sensitive to small shifts of the process mean when compared to the Shewhart control charts.
+
+### When to use
+--------
+- The false alarm rate of a Shewhart control chart is too high.
+- The process rate is so high that false alarms are hardly acceptable.
+- Small process changes (less than one sigma) must be detected quickly.
+- Automation is available to update the chart in real time.
+
+In general, the underlying distribution is supposed to be normal, but CUSUM control charts can be used as well for binomial and Poisson distributions for modelling nonconformities and fraction nonconforming.
+
+### Assumptions
+--------
+The basic assumptions for a CUSUM control chart are:
+
+1. the measurements must be sequential or time sequenced;
+2. the measurements are independent of each other – one data point does not determine or impact the next data point;
+3. the measurements are approximately normally distributed, or the sample size of each plotted point is large enough so the average yields an approximate normal distribution.
+
+## Input
+--------
+
+### Assignment box
+--------
+- Measurements: the observations collected from a process.
+- Subgroups ("Column" option): the subgroup that each observation is assigned to, if all observations are in the same column.
+- Timestamp ("Row" option): optinal subgroup names for each row of observations, that are used as x-axis labels.
+- Stages: a column to split the analysis into multiple parts by assigning a stage to each subgroup. In "row" format, only one stage per subgroup is possible. In "column" format, only the first specified stage for each subgroup is considered.
+
+### Specifying subgroups in "Column" format
+-------
+- Through grouping variable: a single-column subgroup variable is specified that assigns each observation to a subgroup.
+ - Grouping method: if identical values of the subgroup variable are not adjacent in the dataset (top to bottom), there are two methods to handle this. If the grouping method is "Subgroup value change", only series of identical and adjacent subgroup values form a group. If the grouping method is "Same subgroup value", all identical subgroup values form a group, regardless of their adjacency. For instance, if the values of the subgroup variable are [A, A, B, B, A], the method "Subgroup value change" would yield three groups: [A, A], [B, B] and [A]. The method "Same subgroup value" would yield two groups, [A, A, A] and [B, B].
+- Subgroup size: the observations are assigned in the order of appearence (from top to bottom) to subgroups of the specified size. If the number of observations cannot be equally divided into subgroups of the specified size, the last subgroup has the size of the remaining observations.
+
+### Chart options
+--------
+- Target: Value to use as a target
+
+- Average run length (ARL): The number of plotted points until special cause variation is signalled is the average run length (ARL). It is a function of the process mean shift.
+
+- Number of standard deviations (*h*): Standardised decision interval
+
+- Shift size (*k*): *k* is usually called the reference value (or the allowance, or the slack value), and it is often chosen about halfway between the target (µ0) and the out‑of‑control value of the mean (µ1) that we are interested in detecting quickly.
+
+The proper selection of these two parameters (*h* and *k*) is quite important, as it has substantial impact on the performance of the CUSUM. Calculate the reference value or allowable slack, since CUSUM chart is used to monitor the small shifts, generally 0.5 to 1 σ will be considered. *k* = 0.5 σ. Compute decision interval *h*, generally ± 4 σ will be considered (some place ± 5 σ also be used).
+
+## Recommendations for CUSUM design
+--------
+The tabular CUSUM is designed by choosing values for the reference value *k* and the decision interval *h*. It is usually recommended that these parameters be selected to provide good average run length performance. There have been many analytical studies of CUSUM ARL performance. Based on these studies, we may give some general recommendations for selecting *h* and *k*. Define H = *h* σ and K = *k* σ, where σ is the standard deviation of the sample variable used in forming the CUSUM. Using *h* = 4 or *h* = 5 and *k* = ½ will generally provide a CUSUM that has good ARL properties against a shift of about 1 σ in the process mean.
+
+## Output
+--------
+### Charts
+--------
+CUSUM statistics are cumulative deviations from the target, or nominal.
+
+Graphical display for the tabular CUSUM. These charts are sometimes called CUSUM status charts. They are constructed by plotting C+i and C−i versus the sample number.
+
+## References
+--------
+- Page, E.S. (1954), *Continuous inspection schemes*, Biometrika, Vol. 41, No. 1-2, pp. 100-115
+- Roberts, S.W. (1959), *Control chart tests based on geometric moving averages*, Technometrics, Vol. 1, No. 3, pp. 239-250
+- SKF Quality Techniques, Dodson, B., Lynch, D., Weidenbacher, M., and Klerx, R., *QT 2 – Statistical process control* (PUB GQS/P9 18343 EN – April 2019)
+- International Organization for Standardization, *Control charts – Part 4: Cumulative sum charts*, ISO 7870-4:2021 (E)
+- Montgomery D. C. (2013), *Introduction to statistical quality control (7th Ed.)*, John Wiley & Sons, Inc , Hoboken (NJ)
+
+## R Packages
+-------
+- ggplot2
+- qcc
+- jaspGraphs
+- ggrepel
diff --git a/inst/qml/processCapabilityStudies.qml b/inst/qml/processCapabilityStudies.qml
index 4f438d28..205a167b 100644
--- a/inst/qml/processCapabilityStudies.qml
+++ b/inst/qml/processCapabilityStudies.qml
@@ -21,7 +21,6 @@ Form
{
columns: 2
-
DropDown
{
name: "dataFormat"
diff --git a/inst/qml/rareEventCharts.qml b/inst/qml/rareEventCharts.qml
new file mode 100644
index 00000000..261bf74a
--- /dev/null
+++ b/inst/qml/rareEventCharts.qml
@@ -0,0 +1,392 @@
+import QtQuick 2.8
+import QtQuick.Layouts 1.3
+import JASP.Controls 1.0
+import JASP.Widgets 1.0
+
+Form
+{
+ columns: 2
+
+ VariablesForm
+ {
+ id: variablesForm
+ AvailableVariablesList
+ {
+ name: "variablesForm"
+ }
+
+ AssignedVariablesList
+ {
+ name: "variable"
+ title: qsTr("Variable")
+ id: variable
+ allowedColumns: dataType.value == "dataTypeInterval" & dataTypeIntervalType.value != "time" ? ["scale"] : ["nominal"]
+ singleVariable: true
+ }
+
+ AssignedVariablesList
+ {
+ name: "stage"
+ title: qsTr("Stage")
+ id: stages
+ allowedColumns: ["nominal"]
+ singleVariable: true
+ }
+ }
+
+ RadioButtonGroup
+ {
+ name: "dataType"
+ title: qsTr("Data type")
+ id: dataType
+
+ RadioButton
+ {
+ value: "dataTypeDates"
+ label: qsTr("Date/time")
+ checked: true
+
+ DropDown
+ {
+ name: "dataTypeDatesStructure"
+ id: dataTypeDatesStructure
+ label: qsTr("Structure")
+ values:
+ [
+ { label: qsTr("Date + Time"), value: "dateTime"},
+ { label: qsTr("Time + Date"), value: "timeDate"},
+ { label: qsTr("Date only"), value: "dateOnly"},
+ { label: qsTr("Time only"), value: "timeOnly"}
+ ]
+ indexDefaultValue: 0
+ }
+
+ DropDown
+ {
+ name: "dataTypeDatesFormatDate"
+ id: dataTypeDatesFormatDate
+ label: qsTr("Date format")
+ visible: dataTypeDatesStructure.value != "timeOnly"
+ values:
+ [
+ { label: qsTr("DMY"), value: "dmy"},
+ { label: qsTr("MDY"), value: "mdy"},
+ { label: qsTr("YMD"), value: "ymd"},
+ { label: qsTr("DM"), value: "dm"},
+ { label: qsTr("MD"), value: "md"}
+ ]
+ indexDefaultValue: 3
+ }
+
+ DropDown
+ {
+ name: "dataTypeDatesFormatTime"
+ id: dataTypeDatesFormatTime
+ label: qsTr("Time format")
+ visible: dataTypeDatesStructure.value != "dateOnly"
+ values:
+ [
+ { label: qsTr("H"), value: "H"},
+ { label: qsTr("HM"), value: "HM"},
+ { label: qsTr("HMS"), value: "HMS"},
+ { label: qsTr("Ip"), value: "Ip"},
+ { label: qsTr("IMp"), value: "IMp"}
+ ]
+ indexDefaultValue: 1
+ }
+ }
+
+ RadioButton
+ {
+ value: "dataTypeInterval"
+ label: qsTr("Interval between events")
+ childrenOnSameRow: false
+
+ DropDown
+ {
+ name: "dataTypeIntervalType"
+ id: dataTypeIntervalType
+ label: qsTr("Interval type")
+ values:
+ [
+ { label: qsTr("Opportunities"), value: "opportunities"},
+ { label: qsTr("Time"), value: "time"},
+ { label: qsTr("Hours (decimal)"), value: "hours"},
+ { label: qsTr("Days (decimal)"), value: "days"}
+ ]
+ indexDefaultValue: 0
+ }
+
+ DropDown
+ {
+ name: "dataTypeIntervalTimeFormat"
+ id: dataTypeIntervalTimeFormat
+ label: qsTr("Time format")
+ visible: dataTypeIntervalType.value == "time"
+ values:
+ [
+ { label: qsTr("H"), value: "H"},
+ { label: qsTr("HM"), value: "HM"},
+ { label: qsTr("HMS"), value: "HMS"},
+ { label: qsTr("Ip"), value: "Ip"},
+ { label: qsTr("IMp"), value: "IMp"}
+ ]
+ indexDefaultValue: 1
+ }
+ }
+
+ }
+
+ Group
+ {
+ CheckBox
+ {
+ name: "gChart"
+ label: qsTr("G chart")
+ checked: true
+
+ DropDown
+ {
+ name: "gChartProportionSource"
+ id: gChartProportionSource
+ label: qsTr("Proportion")
+ values:
+ [
+ { label: qsTr("Estimated from data"), value: "data"},
+ { label: qsTr("Historical"), value: "historical"}
+ ]
+ indexDefaultValue: 0
+ }
+
+ DoubleField
+ {
+ name: "gChartHistoricalProportion"
+ id: gChartHistoricalProportion
+ label: qsTr("Proportion value")
+ min: 0
+ max: 1
+ visible: gChartProportionSource.value == "historical"
+ defaultValue: 0.5
+ }
+ }
+
+ CheckBox
+ {
+ name: "tChart"
+ label: qsTr("T chart")
+ checked: true
+
+ DropDown
+ {
+ name: "tChartDistribution"
+ id: tChartDistribution
+ label: qsTr("Based on")
+ values:
+ [
+ { label: qsTr("Weibull distribution"), value: "weibull"},
+ { label: qsTr("Exponential distribution"), value: "exponential"}
+ ]
+ indexDefaultValue: 0
+ }
+
+ DropDown
+ {
+ name: "tChartDistributionParameterSource"
+ id: tChartDistributionParameterSource
+ label: qsTr("Distribution parameters")
+ values:
+ [
+ { label: qsTr("Estimated from data"), value: "data"},
+ { label: qsTr("Historical"), value: "historical"}
+ ]
+ indexDefaultValue: 0
+ }
+
+ DoubleField
+ {
+ name: "tChartHistoricalParametersWeibullShape"
+ id: tChartHistoricalParametersWeibullShape
+ label: qsTr("Shape")
+ min: 0
+ inclusive: JASP.None
+ visible: tChartDistributionParameterSource.value == "historical" & tChartDistribution.value == "weibull"
+ defaultValue: 2
+ }
+
+
+ DoubleField
+ {
+ name: "tChartHistoricalParametersScale"
+ id: tChartHistoricalParametersScale
+ label: qsTr("Scale")
+ min: 0
+ inclusive: JASP.None
+ visible: tChartDistributionParameterSource.value == "historical"
+ defaultValue: 2
+ }
+ }
+ }
+
+
+ Section
+ {
+ title: qsTr("Rare Event Charts Report")
+
+ CheckBox
+ {
+ name: "report"
+ label: qsTr("Show Report")
+ columns: 1
+
+ CheckBox
+ {
+ name: "reportMetaData"
+ label: qsTr("Show report metadata")
+ checked: true
+ columns: 2
+
+ CheckBox
+ {
+ name: "reportTitle"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportTitleText"
+ label: qsTr("Title")
+ id: reportTitleText
+ placeholderText: qsTr("Variable Charts for Subgroups Report")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportChartName"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportChartNameText"
+ label: qsTr("Chart name")
+ placeholderText: qsTr("Name of the chart")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportSubtitle"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportSubtitleText"
+ label: qsTr("Sub-title")
+ placeholderText: qsTr("Sub-title")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportMeasurementName"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportMeasurementNameText"
+ label: qsTr("Measurement name")
+ id: reportMeasurementNameText
+ placeholderText: qsTr("Name")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportFootnote"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportFootnoteText"
+ label: qsTr("Footnote")
+ id: reportFootnoteText
+ placeholderText: qsTr("Comment")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportLocation"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportLocationText"
+ label: qsTr("Location")
+ id: reportLocationText
+ placeholderText: qsTr("Location")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportDate"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportDateText"
+ label: qsTr("Date")
+ id: reportDateText
+ placeholderText: qsTr("Date")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportPerformedBy"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportPerformedByText"
+ label: qsTr("Performed by")
+ id: reportPerformedByText
+ placeholderText: qsTr("Analyst")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportPrintDate"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportPrintDateText"
+ label: qsTr("Date printed")
+ id: reportPrintDateText
+ placeholderText: qsTr("Today")
+ fieldWidth: 100
+ }
+ }
+ }
+ }
+ }
+}
diff --git a/inst/qml/timeWeightedCharts.qml b/inst/qml/timeWeightedCharts.qml
index aac05c85..9a108c39 100644
--- a/inst/qml/timeWeightedCharts.qml
+++ b/inst/qml/timeWeightedCharts.qml
@@ -5,28 +5,157 @@ import JASP.Widgets 1.0
Form
{
- columns: 1
+ columns: 2
+
+ DropDown
+ {
+ name: "dataFormat"
+ label: qsTr("Data format")
+ id: dataFormat
+ indexDefaultValue: 0
+ values: [
+ { label: qsTr("Single column"), value: "longFormat"},
+ { label: qsTr("Across rows"), value: "wideFormat"}
+ ]
+ }
VariablesForm
{
- preferredHeight: jaspTheme.smallDefaultVariablesFormHeight
+ id: variablesFormLongFormat
+ visible: dataFormat.currentValue == "longFormat"
AvailableVariablesList
{
- name: "variablesForm"
+ name: "variablesFormLongFormat"
}
AssignedVariablesList
{
- name: "measurements"
+ name: "measurementLongFormat"
+ title: qsTr("Measurement")
+ id: measurementLongFormat
+ allowedColumns: ["scale"]
+ singleVariable: true
+ }
+
+ AssignedVariablesList
+ {
+ id: subgroup
+ name: "subgroup"
+ title: subgroupSizeType.value == "individual" ? qsTr("Timestamp (optional)") : qsTr("Subgroups")
+ singleVariable: true
+ allowedColumns: ["nominal"]
+ enabled: subgroupSizeType.value == "groupingVariable" | subgroupSizeType.value == "individual"
+ }
+
+ AssignedVariablesList
+ {
+ name: "stagesLongFormat"
+ id: stagesLongFormat
+ title: qsTr("Stages")
+ singleVariable: true
+ allowedColumns: ["nominal"]
+ }
+ }
+
+
+ VariablesForm
+ {
+ id: variablesFormWideFormat
+ visible: dataFormat.currentValue == "wideFormat"
+
+ AvailableVariablesList
+ {
+ name: "variablesFormWideFormat"
+ }
+
+
+ AssignedVariablesList
+ {
+ name: "measurementsWideFormat"
title: qsTr("Measurements")
+ id: measurementsWideFormat
allowedColumns: ["scale"]
}
+
+
+
+ AssignedVariablesList
+ {
+ id: axisLabels
+ name: "axisLabels"
+ title: qsTr("Timestamp (optional)")
+ singleVariable: true
+ allowedColumns: ["nominal"]
+ }
+
+ AssignedVariablesList
+ {
+ name: "stagesWideFormat"
+ id: stagesWideFormat
+ title: qsTr("Stages")
+ singleVariable: true
+ allowedColumns: ["nominal"]
+ }
}
Group
{
- columns: 1
+
+ RadioButtonGroup
+ {
+ name: "subgroupSizeType"
+ title: qsTr("Specify subgroups")
+ id: subgroupSizeType
+ visible: dataFormat.currentValue == "longFormat"
+
+ RadioButton
+ {
+ value: "individual"
+ label: qsTr("No subgroups (n = 1)")
+ checked: true
+ }
+
+ RadioButton
+ {
+ value: "manual"
+ label: qsTr("Subgroup size")
+ childrenOnSameRow: true
+
+ IntegerField
+ {
+ name: "manualSubgroupSizeValue"
+ min: 2
+ defaultValue: 5
+ }
+ }
+
+ RadioButton
+ {
+ value: "groupingVariable"
+ label: qsTr("Through grouping variable")
+
+ DropDown
+ {
+ name: "groupingVariableMethod"
+ id: groupingVariable
+ label: "Grouping method"
+ values:
+ [
+ { label: qsTr("Subgroup value change"), value: "newLabel"},
+ { label: qsTr("Same subgroup value"), value: "sameLabel"}
+ ]
+ indexDefaultValue: 0
+ }
+ }
+
+ }
+ }
+
+
+
+ Group
+ {
CheckBox
{
@@ -37,9 +166,8 @@ Form
DoubleField
{
name: "cumulativeSumChartNumberSd"
- label: qsTr("Number of standard deviations")
+ label: qsTr("Number of std. dev. for control limits")
defaultValue: 4
- enabled: variationReference.currentValue != "studyVariation"
}
DoubleField
@@ -47,7 +175,63 @@ Form
name: "cumulativeSumChartShiftSize"
label: qsTr("Shift size")
defaultValue: 0.5
- enabled: variationReference.currentValue != "studyVariation"
+ }
+
+ DoubleField
+ {
+ name: "cumulativeSumChartTarget"
+ label: qsTr("Target")
+ defaultValue: 0
+ }
+
+ Group
+ {
+ DropDown
+ {
+ name: "cumulativeSumChartSdSource"
+ label: qsTr("Std. dev.")
+ id: cumulativeSumChartSdSource
+ indexDefaultValue: 0
+ values: [
+ { label: qsTr("Estimated from data"), value: "data"},
+ { label: qsTr("Historical"), value: "historical"}
+ ]
+ }
+
+ DropDown
+ {
+ name: "cumulativeSumChartSdMethod"
+ visible: cumulativeSumChartSdSource.currentValue == "data"
+ label: qsTr("Std. dev. estimation method")
+ id: cumulativeSumChartSdMethod
+ values: (subgroupSizeType.value == "individual" & dataFormat.currentValue == "longFormat") ?
+ [
+ { label: qsTr("X-mR"), value: "averageMovingRange"}
+ ] :
+ [
+ { label: qsTr("S-bar"), value: "s"},
+ { label: qsTr("R-bar"), value: "r"}
+ ]
+ indexDefaultValue: subgroupSizeType.value == "individual" ? 0 : 1
+ }
+
+ DoubleField
+ {
+ name: "cumulativeSumChartSdValue"
+ label: qsTr("Std. dev. value")
+ visible: cumulativeSumChartSdSource.currentValue == "historical"
+ defaultValue: 3
+ fieldWidth: 50
+ }
+
+ IntegerField
+ {
+ name: "cumulativeSumChartAverageMovingRangeLength"
+ label: qsTr("Moving range length")
+ visible: exponentiallyWeightedMovingAverageChartSdSource.currentValue == "data" & cumulativeSumChartSdMethod.currentValue == "averageMovingRange"
+ min: 2
+ defaultValue: 2
+ }
}
}
@@ -56,45 +240,234 @@ Form
name: "exponentiallyWeightedMovingAverageChart"
label: qsTr("Exponentially weighted moving average chart")
+
DoubleField
{
- name: "exponentiallyWeightedMovingAverageChartLambda"
- label: qsTr("Lambda")
- defaultValue: 0.3
+ name: "exponentiallyWeightedMovingAverageChartSigmaControlLimits"
+ label: qsTr("Number of std. dev. for control limits")
+ defaultValue: 3
}
DoubleField
{
- name: "exponentiallyWeightedMovingAverageChartCenter"
- label: qsTr("Center")
+ name: "exponentiallyWeightedMovingAverageChartLambda"
+ label: qsTr("Lambda (smoothing parameter)")
+ defaultValue: 0.3
}
- DoubleField
+ Group
{
- name: "exponentiallyWeightedMovingAverageChartSd"
- label: qsTr("Within-group standard deviation")
- defaultValue: 3
- fieldWidth: 50
- }
+ DropDown
+ {
+ name: "exponentiallyWeightedMovingAverageChartSdSource"
+ label: qsTr("In-control std. dev.")
+ id: exponentiallyWeightedMovingAverageChartSdSource
+ indexDefaultValue: 0
+ values: [
+ { label: qsTr("Estimated from data"), value: "data"},
+ { label: qsTr("Historical"), value: "historical"}
+ ]
+ }
+
+ DropDown
+ {
+ name: "exponentiallyWeightedMovingAverageChartSdMethod"
+ visible: exponentiallyWeightedMovingAverageChartSdSource.currentValue == "data"
+ label: qsTr("Std. dev. estimation method")
+ id: exponentiallyWeightedMovingAverageChartSdMethod
+ values: subgroupSizeType.value == "individual" ?
+ [
+ { label: qsTr("X-mR"), value: "averageMovingRange"}
+ ] :
+ [
+ { label: qsTr("S-bar"), value: "s"},
+ { label: qsTr("R-bar"), value: "r"}
+ ]
+ indexDefaultValue: subgroupSizeType.value == "individual" ? 0 : 1
+ }
+
+ DoubleField
+ {
+ name: "exponentiallyWeightedMovingAverageChartSdValue"
+ label: qsTr("Std. dev. value")
+ visible: exponentiallyWeightedMovingAverageChartSdSource.currentValue == "historical"
+ defaultValue: 3
+ fieldWidth: 50
+ }
+
+ IntegerField
+ {
+ name: "exponentiallyWeightedMovingAverageChartMovingRangeLength"
+ label: qsTr("Moving range length")
+ visible: exponentiallyWeightedMovingAverageChartSdSource.currentValue == "data" & exponentiallyWeightedMovingAverageChartSdMethod.currentValue == "averageMovingRange"
+ min: 2
+ defaultValue: 2
+ }
+
- DoubleField
- {
- name: "exponentiallyWeightedMovingAverageChartSigmaControlLimits"
- label: qsTr("Sigmas for computing control limits")
- defaultValue: 3
}
}
+ }
+
+ Section
+ {
+ title: qsTr("Time Weighted Charts Report")
CheckBox
{
- name: "gChart"
- label: qsTr("g chart")
- }
+ name: "report"
+ label: qsTr("Show Report")
+ columns: 1
+
+ CheckBox
+ {
+ name: "reportMetaData"
+ label: qsTr("Show report metadata")
+ checked: true
+ columns: 2
+
+ CheckBox
+ {
+ name: "reportTitle"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportTitleText"
+ label: qsTr("Title")
+ id: reportTitleText
+ placeholderText: qsTr("Variable Charts for Subgroups Report")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportChartName"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportChartNameText"
+ label: qsTr("Chart name")
+ placeholderText: qsTr("Name of the chart")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportSubtitle"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportSubtitleText"
+ label: qsTr("Sub-title")
+ placeholderText: qsTr("Sub-title")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportMeasurementName"
+ checked: true
+ childrenOnSameRow: true
- // CheckBox
- // {
- // name: "tchart"
- // label: qsTr("t chart")
- // }
+ TextField
+ {
+ name: "reportMeasurementNameText"
+ label: qsTr("Measurement name")
+ id: reportMeasurementNameText
+ placeholderText: qsTr("Name")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportFootnote"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportFootnoteText"
+ label: qsTr("Footnote")
+ id: reportFootnoteText
+ placeholderText: qsTr("Comment")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportLocation"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportLocationText"
+ label: qsTr("Location")
+ id: reportLocationText
+ placeholderText: qsTr("Location")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportDate"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportDateText"
+ label: qsTr("Date")
+ id: reportDateText
+ placeholderText: qsTr("Date")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportPerformedBy"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportPerformedByText"
+ label: qsTr("Performed by")
+ id: reportPerformedByText
+ placeholderText: qsTr("Analyst")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportPrintDate"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportPrintDateText"
+ label: qsTr("Date printed")
+ id: reportPrintDateText
+ placeholderText: qsTr("Today")
+ fieldWidth: 100
+ }
+ }
+ }
+ }
}
}
diff --git a/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-process20-subplot-2.svg b/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-process20-subplot-2.svg
index af496e1f..1b2955c5 100644
--- a/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-process20-subplot-2.svg
+++ b/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-process20-subplot-2.svg
@@ -27,52 +27,59 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-Target
+
+Target
+
+LSL
USL
-
+
-
-
-
-
-
+
+
+
+
+
-2
-4
-6
-8
-10
+2
+4
+6
+8
+10
12
Measurement
Density
diff --git a/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-processw10-subplot-3.svg b/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-processw10-subplot-3.svg
index 376e811f..e97f6fdb 100644
--- a/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-processw10-subplot-3.svg
+++ b/tests/testthat/_snaps/processCapabilityStudies/capability-of-the-processw10-subplot-3.svg
@@ -27,52 +27,59 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-Target
+
+Target
+
+LSL
USL
-
+
-
-
-
-
-
+
+
+
+
+
-2
-4
-6
-8
-10
+2
+4
+6
+8
+10
12
Measurement
Density
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart1.svg b/tests/testthat/_snaps/rareEventCharts/g-chart1.svg
new file mode 100644
index 00000000..6897bc01
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart1.svg
@@ -0,0 +1,113 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart10.svg b/tests/testthat/_snaps/rareEventCharts/g-chart10.svg
new file mode 100644
index 00000000..0b551a3f
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart10.svg
@@ -0,0 +1,130 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart11.svg b/tests/testthat/_snaps/rareEventCharts/g-chart11.svg
new file mode 100644
index 00000000..73d16d54
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart11.svg
@@ -0,0 +1,135 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart12.svg b/tests/testthat/_snaps/rareEventCharts/g-chart12.svg
new file mode 100644
index 00000000..9e8d84c6
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart12.svg
@@ -0,0 +1,107 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart2.svg b/tests/testthat/_snaps/rareEventCharts/g-chart2.svg
new file mode 100644
index 00000000..dde333d0
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart2.svg
@@ -0,0 +1,113 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart3.svg b/tests/testthat/_snaps/rareEventCharts/g-chart3.svg
new file mode 100644
index 00000000..8ad891df
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart3.svg
@@ -0,0 +1,107 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart4.svg b/tests/testthat/_snaps/rareEventCharts/g-chart4.svg
new file mode 100644
index 00000000..7e0b466c
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart4.svg
@@ -0,0 +1,107 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart5.svg b/tests/testthat/_snaps/rareEventCharts/g-chart5.svg
new file mode 100644
index 00000000..b63adb3e
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart5.svg
@@ -0,0 +1,107 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart6.svg b/tests/testthat/_snaps/rareEventCharts/g-chart6.svg
new file mode 100644
index 00000000..ca801ab7
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart6.svg
@@ -0,0 +1,107 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart7.svg b/tests/testthat/_snaps/rareEventCharts/g-chart7.svg
new file mode 100644
index 00000000..0153a219
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart7.svg
@@ -0,0 +1,112 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart8.svg b/tests/testthat/_snaps/rareEventCharts/g-chart8.svg
new file mode 100644
index 00000000..321543d1
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart8.svg
@@ -0,0 +1,114 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/g-chart9.svg b/tests/testthat/_snaps/rareEventCharts/g-chart9.svg
new file mode 100644
index 00000000..a806d30e
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/g-chart9.svg
@@ -0,0 +1,108 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-1.svg b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-1.svg
new file mode 100644
index 00000000..978b6dba
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-1.svg
@@ -0,0 +1,33 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-2.svg b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-2.svg
new file mode 100644
index 00000000..3a4d2927
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-2.svg
@@ -0,0 +1,107 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-3.svg b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-3.svg
new file mode 100644
index 00000000..e1d8250a
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-3.svg
@@ -0,0 +1,111 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-4.svg b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-4.svg
new file mode 100644
index 00000000..6f060ae9
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-4.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-5.svg b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-5.svg
new file mode 100644
index 00000000..a0bf8f6c
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-5.svg
@@ -0,0 +1,41 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-6.svg b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-6.svg
new file mode 100644
index 00000000..c2b764a6
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/rare-event-charts-report1-subplot-6.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart1.svg b/tests/testthat/_snaps/rareEventCharts/t-chart1.svg
new file mode 100644
index 00000000..a8ad8c4f
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart1.svg
@@ -0,0 +1,109 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart10.svg b/tests/testthat/_snaps/rareEventCharts/t-chart10.svg
new file mode 100644
index 00000000..7c76e6d0
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart10.svg
@@ -0,0 +1,134 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart11.svg b/tests/testthat/_snaps/rareEventCharts/t-chart11.svg
new file mode 100644
index 00000000..064ad489
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart11.svg
@@ -0,0 +1,133 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart12.svg b/tests/testthat/_snaps/rareEventCharts/t-chart12.svg
new file mode 100644
index 00000000..2856f2a4
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart12.svg
@@ -0,0 +1,107 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart13.svg b/tests/testthat/_snaps/rareEventCharts/t-chart13.svg
new file mode 100644
index 00000000..79daac33
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart13.svg
@@ -0,0 +1,113 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart2.svg b/tests/testthat/_snaps/rareEventCharts/t-chart2.svg
new file mode 100644
index 00000000..55bc4356
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart2.svg
@@ -0,0 +1,109 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart3.svg b/tests/testthat/_snaps/rareEventCharts/t-chart3.svg
new file mode 100644
index 00000000..0a681a4b
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart3.svg
@@ -0,0 +1,111 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart4.svg b/tests/testthat/_snaps/rareEventCharts/t-chart4.svg
new file mode 100644
index 00000000..75b36eb9
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart4.svg
@@ -0,0 +1,111 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart5.svg b/tests/testthat/_snaps/rareEventCharts/t-chart5.svg
new file mode 100644
index 00000000..e5219842
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart5.svg
@@ -0,0 +1,111 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart6.svg b/tests/testthat/_snaps/rareEventCharts/t-chart6.svg
new file mode 100644
index 00000000..6c18f44e
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart6.svg
@@ -0,0 +1,111 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart7.svg b/tests/testthat/_snaps/rareEventCharts/t-chart7.svg
new file mode 100644
index 00000000..e4ece3b2
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart7.svg
@@ -0,0 +1,110 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart8.svg b/tests/testthat/_snaps/rareEventCharts/t-chart8.svg
new file mode 100644
index 00000000..f7f46be6
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart8.svg
@@ -0,0 +1,108 @@
+
+
diff --git a/tests/testthat/_snaps/rareEventCharts/t-chart9.svg b/tests/testthat/_snaps/rareEventCharts/t-chart9.svg
new file mode 100644
index 00000000..f63216a5
--- /dev/null
+++ b/tests/testthat/_snaps/rareEventCharts/t-chart9.svg
@@ -0,0 +1,108 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-lf1.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-lf1.svg
new file mode 100644
index 00000000..c9469196
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-lf1.svg
@@ -0,0 +1,126 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf1.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf1.svg
new file mode 100644
index 00000000..9f41d93f
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf1.svg
@@ -0,0 +1,110 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf2.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf2.svg
new file mode 100644
index 00000000..503588bc
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf2.svg
@@ -0,0 +1,137 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf3.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf3.svg
new file mode 100644
index 00000000..27392f60
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf3.svg
@@ -0,0 +1,112 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf4.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf4.svg
new file mode 100644
index 00000000..c3659a4f
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chart-wf4.svg
@@ -0,0 +1,112 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf2.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf2.svg
new file mode 100644
index 00000000..724be4ed
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf2.svg
@@ -0,0 +1,151 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf3.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf3.svg
new file mode 100644
index 00000000..efec5098
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf3.svg
@@ -0,0 +1,110 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf4.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf4.svg
new file mode 100644
index 00000000..ce936f48
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf4.svg
@@ -0,0 +1,334 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf5.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf5.svg
new file mode 100644
index 00000000..66df60ca
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf5.svg
@@ -0,0 +1,126 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf6.svg b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf6.svg
new file mode 100644
index 00000000..09da6dc6
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/cumulative-sum-chartlf6.svg
@@ -0,0 +1,124 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf1.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf1.svg
new file mode 100644
index 00000000..0b7be7ea
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf1.svg
@@ -0,0 +1,92 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf2.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf2.svg
new file mode 100644
index 00000000..c1d76a6e
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf2.svg
@@ -0,0 +1,119 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf3.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf3.svg
new file mode 100644
index 00000000..4880ac77
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf3.svg
@@ -0,0 +1,92 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf4.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf4.svg
new file mode 100644
index 00000000..f360c3df
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart-wf4.svg
@@ -0,0 +1,92 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart.svg
new file mode 100644
index 00000000..41e9b4e7
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chart.svg
@@ -0,0 +1,139 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf1.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf1.svg
new file mode 100644
index 00000000..f959f99c
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf1.svg
@@ -0,0 +1,86 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf3.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf3.svg
new file mode 100644
index 00000000..de8b5851
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf3.svg
@@ -0,0 +1,116 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf4.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf4.svg
new file mode 100644
index 00000000..6534d725
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf4.svg
@@ -0,0 +1,116 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf5.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf5.svg
new file mode 100644
index 00000000..0e4b7c39
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf5.svg
@@ -0,0 +1,90 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf6.svg b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf6.svg
new file mode 100644
index 00000000..d4bdcc98
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/exponentially-weighted-moving-average-chartlf6.svg
@@ -0,0 +1,86 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-1.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-1.svg
new file mode 100644
index 00000000..21dd5689
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-1.svg
@@ -0,0 +1,33 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-2.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-2.svg
new file mode 100644
index 00000000..57215b2e
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-2.svg
@@ -0,0 +1,110 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-3.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-3.svg
new file mode 100644
index 00000000..119dfa6c
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-3.svg
@@ -0,0 +1,92 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-4.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-4.svg
new file mode 100644
index 00000000..548ec914
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-4.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-5.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-5.svg
new file mode 100644
index 00000000..effb994e
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-5.svg
@@ -0,0 +1,41 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-6.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-6.svg
new file mode 100644
index 00000000..705720fa
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report-wf5-subplot-6.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-1.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-1.svg
new file mode 100644
index 00000000..f3fe2ee4
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-1.svg
@@ -0,0 +1,33 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-2.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-2.svg
new file mode 100644
index 00000000..e9f6e4ab
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-2.svg
@@ -0,0 +1,86 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-3.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-3.svg
new file mode 100644
index 00000000..566116be
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-3.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-4.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-4.svg
new file mode 100644
index 00000000..a44ef157
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-report7-2-subplot-4.svg
@@ -0,0 +1,41 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-1.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-1.svg
new file mode 100644
index 00000000..b4318ee7
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-1.svg
@@ -0,0 +1,33 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-2.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-2.svg
new file mode 100644
index 00000000..e386b017
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-2.svg
@@ -0,0 +1,126 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-3.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-3.svg
new file mode 100644
index 00000000..2cfdc4c4
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-3.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-4.svg b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-4.svg
new file mode 100644
index 00000000..c5600b3b
--- /dev/null
+++ b/tests/testthat/_snaps/timeWeightedCharts/time-weighted-charts-reportlf7-1-subplot-4.svg
@@ -0,0 +1,41 @@
+
+
diff --git a/tests/testthat/datasets/rareEventCharts/rareEventCharts.csv b/tests/testthat/datasets/rareEventCharts/rareEventCharts.csv
new file mode 100644
index 00000000..ff749754
--- /dev/null
+++ b/tests/testthat/datasets/rareEventCharts/rareEventCharts.csv
@@ -0,0 +1,38 @@
+"","X","MD","MDHM","DM","DMY","MDY","YMD","opportunities","decimalTime","decimalDays","stages"
+"1",1,"2/3","1/2 12:00","07-01","07-01-2024","01-07-2024","2024-01-07",94,6.63308813469484,4.02573342202231,1
+"2",2,"2/17","1/10 3:10","14-01","14-01-2024","01-14-2024","2024-01-14",6,12.3823835584335,8.80246541230008,1
+"3",3,"2/28","1/17 11:33","23-01","23-01-2024","01-23-2024","2024-01-23",72,7.97060060547665,3.64091864787042,1
+"4",4,"4/5","1/21 4:02","26-01","26-01-2024","01-26-2024","2024-01-26",86,18.8991916039959,2.88239280693233,1
+"5",5,"4/13","1/21 9:00","01-02","01-02-2024","02-01-2024","2024-02-01",86,5.51485472358763,1.70645235106349,1
+"6",6,"4/26","1/29 14:59","12-02","12-02-2024","02-12-2024","2024-02-12",39,25.9093233430758,1.72171746380627,1
+"7",7,"4/29","2/4 7:01","18-03","18-03-2024","03-18-2024","2024-03-18",31,22.3970401240513,4.8204260552302,1
+"8",8,"5/22","2/6 8:17","21-03","21-03-2024","03-21-2024","2024-03-21",81,20.048539491836,2.52964928513393,1
+"9",9,"5/26","2/7 20:06","30-03","30-03-2024","03-30-2024","2024-03-30",50,18.5405361978337,2.1625478961505,1
+"10",10,"6/3","2/9 4:58","31-03","31-03-2024","03-31-2024","2024-03-31",34,11.1671418067999,6.74376388080418,1
+"11",11,"6/26","2/9 22:53","18-04","18-04-2024","04-18-2024","2024-04-18",4,15.8950705756433,0.476636274252087,1
+"12",12,"7/10","2/11 3:26","27-04","27-04-2024","04-27-2024","2024-04-27",13,26.2404702859931,7.00853087473661,1
+"13",13,"7/15","2/14 0:44","14-05","14-05-2024","05-14-2024","2024-05-14",69,17.4525029934011,3.51888638455421,1
+"14",14,"7/16","2/14 12:20","16-05","16-05-2024","05-16-2024","2024-05-16",25,25.1930329436436,4.08943997928873,2
+"15",15,"7/23","2/19 8:31","22-05","22-05-2024","05-22-2024","2024-05-22",52,9.3734449474141,8.20951323956251,2
+"16",16,"7/31","2/19 11:18","01-06","01-06-2024","06-01-2024","2024-06-01",22,21.2487096665427,9.18857348151505,2
+"17",17,"8/6","2/20 3:30","27-06","27-06-2024","06-27-2024","2024-06-27",89,7.95053418260068,2.82528330106288,2
+"18",18,"8/7","2/21 22:27","13-07","13-07-2024","07-13-2024","2024-07-13",32,17.8302958211862,9.61104793706909,2
+"19",19,"8/25","2/25 17:52","15-07","15-07-2024","07-15-2024","2024-07-15",25,14.4386940146796,7.28394428268075,2
+"20",20,"8/27","2/28 14:32","29-07","29-07-2024","07-29-2024","2024-07-29",87,7.9509819438681,6.86375082004815,2
+"21",21,"9/7","3/5 11:39","11-08","11-08-2024","08-11-2024","2024-08-11",35,16.9377130432986,0.528439427725971,2
+"22",22,"9/11","3/6 9:16","16-08","16-08-2024","08-16-2024","2024-08-16",40,27.3956466908567,3.95220134640113,2
+"23",23,"9/23","3/9 6:13","31-08","31-08-2024","08-31-2024","2024-08-31",30,27.0562316849828,4.77845379849896,2
+"24",24,"9/28","3/10 16:43","10-09","10-09-2024","09-10-2024","2024-09-10",12,8.22499864501879,5.6025326368399,2
+"25",25,"10/4","3/21 10:23","12-09","12-09-2024","09-12-2024","2024-09-12",31,9.64448269223794,6.98261594865471,2
+"26",26,"10/14","3/23 14:07","19-09","19-09-2024","09-19-2024","2024-09-19",30,29.5692265313119,9.15683538420126,2
+"27",27,"10/26","3/28 18:31","25-10","25-10-2024","10-25-2024","2024-10-25",64,18.5997993056662,6.18351227371022,3
+"28",28,"10/26","3/29 8:43","01-11","01-11-2024","11-01-2024","2024-11-01",99,28.1194226746447,4.28421508753672,3
+"29",29,"10/26","4/10 3:27","04-11","04-11-2024","11-04-2024","2024-11-04",14,13.9959810697474,5.4208036721684,3
+"30",30,"10/26","4/11 23:21","23-11","23-11-2024","11-23-2024","2024-11-23",93,12.20497779781,0.58478488586843,3
+"31",31,"10/26","4/23 20:30","25-11","25-11-2024","11-25-2024","2024-11-25",96,19.7769097262062,2.60856857057661,3
+"32",32,"10/28","4/29 16:24","27-11","27-11-2024","11-27-2024","2024-11-27",71,4.57039850531146,3.97151953307912,3
+"33",33,"11/5","5/4 4:16","28-11","28-11-2024","11-28-2024","2024-11-28",67,17.1860117465258,1.97744736680761,3
+"34",34,"11/11","5/11 15:15","13-12","13-12-2024","12-13-2024","2024-12-13",23,7.161780805327,8.3192756283097,3
+"35",35,"11/17","5/21 17:34","15-12","15-12-2024","12-15-2024","2024-12-15",79,28.8707680930384,1.52887222822756,3
+"36",36,"11/30","6/4 1:36","20-12","20-12-2024","12-20-2024","2024-12-20",85,18.0409717792645,8.03418542025611,3
+"37",37,"12/16","6/10 8:59","30-12","30-12-2024","12-30-2024","2024-12-30",37,15.4508918174542,5.46826156554744,3
diff --git a/tests/testthat/datasets/timeWeightedCharts/cumsumChartLong.csv b/tests/testthat/datasets/timeWeightedCharts/cumsumChartLong.csv
new file mode 100644
index 00000000..9786d037
--- /dev/null
+++ b/tests/testthat/datasets/timeWeightedCharts/cumsumChartLong.csv
@@ -0,0 +1,126 @@
+Measurement,Date,Stage
+-0.44025,Sep/28,1
+5.90038,Sep/28,1
+2.08965,Sep/28,1
+0.09998,Sep/28,1
+2.01594,Sep/28,1
+4.83012,Sep/29,1
+3.78732,Sep/29,1
+4.99821,Sep/29,1
+6.91169,Sep/29,1
+1.93847,Sep/29,1
+-3.09907,Sep/30,1
+-3.18827,Sep/30,1
+5.28978,Sep/30,1
+0.56182,Sep/30,1
+-3.1896,Sep/30,1
+7.93177,10/Apr,1
+3.72692,10/Apr,1
+3.83152,10/Apr,1
+-2.17454,10/Apr,1
+2.81598,10/Apr,1
+4.52023,10/May,1
+3.95372,10/May,1
+7.99326,10/May,1
+4.98677,10/May,1
+-2.03427,10/May,1
+3.89134,10/Jun,1
+1.99825,10/Jun,1
+0.01028,10/Jun,1
+-0.24542,10/Jun,1
+2.08175,10/Jun,1
+-4.86937,10/Jul,1
+-2.69206,10/Jul,1
+-3.02947,10/Jul,1
+2.99932,10/Jul,1
+3.50123,10/Jul,1
+-1.99506,10/Aug,1
+-1.62939,10/Aug,1
+2.14395,10/Aug,1
+-1.90688,10/Aug,1
+8.02322,10/Aug,1
+4.75466,10/Nov,1
+1.1424,10/Nov,1
+0.9379,10/Nov,1
+-7.30286,10/Nov,1
+-5.22516,10/Nov,1
+-4.06527,10/Dec,1
+-1.91314,10/Dec,1
+2.0459,10/Dec,1
+4.93029,10/Dec,1
+0.03095,10/Dec,1
+-2.80363,Oct/13,2
+-3.12681,Oct/13,2
+-4.57793,Oct/13,2
+-3.17924,Oct/13,2
+-2.44537,Oct/13,2
+1.36225,Oct/14,2
+0.92825,Oct/14,2
+-0.24151,Oct/14,2
+-0.83762,Oct/14,2
+-1.99674,Oct/14,2
+4.90024,Oct/15,2
+1.28079,Oct/15,2
+2.87917,Oct/15,2
+1.83867,Oct/15,2
+-0.75614,Oct/15,2
+3.72977,Oct/18,2
+3.77141,Oct/18,2
+-4.04994,Oct/18,2
+3.89824,Oct/18,2
+1.76868,Oct/18,2
+2.2731,Oct/18,2
+-3.82297,Oct/18,2
+-2.26821,Oct/18,2
+-2.07973,Oct/18,2
+0.01739,Oct/18,2
+3.71309,Oct/19,2
+1.72573,Oct/19,2
+3.07264,Oct/19,2
+0.15676,Oct/19,2
+-0.05666,Oct/19,2
+3.81341,Oct/19,2
+-3.78952,Oct/19,2
+-3.81635,Oct/19,2
+-4.8882,Oct/19,2
+-3.24534,Oct/19,2
+-0.27272,Oct/20,3
+-4.33095,Oct/20,3
+-1.83547,Oct/20,3
+-3.98876,Oct/20,3
+-4.97431,Oct/20,3
+-5.1405,Oct/20,3
+-0.10379,Oct/20,3
+2.21033,Oct/20,3
+5.13041,Oct/20,3
+-1.89455,Oct/20,3
+0.95119,Oct/21,3
+-5.15414,Oct/21,3
+4.82794,Oct/21,3
+0.13001,Oct/21,3
+-0.09911,Oct/21,3
+-1.15453,Oct/21,3
+2.29868,Oct/21,3
+5.15847,Oct/21,3
+0.08558,Oct/21,3
+-3.09574,Oct/21,3
+5.16744,Oct/22,3
+0.29748,Oct/22,3
+-4.66858,Oct/22,3
+-2.13787,Oct/22,3
+-0.0045,Oct/22,3
+0.18096,Oct/22,3
+4.30247,Oct/22,3
+-2.21708,Oct/22,3
+7.17603,Oct/22,3
+5.86525,Oct/22,3
+0.95699,Oct/25,3
+-4.03441,Oct/25,3
+-2.05086,Oct/25,3
+-3.10319,Oct/25,3
+-1.83001,Oct/25,3
+5.03945,Oct/25,3
+1.96583,Oct/25,3
+-0.21026,Oct/25,3
+0.27517,Oct/25,3
+-5.32797,Oct/25,3
diff --git a/tests/testthat/datasets/timeWeightedCharts/cumsumChartWide.csv b/tests/testthat/datasets/timeWeightedCharts/cumsumChartWide.csv
new file mode 100644
index 00000000..93ac9a78
--- /dev/null
+++ b/tests/testthat/datasets/timeWeightedCharts/cumsumChartWide.csv
@@ -0,0 +1,20 @@
+"","Date","Stage","1","2","3","4","5","6","7","8","9","10"
+"1","Sep/28",1,-0.44025,5.90038,2.08965,0.09998,2.01594,NA,NA,NA,NA,NA
+"2","Sep/29",1,4.83012,3.78732,4.99821,6.91169,1.93847,NA,NA,NA,NA,NA
+"3","Sep/30",1,-3.09907,-3.18827,5.28978,0.56182,-3.1896,NA,NA,NA,NA,NA
+"4","10/Apr",1,7.93177,3.72692,3.83152,-2.17454,2.81598,NA,NA,NA,NA,NA
+"5","10/May",1,4.52023,3.95372,7.99326,4.98677,-2.03427,NA,NA,NA,NA,NA
+"6","10/Jun",1,3.89134,1.99825,0.01028,-0.24542,2.08175,NA,NA,NA,NA,NA
+"7","10/Jul",1,-4.86937,-2.69206,-3.02947,2.99932,3.50123,NA,NA,NA,NA,NA
+"8","10/Aug",1,-1.99506,-1.62939,2.14395,-1.90688,8.02322,NA,NA,NA,NA,NA
+"9","10/Nov",1,4.75466,1.1424,0.9379,-7.30286,-5.22516,NA,NA,NA,NA,NA
+"10","10/Dec",1,-4.06527,-1.91314,2.0459,4.93029,0.03095,NA,NA,NA,NA,NA
+"11","Oct/13",2,-2.80363,-3.12681,-4.57793,-3.17924,-2.44537,NA,NA,NA,NA,NA
+"12","Oct/14",2,1.36225,0.92825,-0.24151,-0.83762,-1.99674,NA,NA,NA,NA,NA
+"13","Oct/15",2,4.90024,1.28079,2.87917,1.83867,-0.75614,NA,NA,NA,NA,NA
+"14","Oct/18",2,3.72977,3.77141,-4.04994,3.89824,1.76868,2.2731,-3.82297,-2.26821,-2.07973,0.01739
+"15","Oct/19",2,3.71309,1.72573,3.07264,0.15676,-0.05666,3.81341,-3.78952,-3.81635,-4.8882,-3.24534
+"16","Oct/20",3,-0.27272,-4.33095,-1.83547,-3.98876,-4.97431,-5.1405,-0.10379,2.21033,5.13041,-1.89455
+"17","Oct/21",3,0.95119,-5.15414,4.82794,0.13001,-0.09911,-1.15453,2.29868,5.15847,0.08558,-3.09574
+"18","Oct/22",3,5.16744,0.29748,-4.66858,-2.13787,-0.0045,0.18096,4.30247,-2.21708,7.17603,5.86525
+"19","Oct/25",3,0.95699,-4.03441,-2.05086,-3.10319,-1.83001,5.03945,1.96583,-0.21026,0.27517,-5.32797
diff --git a/tests/testthat/datasets/timeWeightedCharts/ewmaChartLong.csv b/tests/testthat/datasets/timeWeightedCharts/ewmaChartLong.csv
new file mode 100644
index 00000000..b6d43776
--- /dev/null
+++ b/tests/testthat/datasets/timeWeightedCharts/ewmaChartLong.csv
@@ -0,0 +1,36 @@
+Subgroup,Measurement,Stage
+1,9.687765221,1
+2,9.376965607,1
+3,10.82535018,1
+4,9.636838422,1
+5,10.40493918,1
+6,9.210301838,1
+7,10.7450633,1
+8,10.35468689,2
+9,10.09609676,2
+10,9.625591714,2
+11,10.31463762,2
+12,10.40390853,2
+13,11.01761469,2
+14,9.852254111,2
+15,9.748415565,2
+16,10.71510003,2
+17,9.781192369,2
+18,10.04083362,2
+19,9.485813674,3
+20,8.715005153,3
+21,9.907705807,3
+22,8.306911464,3
+23,10.49958488,3
+24,9.616518597,3
+25,9.542703852,3
+26,14.10973827,3
+27,10.28420997,3
+28,12.48279229,3
+29,10.874,3
+30,12.73937432,3
+31,11.28508093,3
+32,10.86900005,3
+33,11.32264938,3
+34,10.865,3
+35,10.992612,3
diff --git a/tests/testthat/test-rareEventCharts.R b/tests/testthat/test-rareEventCharts.R
new file mode 100644
index 00000000..2c68513e
--- /dev/null
+++ b/tests/testthat/test-rareEventCharts.R
@@ -0,0 +1,314 @@
+context("[Quality Control] Rare Event Charts")
+.numDecimals <- 2
+
+# Date input ####
+
+## MD (g chart verified with Minitab, T chart differs because of zero handling) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "MD"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "md"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("1.1 Test of G chart with MD date format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart1")
+})
+
+test_that("1.2 Test of T chart with MD date format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart1")
+})
+
+## MDHM (t chart verified with Minitab, g chart not possible with this format in Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "MDHM"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateTime"
+options$dataTypeDatesFormatDate <- "md"
+options$dataTypeDatesFormatTime <- "HM"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("2.1 Test of G chart with MDHM date format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart2")
+})
+
+test_that("2.2 Test of T chart with MDHM date format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart2")
+})
+
+
+## DM (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "DM"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "dm"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("3.1 Test of G chart with DM date format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart3")
+})
+
+test_that("3.2 Test of T chart with DM date format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart3")
+})
+
+## DMY (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "DMY"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "dmy"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("4.1 Test of G chart with DMY date format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart4")
+})
+
+test_that("4.2 Test of T chart with DMY date format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart4")
+})
+
+## MDY (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "MDY"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "mdy"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("5.1 Test of G chart with MDY date format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart5")
+})
+
+test_that("5.2 Test of T chart with MDY date format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart5")
+})
+
+## YMD (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "YMD"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "ymd"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("6.1 Test of G chart with YMD date format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart6")
+})
+
+test_that("6.2 Test of T chart with YMD date format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart6")
+})
+
+# Time input ####
+
+## Decimal Hours (t chart verified with Minitab, g chart not possible with this format in Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "decimalTime"
+options$dataType <- "dataTypeInterval"
+options$dataTypeIntervalType <- "hours"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("7.1 Test of G chart with decimal hour format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart7")
+})
+
+test_that("7.2 Test of T chart with decimal hour format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart7")
+})
+
+## Decimal Days (t chart verified with Minitab, g chart not possible with this format in Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "decimalDays"
+options$dataType <- "dataTypeInterval"
+options$dataTypeIntervalType <- "days"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("8.1 Test of G chart with decimal day format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart8")
+})
+
+test_that("8.2 Test of T chart with decimal day format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart8")
+})
+
+# Opportunities input (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "opportunities"
+options$dataType <- "dataTypeInterval"
+options$dataTypeIntervalType <- "opportunities"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("9.1 Test of G chart with opportunities format", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart9")
+})
+
+test_that("9.2 Test of T chart with opportunities format", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart9")
+})
+
+# Stages ####
+
+## Date format (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "DM"
+options$stage <- "stages"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "dm"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("10.1 Test of G chart with DM format and stages", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart10")
+})
+
+test_that("10.2 Test of T chart with DM format and stages", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart10")
+})
+
+## Interval format (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "opportunities"
+options$stage <- "stages"
+options$dataType <- "dataTypeInterval"
+options$dataTypeIntervalType <- "opportunities"
+options$gChart <- TRUE
+options$tChart <- TRUE
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("11.1 Test of G chart with interval format and stages", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart11")
+})
+
+test_that("11.2 Test of G chart with interval format and stages", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ testthat::skip_on_os("mac")
+ jaspTools::expect_equal_plots(testPlot, "t-chart11")
+})
+
+# Historical options (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "DM"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "dm"
+options$gChart <- TRUE
+options$tChart <- TRUE
+options$gChartProportionSource <- "historical"
+options$gChartHistoricalProportion <- 0.5
+options$tChartDistributionParameterSource <- "historical"
+options$tChartHistoricalParametersScale <- 2
+options$tChartHistoricalParametersWeibullShape <- 2
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("12.1 Test of G chart with DM date format and historical parameters", {
+ plotName <- results[["results"]][["gChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "g-chart12")
+})
+
+test_that("12.2 Test of T chart with DM date format and historical parameters", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart12")
+})
+
+# Distribution options (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "DM"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "dm"
+options$gChart <- FALSE
+options$tChart <- TRUE
+options$tChartDistribution <- "exponential"
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("13 Test of T chart with DM date format and exponential distribution", {
+ plotName <- results[["results"]][["tChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "t-chart13")
+})
+
+# Report (verified with Minitab) ####
+options <- analysisOptions("rareEventCharts")
+options$variable <- "DM"
+options$dataType <- "dataTypeDates"
+options$dataTypeDatesStructure <- "dateOnly"
+options$dataTypeDatesFormatDate <- "dm"
+options$gChart <- TRUE
+options$tChart <- TRUE
+options$report <- TRUE
+options$reportMeasurementName <- TRUE
+options$reportMeasurementNameText <- "Test Name"
+results <- runAnalysis("rareEventCharts", "datasets/rareEventCharts/rareEventCharts.csv", options)
+
+test_that("14 Test of g and t chart report", {
+ plotName <- results[["results"]][["report"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "rare-event-charts-report1")
+})
diff --git a/tests/testthat/test-timeWeightedCharts.R b/tests/testthat/test-timeWeightedCharts.R
new file mode 100644
index 00000000..f66b04a1
--- /dev/null
+++ b/tests/testthat/test-timeWeightedCharts.R
@@ -0,0 +1,381 @@
+context("[Quality Control] Time Weighted Charts")
+.numDecimals <- 2
+
+# Long Format ####
+
+## Without Stages ####
+
+### CUSUM (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartLong.csv", options)
+
+test_that("LF1.1 Basic test of Cumulative sum chart", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chart_LF1")
+})
+
+### EWMA (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$cumulativeSumChart <- FALSE
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/ewmaChartLong.csv", options)
+
+test_that("LF1.2 Basic test of Exponentially weighted moving average chart", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chartLF1")
+})
+
+## With Stages ####
+
+### CUSUM (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$stagesLongFormat <- "Stage"
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartLong.csv", options)
+
+test_that("LF2.1 Basic test of Cumulative sum chart with stages", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chartLF2")
+})
+
+### EWMA (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "individual"
+options$stagesLongFormat <- "Stage"
+options$cumulativeSumChart <- FALSE
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/ewmaChartLong.csv", options)
+
+test_that("LF2.2 Basic test of Exponentially weighted moving average chart with stages", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chart")
+})
+
+## Subgrouping Mechanisms ####
+
+### Grouping Variable ####
+
+#### CUSUM (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "groupingVariable"
+options$subgroup <- "Date"
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartLong.csv", options)
+
+test_that("LF3.1 Test of Cumulative sum chart with subgroup variable", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chartLF3")
+})
+
+#### EWMA (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "groupingVariable"
+options$subgroup <- "Subgroup"
+options$cumulativeSumChart <- FALSE
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/ewmaChartLong.csv", options)
+
+test_that("LF3.2 Test of Exponentially weighted moving average chart with subgroup variable", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chartLF3")
+})
+
+### No Subgroups ####
+
+#### CUSUM (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "individual"
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartLong.csv", options)
+
+test_that("LF4.1 Test of Cumulative sum chart without subgroups", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chartLF4")
+})
+
+#### EWMA (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "individual"
+options$cumulativeSumChart <- FALSE
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/ewmaChartLong.csv", options)
+
+test_that("LF4.2 Test of Exponentially weighted moving average chart without subgroups", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chartLF4")
+})
+
+## Plotting Options ####
+
+### Historical values ####
+
+#### CUSUM (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "historical"
+options$cumulativeSumChartSdValue <- 3
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartLong.csv", options)
+
+test_that("LF5.1 Test of Cumulative sum chart with historical std. dev.", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chartLF5")
+})
+
+#### EWMA (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$cumulativeSumChart <- FALSE
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "historical"
+options$exponentiallyWeightedMovingAverageChartSdValue <- 3
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/ewmaChartLong.csv", options)
+
+test_that("LF5.2 Test of Exponentially weighted moving average chart with historical std. dev.", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chartLF5")
+})
+
+### Alternative SD Estimation ####
+
+#### CUSUM (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "r"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartLong.csv", options)
+
+test_that("LF6.1 Test of Cumulative sum chart with r-bar std. dev.", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chartLF6")
+})
+
+#### EWMA (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$cumulativeSumChart <- FALSE
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "r"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/ewmaChartLong.csv", options)
+
+test_that("LF6.2 Test of Exponentially weighted moving average chart with r-bar std. dev.", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chartLF6")
+})
+
+
+## Report ####
+
+### CUSUM (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "s"
+options$report <- TRUE
+options$reportMeasurementName <- TRUE
+options$reportMeasurementNameText <- "Test Name"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartLong.csv", options)
+
+test_that("LF7.1 Test of Cumulative sum chart report", {
+ plotName <- results[["results"]][["report"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "time-weighted-charts-reportLF7_1")
+})
+
+### EWMA (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$measurementLongFormat <- "Measurement"
+options$subgroupSizeType <- "manual"
+options$manualSubgroupSizeValue <- 5
+options$cumulativeSumChart <- FALSE
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "s"
+options$report <- TRUE
+options$reportMeasurementName <- TRUE
+options$reportMeasurementNameText <- "Test Name"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/ewmaChartLong.csv", options)
+
+test_that("LF7.2 Test of Exponentially weighted moving average chart report", {
+ plotName <- results[["results"]][["report"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "time-weighted-charts-report7_2")
+})
+
+# Wide Format ####
+
+## Without Stages (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "s"
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartWide.csv", options)
+
+test_that("WF1.1 Basic test of Cumulative sum chart", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chart_WF1")
+})
+
+test_that("WF1.2 Basic test of Exponentially weighted moving average chart", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chart_WF1")
+})
+
+## With Stages (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
+options$stagesWideFormat <- "Stage"
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "s"
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "s"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartWide.csv", options)
+
+test_that("WF2.1 Basic test of Cumulative sum chart with stages", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chart_WF2")
+})
+
+test_that("WF2.2 Basic test of Exponentially weighted moving average chart with stages", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chart_WF2")
+})
+
+## Plotting Options (verified with Minitab) ####
+
+### Historical values ####
+options <- analysisOptions("timeWeightedCharts")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "historical"
+options$cumulativeSumChartSdValue <- 3
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "historical"
+options$exponentiallyWeightedMovingAverageChartSdValue <- 3
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartWide.csv", options)
+
+test_that("WF3.1 Test of Cumulative sum chart with historical std. dev.", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chart_WF3")
+})
+
+test_that("WF3.2 Test of Exponentially weighted moving average chart with historical std. dev.", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chart_WF3")
+})
+
+### Alternative SD Estimation (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "r"
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "r"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartWide.csv", options)
+
+test_that("WF4.1 Test of Cumulative sum chart with r-bar std. dev.", {
+ plotName <- results[["results"]][["CusumChart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "cumulative-sum-chart_WF4")
+})
+
+test_that("WF4.2 Test of Exponentially weighted moving average chart with historical std. dev.", {
+ plotName <- results[["results"]][["EWMAPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "exponentially-weighted-moving-average-chart_WF4")
+})
+
+## Report (verified with Minitab) ####
+options <- analysisOptions("timeWeightedCharts")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
+options$cumulativeSumChart <- TRUE
+options$cumulativeSumChartSdSource <- "data"
+options$cumulativeSumChartSdMethod <- "s"
+options$exponentiallyWeightedMovingAverageChart <- TRUE
+options$exponentiallyWeightedMovingAverageChartSdSource <- "data"
+options$exponentiallyWeightedMovingAverageChartSdMethod <- "s"
+options$report <- TRUE
+options$reportMeasurementName <- TRUE
+options$reportMeasurementNameText <- "Test Name"
+results <- runAnalysis("timeWeightedCharts", "datasets/timeWeightedCharts/cumsumChartWide.csv", options)
+
+test_that("WF5 Test of Time weighted charts report", {
+ plotName <- results[["results"]][["report"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "time-weighted-charts-report_WF5")
+})