From a503651373117b938546548be21128b91fa84a32 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 19 Sep 2025 14:26:58 +0200 Subject: [PATCH 1/9] transformations options and help file --- inst/help/processCapabilityStudies.md | 17 ++++++++++++ inst/qml/processCapabilityStudies.qml | 38 +++++++++++++++++++++++++++ 2 files changed, 55 insertions(+) diff --git a/inst/help/processCapabilityStudies.md b/inst/help/processCapabilityStudies.md index 907bff23..61b0fc37 100644 --- a/inst/help/processCapabilityStudies.md +++ b/inst/help/processCapabilityStudies.md @@ -30,6 +30,21 @@ The size of the subgroups is relevant for the calculation of the process varianc - Calculate with actual size: the control limits are calculated per subgroup and the actual subgroup sizes are used for the calculation. ### Options + +#### Data transformation +- Transform data before any analysis. + - **None**: The data is analysed as-is + - **Exponential**: The data is transformed using the equation $y = (x+\text{shift})^\lambda$ if $\lambda \neq 0$, otherwise $y = \ln(x + \text{shift})$. Convenient values: $\lambda = 0$ - use the natural log of the data, $\lambda = 0.5$ - use the square root of your data. + - **Box-Cox**: The data is transformed using the equation $y = \frac{(x+\text{shift})^\lambda - 1}{\lambda}$ if $\lambda = 0$, otherwise $y = \ln(x + \text{shift})$. + - **Box-Cox (Log. Lik)**: The data is transformed using the Box-Cox transformation, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. + - **Box-Cox (Minitab)**: The data is transformed using a procedure emulating the "Box-Cox (optimal $\lambda$)" transform in Minitab: The $\lambda$ is automatically estimated by minimizing the within-subgroup unbiased pooled standard deviation of a power transformed variable. Note that the final transformation uses the equation described in the **Exponential** option (removing the -1 shift and scale $\lambda$). + - **Yeo-Johnson**: The data is transformed using the Yeo-Johnson transform as described in Yeo & Johnson (2000). It can be used for unbounded data. + - **Yeo-Johnson (Log. Lik)**: The data is transformed using the Yeo-Johnson transform, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. + - **Johnson**: The data is transformed using the Johnson transform. It can be used for unbounded data. The transform is fully automatic, as described in Chou, Polanski, & Mason (1998). + +- **Shift** numerical value of the shift parameter used for transforms that accept bounded data. This option is disabled for unbounded transforms (Yeo-Johnson, Johnson), and Box-Cox (Minitab) transform. +- **Lambda** numerical value of the $\lambda$ parameter of the transforms. This option is disabled for transforms which automatically estimate their parameter(s). + #### Type of data distribution - Type of data distribution: indicate whether the data approximates a normal distribution or another distribution (the most commonly used distributions are: Weibull, Lognormal, 3-parameter Weibull, and 3-parameter lognorma) - Specify a distribution: the non-normal distribution to be used. @@ -112,6 +127,8 @@ The size of the subgroups is relevant for the calculation of the process varianc 1. Automotive Industry Action Group, *Statistical Process Control - Reference Manual* (July 2005, 2nd Edition) 2. SKF Quality Techniques, Klerx, R., Dodson, B., and Dumont, D., QT 1 - *Process capability studies*. (PUB GQ/P9 10347/1 EN - December 2021) 3. SKF Quality Techniques, Dodson, B., Lynch, D., Weidenbacher, M., and Klerx, R. (), *QT 2 - Statistical process control*, (PUB GQS/P9 18343 EN - April 2019) +4. Yeo, I. K., & Johnson, R. A. (2000). A new family of power transformations to improve normality or symmetry. Biometrika, 87(4), 954-959. +5. Chou, Y. M., Polansky, A. M., & Mason, R. L. (1998). Transforming non-normal data to normality in statistical process control. Journal of Quality Technology, 30(2), 133-141. ## R Packages diff --git a/inst/qml/processCapabilityStudies.qml b/inst/qml/processCapabilityStudies.qml index eb4ef1e3..45c4e8bc 100644 --- a/inst/qml/processCapabilityStudies.qml +++ b/inst/qml/processCapabilityStudies.qml @@ -202,6 +202,44 @@ Form ColumnLayout { + Group + { + title: qsTr("Data transformation") + DropDown + { + name: "dataTransformation" + id: dataTransformation + title: qsTr("Type of transformation") + values: + [ + {label: qsTr("None"), value: "none"}, + {label: qsTr("Exponential"), value: "exponential"}, + {label: qsTr("Box-Cox"), value: "boxCox"}, + {label: qsTr("Box-Cox (Log Lik.)"), value: "boxCoxAuto"}, + {label: qsTr("Box-Cox (Minitab)"), value: "boxCoxMinitab"}, + {label: qsTr("Yeo-Johnson"), value: "yeoJohnson"}, + {label: qsTr("Yeo-Johnson (Log Lik.)"), value: "yeoJohnsonAuto"}, + {label: qsTr("Johnson"), value: "johnson"}, + ] + } + + DoubleField + { + label: qsTr("Shift") + name: "dataTransformationShift" + negativeValues: true + defaultValue: 0 + enabled: ["exponential", "boxCox", "boxCoxAuto"].includes(dataTransformation.value) + } + DoubleField + { + label: qsTr("Lambda") + name: "dataTransformationLambda" + negativeValues: true + defaultValue: 0 + enabled: ["exponential", "boxCox", "yeoJohnson"].includes(dataTransformation.value) + } + } Group { title: qsTr("Type of data distribution") From f54aba754e7d5e7179204cb345fe56d6cc61f6d1 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Tue, 23 Sep 2025 17:50:29 +0200 Subject: [PATCH 2/9] transform data in r --- R/commonQualityControl.R | 32 ++++++++++++++++++++++++++++++++ R/processCapabilityStudies.R | 4 ++++ 2 files changed, 36 insertions(+) diff --git a/R/commonQualityControl.R b/R/commonQualityControl.R index 62d9d257..f92c101a 100644 --- a/R/commonQualityControl.R +++ b/R/commonQualityControl.R @@ -87,6 +87,38 @@ xAxisTitle = xAxisTitle)) } +.transformData <- function(dataset, measurements, options) { + if (options[["dataTransformation"]] == "none") return(dataset) + # transforms need data in a long format... + dataset <- tidyr::pivot_longer(dataset, tidyr::all_of(measurements)) + + x <- dataset[["value"]] + group <- dataset[["name"]] + lambda <- 1 #options[["dataTransformationLambda"]] + shift <- 1 #options[["dataTransformationShift"]] + + dataset[["value"]] <- switch( + options[["dataTransformation"]], + exponential = x^lambda, + boxCox = jaspBase::BoxCox(x, lambda=lambda, shift=shift), + boxCoxAuto = jaspBase::BoxCoxAuto(x, shift=shift), + boxCoxMinitab = jaspBase::BoxCoxMinitab(x, group=group), + yeoJohnson = jaspBase::YeoJohnson(x, lambda=lambda), + yeoJohnsonAuto = jaspBase::YeoJohnsonAuto(x), + johnson = jaspBase::Johnson(x) + ) + + # some auto-transformations return meta-info about the applied transform + attr <- attributes(dataset[["value"]]) + + dataset <- tidyr::pivot_wider(dataset, values_from="value", names_from="name") + dataset <- as.data.frame(dataset) + + attributes(dataset) <- attr + + return(dataset) +} + .qcReport <- function(text = NULL, # a string or vector of strings, plots, # a list of ggplots. If the plots should stay on top of each other, use a nested list. tables = NULL, # a list of dataframes. If tables should be in the same plot, use a nested list. diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index a373c2fa..5605eec4 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -97,12 +97,16 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { } } + # Error Handling if (ready) { .hasErrors(dataset, type = c('infinity'), all.target = measurements, exitAnalysisIfErrors = TRUE) } + # Transform data as needed + if (ready) dataset <- .transformData(dataset, measurements, options) + # Plot note about R/S chart recommendation if (length(measurements) > 5 && options[["controlChartType"]] == "xBarR") # if the subgroup size is above 5, R chart is not recommended plotNotes <- paste0(plotNotes, gettext("Subgroup size is >5, results may be biased. An s-chart is recommended.")) From 3e38c920a29a72e365d0a2c6dc7a426e90a538a0 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Wed, 24 Sep 2025 16:44:42 +0200 Subject: [PATCH 3/9] fix transforming data --- R/commonQualityControl.R | 19 ++++++++++++------- R/processCapabilityStudies.R | 11 ++++++++++- inst/help/processCapabilityStudies.md | 6 +++--- inst/qml/processCapabilityStudies.qml | 4 ++-- 4 files changed, 27 insertions(+), 13 deletions(-) diff --git a/R/commonQualityControl.R b/R/commonQualityControl.R index f92c101a..6fc5cf73 100644 --- a/R/commonQualityControl.R +++ b/R/commonQualityControl.R @@ -88,14 +88,18 @@ } .transformData <- function(dataset, measurements, options) { - if (options[["dataTransformation"]] == "none") return(dataset) + if (options[["dataTransformation"]] == "none") return(list(dataset=dataset, parameters=NULL)) # transforms need data in a long format... + + # we need to append a unique id for each row in a wide format + # so that we can do pivot_longer -> pivot_wider + dataset[["id"]] <- seq_len(nrow(dataset)) dataset <- tidyr::pivot_longer(dataset, tidyr::all_of(measurements)) x <- dataset[["value"]] group <- dataset[["name"]] - lambda <- 1 #options[["dataTransformationLambda"]] - shift <- 1 #options[["dataTransformationShift"]] + lambda <- options[["dataTransformationLambda"]] + shift <- options[["dataTransformationShift"]] dataset[["value"]] <- switch( options[["dataTransformation"]], @@ -110,13 +114,14 @@ # some auto-transformations return meta-info about the applied transform attr <- attributes(dataset[["value"]]) + attributes(dataset[["value"]]) <- NULL - dataset <- tidyr::pivot_wider(dataset, values_from="value", names_from="name") + # reshape back to wider format and remove the id col + dataset <- tidyr::pivot_wider(dataset, values_from="value", names_from="name", id_cols="id") + dataset[["id"]] <- NULL dataset <- as.data.frame(dataset) - attributes(dataset) <- attr - - return(dataset) + return(list(dataset=dataset, parameters=attr)) } .qcReport <- function(text = NULL, # a string or vector of strings, diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index 5605eec4..3cb1b3f0 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -105,7 +105,11 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { } # Transform data as needed - if (ready) dataset <- .transformData(dataset, measurements, options) + if (ready) { + transformOutput <- .transformData(dataset, measurements, options) + dataset <- transformOutput[["dataset"]] + transformParameters <- transformOutput[["parameters"]] + } # Plot note about R/S chart recommendation if (length(measurements) > 5 && options[["controlChartType"]] == "xBarR") # if the subgroup size is above 5, R chart is not recommended @@ -122,6 +126,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { title = "Zero values found in non-normal capability study:", position = 1) jaspResults[["zeroWarning"]]$dependOn(c("measurementLongFormat", "measurementsWideFormat", "capabilityStudyType", + "dataTransformation", "dataTransformationLambda", "dataTransformationShift", "nullDistribution")) } } @@ -137,6 +142,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { jaspResults[["report"]] <- reportPlot jaspResults[["report"]]$dependOn(c("report", "measurementLongFormat", "measurementsWideFormat", "subgroups", "controlChartType", "stagesLongFormat", "stagesWideFormat", "subgroupSizeType","manualSubgroupSizeValue", + "dataTransformation", "dataTransformationLambda", "dataTransformationShift", "controlLimitsNumberOfSigmas", "groupingVariableMethod", "reportProcessStability", "reportProcessCapabilityPlot", "reportProbabilityPlot", "reportProcessCapabilityTables", "upperSpecificationLimit", "lowerSpecificationLimit", "subgroupSizeUnequal", "fixedSubgroupSizeValue", @@ -310,6 +316,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { # first chart is always xBar-chart, second is either R-, mR-, or s-chart jaspResults[["xBar"]] <- createJaspContainer(gettextf("X-bar & %s control chart", secondPlotTitle)) jaspResults[["xBar"]]$dependOn(c("measurementLongFormat", "measurementsWideFormat", "subgroups", "controlChartType", + "dataTransformation", "dataTransformationLambda", "dataTransformationShift", "report", "stagesLongFormat", "stagesWideFormat", "subgroupSizeType","manualSubgroupSizeValue", "subgroupSizeUnequal", "controlChartSdUnbiasingConstant", "controlChart", "controlLimitsNumberOfSigmas", "groupingVariableMethod", .getDependenciesControlChartRules())) @@ -352,6 +359,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { } else if (options[["controlChartType"]] == "xmr" && options[["controlChart"]]) { jaspResults[["xmr"]] <- createJaspContainer(gettext("X-mR control chart")) jaspResults[["xmr"]]$dependOn(c("measurementLongFormat", "measurementsWideFormat", "subgroups", "controlChartType", + "dataTransformation", "dataTransformationLambda", "dataTransformationShift", "report", "stagesLongFormat", "stagesWideFormat", "subgroupSizeType","manualSubgroupSizeValue", "subgroupSizeUnequal", "controlChart", "controlLimitsNumberOfSigmas", "groupingVariableMethod", .getDependenciesControlChartRules())) jaspResults[["xmr"]]$position <- 1 @@ -2316,6 +2324,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (!ready) { plot <- createJaspPlot(title = gettext("Histogram"), width = 600, height = 400) plot$dependOn(options = c("histogram", "histogramDensityLine", "measurementsWideFormat", "histogramBinNumber", + "dataTransformation", "dataTransformationLambda", "dataTransformationShift", "report", "measurementLongFormat", "manualSubgroupSizeValue", "subgroup", 'nullDistribution', "stagesLongFormat", "stagesWideFormat", "histogramBinBoundaryDirection", "subgroupSizeType", "manualSubgroupSizeValue", "groupingVariableMethod")) diff --git a/inst/help/processCapabilityStudies.md b/inst/help/processCapabilityStudies.md index 61b0fc37..cad98b57 100644 --- a/inst/help/processCapabilityStudies.md +++ b/inst/help/processCapabilityStudies.md @@ -36,11 +36,11 @@ The size of the subgroups is relevant for the calculation of the process varianc - **None**: The data is analysed as-is - **Exponential**: The data is transformed using the equation $y = (x+\text{shift})^\lambda$ if $\lambda \neq 0$, otherwise $y = \ln(x + \text{shift})$. Convenient values: $\lambda = 0$ - use the natural log of the data, $\lambda = 0.5$ - use the square root of your data. - **Box-Cox**: The data is transformed using the equation $y = \frac{(x+\text{shift})^\lambda - 1}{\lambda}$ if $\lambda = 0$, otherwise $y = \ln(x + \text{shift})$. - - **Box-Cox (Log. Lik)**: The data is transformed using the Box-Cox transformation, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. + - **Box-Cox (Log. Lik)**: Only for total (overall) process capability. The data is transformed using the Box-Cox transformation, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. - **Box-Cox (Minitab)**: The data is transformed using a procedure emulating the "Box-Cox (optimal $\lambda$)" transform in Minitab: The $\lambda$ is automatically estimated by minimizing the within-subgroup unbiased pooled standard deviation of a power transformed variable. Note that the final transformation uses the equation described in the **Exponential** option (removing the -1 shift and scale $\lambda$). - **Yeo-Johnson**: The data is transformed using the Yeo-Johnson transform as described in Yeo & Johnson (2000). It can be used for unbounded data. - - **Yeo-Johnson (Log. Lik)**: The data is transformed using the Yeo-Johnson transform, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. - - **Johnson**: The data is transformed using the Johnson transform. It can be used for unbounded data. The transform is fully automatic, as described in Chou, Polanski, & Mason (1998). + - **Yeo-Johnson (Log. Lik)**: Only for total (overall) process capability. The data is transformed using the Yeo-Johnson transform, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. + - **Johnson**: Only for total (overall) process capability. The data is transformed using the Johnson transform. It can be used for unbounded data. The transform is fully automatic, as described in Chou, Polanski, & Mason (1998). - **Shift** numerical value of the shift parameter used for transforms that accept bounded data. This option is disabled for unbounded transforms (Yeo-Johnson, Johnson), and Box-Cox (Minitab) transform. - **Lambda** numerical value of the $\lambda$ parameter of the transforms. This option is disabled for transforms which automatically estimate their parameter(s). diff --git a/inst/qml/processCapabilityStudies.qml b/inst/qml/processCapabilityStudies.qml index 45c4e8bc..e181d78e 100644 --- a/inst/qml/processCapabilityStudies.qml +++ b/inst/qml/processCapabilityStudies.qml @@ -204,12 +204,12 @@ Form { Group { - title: qsTr("Data transformation") + title: qsTr("Transform data") DropDown { name: "dataTransformation" id: dataTransformation - title: qsTr("Type of transformation") + label: qsTr("Type") values: [ {label: qsTr("None"), value: "none"}, From 2e51c467defed6027247518709e9e48f091c5675 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 21 Nov 2025 17:23:49 +0100 Subject: [PATCH 4/9] implement transforms (basic functionality) --- R/commonQualityControl.R | 37 ---- R/processCapabilityStudies.R | 266 +++++++++++++++++++++++++- inst/help/processCapabilityStudies.md | 14 +- inst/qml/processCapabilityStudies.qml | 30 ++- 4 files changed, 294 insertions(+), 53 deletions(-) diff --git a/R/commonQualityControl.R b/R/commonQualityControl.R index 6fc5cf73..62d9d257 100644 --- a/R/commonQualityControl.R +++ b/R/commonQualityControl.R @@ -87,43 +87,6 @@ xAxisTitle = xAxisTitle)) } -.transformData <- function(dataset, measurements, options) { - if (options[["dataTransformation"]] == "none") return(list(dataset=dataset, parameters=NULL)) - # transforms need data in a long format... - - # we need to append a unique id for each row in a wide format - # so that we can do pivot_longer -> pivot_wider - dataset[["id"]] <- seq_len(nrow(dataset)) - dataset <- tidyr::pivot_longer(dataset, tidyr::all_of(measurements)) - - x <- dataset[["value"]] - group <- dataset[["name"]] - lambda <- options[["dataTransformationLambda"]] - shift <- options[["dataTransformationShift"]] - - dataset[["value"]] <- switch( - options[["dataTransformation"]], - exponential = x^lambda, - boxCox = jaspBase::BoxCox(x, lambda=lambda, shift=shift), - boxCoxAuto = jaspBase::BoxCoxAuto(x, shift=shift), - boxCoxMinitab = jaspBase::BoxCoxMinitab(x, group=group), - yeoJohnson = jaspBase::YeoJohnson(x, lambda=lambda), - yeoJohnsonAuto = jaspBase::YeoJohnsonAuto(x), - johnson = jaspBase::Johnson(x) - ) - - # some auto-transformations return meta-info about the applied transform - attr <- attributes(dataset[["value"]]) - attributes(dataset[["value"]]) <- NULL - - # reshape back to wider format and remove the id col - dataset <- tidyr::pivot_wider(dataset, values_from="value", names_from="name", id_cols="id") - dataset[["id"]] <- NULL - dataset <- as.data.frame(dataset) - - return(list(dataset=dataset, parameters=attr)) -} - .qcReport <- function(text = NULL, # a string or vector of strings, plots, # a list of ggplots. If the plots should stay on top of each other, use a nested list. tables = NULL, # a list of dataframes. If tables should be in the same plot, use a nested list. diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index 3cb1b3f0..63feff7d 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -106,9 +106,9 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { # Transform data as needed if (ready) { - transformOutput <- .transformData(dataset, measurements, options) - dataset <- transformOutput[["dataset"]] - transformParameters <- transformOutput[["parameters"]] + results <- .qcDataTransformations(jaspResults, dataset, measurements, options) + dataset <- results[["dataset"]] + options <- results[["options"]] } # Plot note about R/S chart recommendation @@ -482,6 +482,64 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { ## Output #### +.qcDataTransformations <- function(jaspResults, dataset, measurements, options) { + # this function transforms `dataset`, lower and upper specification limits, and target (in the options list) + # transformed `dataset` and `options` are returned in a list + # as a side product, this function generates output that shows to the user how was the data transformed + + # if no transform, don't show anything and return unchanged inputs + if (options[["dataTransformation"]] == "none") return(list(dataset=dataset, options=options)) + + # create the main output (fill later) + transformsContainer <- jaspResults[["transformsContainer"]] %setOrRetrieve% + createJaspContainer( + title = gettext("Data transformation"), + dependencies = c("dataFormat", + "measurementLongFormat", "subgroup","stagesLongFormat", + "measurementsWideFormat", "stagesWideFormat", + "subgroupSizeType", "groupingVariable", "groupingVariableMethod", + "subgroupSizeUnequal", "fixedSubgroupSizeValue", + "dataTransformation", "dataTransformationShift", "dataTransformationLambda", + "dataTransformationMethod", + "dataTransformationLambdaLower", "dataTransformationLambdaUpper", + "dataTransformationContinuityAdjustment"), + position=0 + ) + + # return state if available + state <- transformsContainer[["state"]] %setOrRetrieve% createJaspState() + if (!isRecomputed(transformsContainer)) return(state$object) + + # transform data and return parameters of the transform + result <- try(.qcTransformData(dataset = dataset, measurements = measurements, options = options)) + + if(isTryError(result)) { + message <- gettextf("Data could not be transformed: %1$s", .extractErrorMessage(result)) + .quitAnalysis(message) + } + + # retrieve data and parameters + dataset <- result[["dataset"]] + parameters <- result[["parameters"]] + + + # transform lower and upper spec limits, target + options <- try(.qcTransformOptions(options = options, parameters = parameters), silent=TRUE) + + if(isTryError(options)) { + message <- gettextf("Data could not be transformed: %1$s", .extractErrorMessage(options)) + .quitAnalysis(message) + } + + .qcFillTransformOutput(transformsContainer, options=options, parameters=parameters) + + output <- list(dataset=dataset, options=options) + + state$object <- output + + return(output) +} + .qcProcessSummaryTable <- function(options, dataset, ready, container, measurements, stages, returnDataframe = FALSE) { if (identical(stages, "")) { nStages <- 1 @@ -2454,3 +2512,205 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { return(output) } + + +# helper functions for transforms ---- + +.qcTransformData <- function(dataset, measurements, options) { + # we need to append a unique id for each row in a wide format + # so that we can do pivot_longer -> pivot_wider + + # save any possible columns that might be next to grouping and measurements + extra <- dplyr::select(dataset, -tidyr::all_of(measurements)) + + # then add a column which IDs the measurements + dataset[["id"]] <- seq_len(nrow(dataset)) + + # and finally convert to long + dataset <- tidyr::pivot_longer(dataset, tidyr::all_of(measurements)) + + x <- dataset[["value"]] + group <- dataset[["name"]] + lambda <- options[["dataTransformationLambda"]] + shift <- options[["dataTransformationShift"]] + method <- options[["dataTransformationMethod"]] + + dataset[["value"]] <- switch( + options[["dataTransformation"]], + boxCox = jaspBase::BoxCox(x, lambda=lambda, shift=shift), + boxCoxAuto = jaspBase::BoxCoxAuto(x, shift=shift, method = method), + yeoJohnson = jaspBase::YeoJohnson(x, lambda=lambda), + yeoJohnsonAuto = jaspBase::YeoJohnsonAuto(x), + johnson = jaspBase::Johnson(x) + ) + + # some auto-transformations return meta-info about the applied transform + attr <- attributes(dataset[["value"]]) + attributes(dataset[["value"]]) <- NULL + + # reshape back to wider format and remove the id col + dataset <- tidyr::pivot_wider(dataset, values_from="value", names_from="name", id_cols="id") + dataset[["id"]] <- NULL + dataset <- as.data.frame(dataset) + # return extra columns + dataset <- cbind(dataset, extra) + + return(list(dataset=dataset, parameters=attr)) +} + + +.qcTransformOptions <- function(options, parameters) { + # returns modified options list with + # lower and upper specification limits + target value transformed + limits <- list() + + if(options[["lowerSpecificationLimit"]]) limits <- c(limits, options["lowerSpecificationLimitValue"]) + if(options[["upperSpecificationLimit"]]) limits <- c(limits, options["upperSpecificationLimitValue"]) + if(options[["target"]]) limits <- c(limits, options["targetValue"]) + + limits <- unlist(limits) + + + if (options[["dataTransformation"]] %in% c("boxCox", "boxCoxAuto")) { + shift <- options[["dataTransformationShift"]] + lambda <- if(options[["dataTransformation"]] == "boxCox") options[["dataTransformationLambda"]] else parameters[["lambda"]] + if (any(limits + shift <= 0)) + stop(gettextf("Some specification limits or target value are outside of the support of the Box-Cox transform. The lower bound of the Box-Cox transform is -shift (%1$f).", -shift)) + + limits <- BoxCox(limits, lambda=lambda, shift=shift, continuityAdjustment = options[["dataTransformationContinuityAdjustment"]]) + } else if(options[["dataTransformation"]] %in% c("yeoJohnson", "yeoJohnsonAuto")) { + lambda <- if(options[["dataTransformation"]] == "boxCox") options[["dataTransformationLambda"]] else parameters[["lambda"]] + limits <- YeoJohnson(limits, lambda=lambda) + } else if (options[["dataTransformation"]] == "johnson") { + args <- parameters[["params"]] + args[["x"]] <- limits + + # check for errors (invalid bounds) + # there might be some corrections for these cases but I could not find proper references except for documentation of other software. + # so for now we will just throw an error... + if (parameters[["type"]] == "sb") { # bounded between epsilon and epsilon+lambda + min <- args[["epsilon"]] + max <- args[["epsilon"]] + args[["lambda"]] + + if (any(limits <= min) || any(limits >= max)) + stop(gettextf("Some specification limits or target value are outside of the support of the Johnson (SB) transform. The bounds of the transform were identified to between %1$f and %2$f.", min, max)) + } else if(parameters[["type"]] == "sl") { # bounded from below by epsilon + min <- args[["epsilon"]] + + if (any(limits <= min)) + stop(gettextf("Some specification limits or target value are outside of the support of the Johnson (SL) transform. The lower bound of the transform was identified as %1$f.", min)) + } + + #TODO: export these functions from jaspBase + limits <- switch( + parameters[["type"]], + sb = with(data=args, gamma + eta * log((x - epsilon) / (lambda + epsilon - x))), + sl = with(data=args, gamma + eta * log(x - epsilon)), + su = with(data=args, gamma + eta * asinh((x - epsilon) / lambda)) + ) + } + + # overwrite the old specs with transformed specs + options <- modifyList(options, as.list(limits)) + return(options) +} + +.qcFillTransformOutput <- function(container, options, parameters) { + container[["formula"]] <- .qcTransformFormula(options, parameters) + container[["table"]] <- .qcTransformTable(options, parameters) +} + +.qcTransformFormula <- function(options, parameters) { + if (options[["dataTransformation"]] %in% c("boxCox", "boxCoxAuto")) { + name <- "Box-Cox" + shift <- options[["dataTransformationShift"]] + lambda <- if(options[["dataTransformation"]] == "boxCox") options[["dataTransformationLambda"]] else parameters[["lambda"]] + + if (shift == 0) { + if (lambda == 0) { + formula <- r"(\ln(x))" + } else if (!options[["dataTransformationContinuityAdjustment"]]) { + formula <- r"(x^\lambda)" + } else { + formula <- r"(\frac{x^\lambda - 1}{\lambda})" + } + } else { + if (lambda == 0) { + formula <- r"(\ln(x + \text{shift}))" + } else if (!options[["dataTransformationContinuityAdjustment"]]) { + formula <- r"((x+\text{shift})^\lambda)" + } else { + formula <- r"(\frac{(x+\text{shift})^\lambda - 1}{\lambda})" + } + } + + } else if (options[["dataTransformation"]] %in% c("yeoJohnson", "yeoJohnsonAuto")) { + name <- "Yeo-Johnson" + + formula <- + r"( + y_i^{(\lambda)} = + \begin{cases} + ((x+1)^\lambda-1)/\lambda & \text{if }\lambda \neq 0, x \geq 0 \\ + \ln(x + 1) & \text{if }\lambda = 0, x \geq 0 \\ + -((-x + 1)^{(2-\lambda)} - 1) / (2 - \lambda) & \text{if }\lambda \neq 2, x < 0 \\ + -\ln(-x + 1) & \text{if }\lambda = 2, x < 0 + \end{cases} + )" + + } else if (options[["dataTransformation"]] == "johnson") { + formula <- switch( + parameters[["type"]], + "sb" = r"(\gamma + \eta \ln \frac{x-\epsilon}{\lambda + \epsilon - x})", + "sl" = r"(\gamma + \eta \ln (x-\epsilon))", + "su" = r"(\gamma + \eta \sinh^{-1} \frac{x-\epsilon}{\lambda})" + ) + name <- switch( + parameters[["type"]], + "sb" = "Johnson (SB)", + "sl" = "Johnson (SL)", + "su" = "Johnson (SU)" + ) + } + + formula <- mathExpression(formula, inline=FALSE) + + intro <- gettextf("The measrements, specification limits and target value were transformed using the %s transformation, with the following formula,", name) + + html <- createJaspHtml(title="", text = paste(intro, formula, sep="
")) + + return(html) +} + + +.qcTransformTable <- function(options, parameters) { + table <- createJaspTable(title = gettext("Parameters of the transform")) + table$addColumnInfo(name = "par", title = gettext("Parameter"), type = "string") + table$addColumnInfo(name = "value", title = gettext("Value"), type = "number" ) + + if (options[["dataTransformation"]] %in% c("boxCox", "boxCoxAuto") && options[["dataTransformationShift"]]!=0) + table$addRows(list(par="shift", value=options[["dataTransformationShift"]])) + + + if (options[["dataTransformation"]] %in% c("boxCox", "yeoJohnson")) { + table$addRows(list(par=mathExpression("\\lambda"), value=options[["dataTransformationLambda"]])) + + } else if (options[["dataTransformation"]] %in% c("boxCoxAuto", "yeoJohnson")) { + table$addRows(list(par=mathExpression("\\lambda"), value=parameters[["lambda"]]), rowNames = "lambda") + table$addFootnote(gettext("Estimated from data"), rowNames = "lambda", colNames = "value") + + } else if (options[["dataTransformation"]] == "johnson") { + if (parameters[["type"]] %in% c("sb", "su")) { + pars <- mathExpression(c("\\eta", "\\gamma", "\\lambda", "\\epsilon")) + vals <- c(parameters[["params"]][c("eta", "gamma", "lambda", "epsilon")]) + } else if (parameters[["type"]] == "sl") { + pars <- mathExpression(c("\\eta", "\\gamma", "\\epsilon")) + vals <- c(parameters[["params"]][c("eta", "gamma", "epsilon")]) + } + + table$setData(list(par=pars, value=vals)) + + table$addFootnote(gettext("All values estimated from data"), colNames = "value") + } + return(table) +} diff --git a/inst/help/processCapabilityStudies.md b/inst/help/processCapabilityStudies.md index cad98b57..98a2e257 100644 --- a/inst/help/processCapabilityStudies.md +++ b/inst/help/processCapabilityStudies.md @@ -34,16 +34,16 @@ The size of the subgroups is relevant for the calculation of the process varianc #### Data transformation - Transform data before any analysis. - **None**: The data is analysed as-is - - **Exponential**: The data is transformed using the equation $y = (x+\text{shift})^\lambda$ if $\lambda \neq 0$, otherwise $y = \ln(x + \text{shift})$. Convenient values: $\lambda = 0$ - use the natural log of the data, $\lambda = 0.5$ - use the square root of your data. - - **Box-Cox**: The data is transformed using the equation $y = \frac{(x+\text{shift})^\lambda - 1}{\lambda}$ if $\lambda = 0$, otherwise $y = \ln(x + \text{shift})$. - - **Box-Cox (Log. Lik)**: Only for total (overall) process capability. The data is transformed using the Box-Cox transformation, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. - - **Box-Cox (Minitab)**: The data is transformed using a procedure emulating the "Box-Cox (optimal $\lambda$)" transform in Minitab: The $\lambda$ is automatically estimated by minimizing the within-subgroup unbiased pooled standard deviation of a power transformed variable. Note that the final transformation uses the equation described in the **Exponential** option (removing the -1 shift and scale $\lambda$). + - **Box-Cox**: The data is transformed using the equation $y = (x+\text{shift})^\lambda$ if $\lambda \neq 0$, otherwise $y = \ln(x + \text{shift})$. + - **Box-Cox (auto)**: The data is transformed using the Box-Cox transformation, but with the $\lambda$ parameter automatically estimated using one of the methods specified (see 'Method'). - **Yeo-Johnson**: The data is transformed using the Yeo-Johnson transform as described in Yeo & Johnson (2000). It can be used for unbounded data. - - **Yeo-Johnson (Log. Lik)**: Only for total (overall) process capability. The data is transformed using the Yeo-Johnson transform, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. - - **Johnson**: Only for total (overall) process capability. The data is transformed using the Johnson transform. It can be used for unbounded data. The transform is fully automatic, as described in Chou, Polanski, & Mason (1998). + - **Yeo-Johnson (auto)**: The data is transformed using the Yeo-Johnson transform, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. This procedure allows only process performance results (no process capability). + - **Johnson**: The data is transformed using the Johnson transform. It can be used for unbounded data. The transform is fully automatic, as described in Chou, Polanski, & Mason (1998). This procedure allows only process performance results (no process capability). -- **Shift** numerical value of the shift parameter used for transforms that accept bounded data. This option is disabled for unbounded transforms (Yeo-Johnson, Johnson), and Box-Cox (Minitab) transform. +- **Shift** numerical value of the shift parameter used for transforms that accept bounded data. This option is disabled for unbounded transforms (Yeo-Johnson, Johnson) - **Lambda** numerical value of the $\lambda$ parameter of the transforms. This option is disabled for transforms which automatically estimate their parameter(s). +- **Method** method for selecting the best $\lambda$ value. 'Log-Lik' maximizes the normal-likelihood of the transformed variable. 'Sd' minimizes the sums of squares of the power-transformed variable. 'Average moving range' minimizes the estimate of variabiliy based on the average moving range of the power-transformed variable. 'Log-Lik' and 'Sd' are appropriate for grouped data, 'Average moving range' is appropriate for individual's data. +- **Continuity Adjustment** if enabled, the Box-Cox transform includes the adjustment term $y = \frac{(x+\text{shift})^\lambda-1}{\lambda}$. #### Type of data distribution - Type of data distribution: indicate whether the data approximates a normal distribution or another distribution (the most commonly used distributions are: Weibull, Lognormal, 3-parameter Weibull, and 3-parameter lognorma) diff --git a/inst/qml/processCapabilityStudies.qml b/inst/qml/processCapabilityStudies.qml index e181d78e..d82157f3 100644 --- a/inst/qml/processCapabilityStudies.qml +++ b/inst/qml/processCapabilityStudies.qml @@ -213,12 +213,10 @@ Form values: [ {label: qsTr("None"), value: "none"}, - {label: qsTr("Exponential"), value: "exponential"}, {label: qsTr("Box-Cox"), value: "boxCox"}, - {label: qsTr("Box-Cox (Log Lik.)"), value: "boxCoxAuto"}, - {label: qsTr("Box-Cox (Minitab)"), value: "boxCoxMinitab"}, + {label: qsTr("Box-Cox (auto)"), value: "boxCoxAuto"}, {label: qsTr("Yeo-Johnson"), value: "yeoJohnson"}, - {label: qsTr("Yeo-Johnson (Log Lik.)"), value: "yeoJohnsonAuto"}, + {label: qsTr("Yeo-Johnson (auto)"), value: "yeoJohnsonAuto"}, {label: qsTr("Johnson"), value: "johnson"}, ] } @@ -229,7 +227,7 @@ Form name: "dataTransformationShift" negativeValues: true defaultValue: 0 - enabled: ["exponential", "boxCox", "boxCoxAuto"].includes(dataTransformation.value) + enabled: ["boxCox", "boxCoxAuto"].includes(dataTransformation.value) } DoubleField { @@ -237,7 +235,27 @@ Form name: "dataTransformationLambda" negativeValues: true defaultValue: 0 - enabled: ["exponential", "boxCox", "yeoJohnson"].includes(dataTransformation.value) + enabled: ["boxCox", "yeoJohnson"].includes(dataTransformation.value) + } + DropDown + { + name: "dataTransformationMethod" + id: dataTransformation + label: qsTr("Type") + values: + [ + {label: qsTr("Log. Lik"), value: "loglik"}, + {label: qsTr("Sd"), value: "sd"}, + {label: qsTr("Average moving range)"), value: "movingRange"}, + ] + enabled: ["boxCoxAuto"].includes(dataTransformation.value) + } + CheckBox + { + label: qsTr("Continuity Adjustment") + name: "dataTransformationContinuityAdjustment" + checked: false + enabled: ["boxCox", "boxCoxAuto"].includes(dataTransformation.value) } } Group From a1f7b32854f291b1681b2ae70c584232cfe8cfbc Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 21 Nov 2025 17:53:05 +0100 Subject: [PATCH 5/9] streamline option dependencies --- R/processCapabilityStudies.R | 131 ++++++++++++++++++++--------------- 1 file changed, 76 insertions(+), 55 deletions(-) diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index 63feff7d..a9428964 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -126,7 +126,6 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { title = "Zero values found in non-normal capability study:", position = 1) jaspResults[["zeroWarning"]]$dependOn(c("measurementLongFormat", "measurementsWideFormat", "capabilityStudyType", - "dataTransformation", "dataTransformationLambda", "dataTransformationShift", "nullDistribution")) } } @@ -140,23 +139,17 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { plotHeight <- ceiling(nElements/2) * 500 reportPlot <- createJaspPlot(title = gettext("Process Capability Report"), width = 1250, height = plotHeight) jaspResults[["report"]] <- reportPlot - jaspResults[["report"]]$dependOn(c("report", "measurementLongFormat", "measurementsWideFormat", "subgroups", "controlChartType", - "stagesLongFormat", "stagesWideFormat", "subgroupSizeType","manualSubgroupSizeValue", - "dataTransformation", "dataTransformationLambda", "dataTransformationShift", - "controlLimitsNumberOfSigmas", "groupingVariableMethod", "reportProcessStability", - "reportProcessCapabilityPlot", "reportProbabilityPlot", "reportProcessCapabilityTables", - "upperSpecificationLimit", "lowerSpecificationLimit", "subgroupSizeUnequal", "fixedSubgroupSizeValue", - "capabilityStudyType", "nonNormalDistribution", "nonNormalMethod", "lowerSpecificationLimitValue", - "lowerSpecificationLimitBoundary", "target", "targetValue", "reportMetaData", - "upperSpecificationLimitValue", "upperSpecificationLimitBoundary", "processCapabilityPlotBinNumber", - "processCapabilityPlotDistributions", "processCapabilityPlotSpecificationLimits", "xBarMovingRangeLength", - "xmrChartMovingRangeLength", "xmrChartSpecificationLimits","probabilityPlotRankMethod", - "histogramBinBoundaryDirection", "nullDistribution", "controlChartSdEstimationMethodGroupSizeLargerThanOne", - "controlChartSdEstimationMethodGroupSizeEqualOne", "controlChartSdUnbiasingConstant", - "subgroup", "reportTitle", "reportTitleText", "reportLocation", "reportLocationText", - "reportLine", "reportLineText", "reportMachine", "reportMachineText", "reportVariable", - "reportVariableText", "reportProcess", "reportProcessText", "reportDate", "reportDateText", - "reportReportedBy", "reportReportedByText", "reportConclusion", "reportConclusionText", .getDependenciesControlChartRules())) + jaspResults[["report"]]$dependOn(c( + "subgroups", "controlChartType", "controlLimitsNumberOfSigmas", + "capabilityStudyType", "nonNormalDistribution", "nonNormalMethod", + "lowerSpecificationLimitBoundary", "upperSpecificationLimitBoundary", + "processCapabilityPlotBinNumber", "processCapabilityPlotDistributions", + "processCapabilityPlotSpecificationLimits", "xBarMovingRangeLength", + "xmrChartMovingRangeLength", "xmrChartSpecificationLimits", "probabilityPlotRankMethod", + "histogramBinBoundaryDirection", "nullDistribution", "controlChartSdEstimationMethodGroupSizeLargerThanOne", + "controlChartSdEstimationMethodGroupSizeEqualOne", "controlChartSdUnbiasingConstant", + .qcDataOptionNames(), .qcReportOptionNames(), .getDependenciesControlChartRules() + )) if((!options[["upperSpecificationLimit"]] && !options[["lowerSpecificationLimit"]]) && options[["reportProcessCapabilityTables"]]) { reportPlot$setError(gettext("No specification limits set.")) @@ -315,11 +308,11 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { "xBarMR" = "mR") # first chart is always xBar-chart, second is either R-, mR-, or s-chart jaspResults[["xBar"]] <- createJaspContainer(gettextf("X-bar & %s control chart", secondPlotTitle)) - jaspResults[["xBar"]]$dependOn(c("measurementLongFormat", "measurementsWideFormat", "subgroups", "controlChartType", - "dataTransformation", "dataTransformationLambda", "dataTransformationShift", - "report", "stagesLongFormat", "stagesWideFormat", "subgroupSizeType","manualSubgroupSizeValue", - "subgroupSizeUnequal", "controlChartSdUnbiasingConstant", "controlChart", - "controlLimitsNumberOfSigmas", "groupingVariableMethod", .getDependenciesControlChartRules())) + jaspResults[["xBar"]]$dependOn(c( + "subgroups", "controlChartType", "report", "controlChartSdUnbiasingConstant", + "controlChart", "controlLimitsNumberOfSigmas", + .qcDataOptionNames(), .getDependenciesControlChartRules() + )) jaspResults[["xBar"]]$position <- 1 @@ -358,10 +351,12 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { } } else if (options[["controlChartType"]] == "xmr" && options[["controlChart"]]) { jaspResults[["xmr"]] <- createJaspContainer(gettext("X-mR control chart")) - jaspResults[["xmr"]]$dependOn(c("measurementLongFormat", "measurementsWideFormat", "subgroups", "controlChartType", - "dataTransformation", "dataTransformationLambda", "dataTransformationShift", - "report", "stagesLongFormat", "stagesWideFormat", "subgroupSizeType","manualSubgroupSizeValue", - "subgroupSizeUnequal", "controlChart", "controlLimitsNumberOfSigmas", "groupingVariableMethod", .getDependenciesControlChartRules())) + jaspResults[["xmr"]]$dependOn(c( + "subgroups", "controlChartType", "report", "controlChart", + "controlLimitsNumberOfSigmas", + .qcDataOptionNames(), .getDependenciesControlChartRules() + )) + jaspResults[["xmr"]]$position <- 1 if (ready && is.null(jaspResults[["xmr"]][["plot"]])) { jaspResults[["xmr"]][["plot"]] <- createJaspPlot(title = gettext("X-mR control chart"), width = 1200, height = 500) @@ -414,13 +409,15 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { .qcCapabilityAnalysis <- function(options, dataset, ready, jaspResults, measurements, stages) { container <- createJaspContainer(gettext("Capability study")) - container$dependOn(options = c("CapabilityStudyType", "measurementsWideFormat", "subgroup", "lowerSpecificationLimitValue", - "upperSpecificationLimitValue", "targetValue", "measurementLongFormat", "manualSubgroupSizeValue", - "dataFormat", "processCapabilityPlot", "processCapabilityTable", "manualSubgroupSize", "report", - "stagesLongFormat", "stagesWideFormat","controlChartSdUnbiasingConstant", "lowerSpecificationLimitBoundary", - "upperSpecificationLimitBoundary", "controlChartSdEstimationMethodGroupSizeLargerThanOne", - "controlChartSdEstimationMethodGroupSizeEqualOne", "controlChartSdEstimationMethodMeanMovingRangeLength", - "groupingVariableMethod")) + container$dependOn(c( + "capabilityStudyType", "processCapabilityPlot", "processCapabilityTable", + "manualSubgroupSize", "report", "controlChartSdUnbiasingConstant", + "lowerSpecificationLimitBoundary", "upperSpecificationLimitBoundary", + "controlChartSdEstimationMethodGroupSizeLargerThanOne", "controlChartSdEstimationMethodGroupSizeEqualOne", + "controlChartSdEstimationMethodMeanMovingRangeLength", + .qcDataOptionNames() + )) + container$position <- 4 jaspResults[["capabilityAnalysis"]] <- container @@ -494,15 +491,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { transformsContainer <- jaspResults[["transformsContainer"]] %setOrRetrieve% createJaspContainer( title = gettext("Data transformation"), - dependencies = c("dataFormat", - "measurementLongFormat", "subgroup","stagesLongFormat", - "measurementsWideFormat", "stagesWideFormat", - "subgroupSizeType", "groupingVariable", "groupingVariableMethod", - "subgroupSizeUnequal", "fixedSubgroupSizeValue", - "dataTransformation", "dataTransformationShift", "dataTransformationLambda", - "dataTransformationMethod", - "dataTransformationLambdaLower", "dataTransformationLambdaUpper", - "dataTransformationContinuityAdjustment"), + dependencies = .getDataDependencies(), position=0 ) @@ -2020,9 +2009,11 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (!options[["probabilityPlot"]] || !is.null(jaspResults[["probabilityContainer"]])) return() container <- createJaspContainer(gettext("Probability table and plot")) - container$dependOn(options = c("measurementsWideFormat", "probabilityPlot", "probabilityPlotRankMethod", "nullDistribution", - "probabilityPlotGridLines", "measurementLongFormat","subgroup", "report", "stagesLongFormat", - "stagesWideFormat", "subgroupSizeType","manualSubgroupSizeValue", "groupingVariableMethod")) + container$dependOn(c( + "probabilityPlot", "probabilityPlotRankMethod", "nullDistribution", + "probabilityPlotGridLines", "report", + .qcDataOptionNames() + )) container$position <- 3 jaspResults[["probabilityContainer"]] <- container @@ -2381,11 +2372,11 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (!ready) { plot <- createJaspPlot(title = gettext("Histogram"), width = 600, height = 400) - plot$dependOn(options = c("histogram", "histogramDensityLine", "measurementsWideFormat", "histogramBinNumber", - "dataTransformation", "dataTransformationLambda", "dataTransformationShift", - "report", "measurementLongFormat", "manualSubgroupSizeValue", "subgroup", 'nullDistribution', - "stagesLongFormat", "stagesWideFormat", "histogramBinBoundaryDirection", "subgroupSizeType", - "manualSubgroupSizeValue", "groupingVariableMethod")) + plot$dependOn(c( + "histogram", "histogramDensityLine", "histogramBinNumber", + "report", "nullDistribution", "histogramBinBoundaryDirection", + .qcDataOptionNames() + )) jaspResults[["histogram"]] <- plot return() } @@ -2401,10 +2392,11 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { plotWidth <- nCol * 600 plotHeight <- nRow * 400 plot <- createJaspPlot(title = gettext("Histogram"), width = plotWidth, height = plotHeight) - plot$dependOn(options = c("histogram", "histogramDensityLine", "measurementsWideFormat", "histogramBinNumber", - "report", "measurementLongFormat", "manualSubgroupSizeValue", "subgroup", 'nullDistribution', - "stagesLongFormat", "stagesWideFormat", "histogramBinBoundaryDirection", "subgroupSizeType", - "manualSubgroupSizeValue", "groupingVariableMethod")) + plot$dependOn(c( + "histogram", "histogramDensityLine", "histogramBinNumber", + "report", "nullDistribution", "histogramBinBoundaryDirection", + .qcDataOptionNames() + )) plot$position <- 2 jaspResults[["histogram"]] <- plot @@ -2714,3 +2706,32 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { } return(table) } + +.qcDataOptionNames <- function() { + dependencies <- c("dataFormat", + "measurementLongFormat", "subgroup","stagesLongFormat", + "measurementsWideFormat", "stagesWideFormat", + "subgroupSizeType", "groupingVariable", "groupingVariableMethod", + "subgroupSizeUnequal", "fixedSubgroupSizeValue", "manualSubgroupSizeValue", + "dataTransformation", "dataTransformationShift", "dataTransformationLambda", + "dataTransformationMethod", + "dataTransformationLambdaLower", "dataTransformationLambdaUpper", + "dataTransformationContinuityAdjustment", + "lowerSpecificationLimit", "lowerSpecificationLimitValue", + "target", "targetValue", + "upperSpecificationLimit", "upperSpecificationLimitValue") + return(dependencies) +} + +.qcReportOptionNames <- function() { + dependencies <- c("report", "reportMetaData", "reportTitle", "reportTitleText", + "reportLocation", "reportLocationText", "reportLine", "reportLineText", + "reportMachine", "reportMachineText", "reportVariable", "reportVariableText", + "reportProcess", "reportProcessText", "reportDate", "reportDateText", + "reportReportedBy", "reportReportedByText", "reportConclusion", + "reportConclusionText", "reportProcessStability", "reportProcessCapabilityPlot", + "reportProbabilityPlot", "reportProcessCapabilityTables") + + return(dependencies) +} + From e37d22cb54d2fc77f037f534793fd8204bfff935 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 21 Nov 2025 18:59:13 +0100 Subject: [PATCH 6/9] fix little issues based on manual testing --- R/processCapabilityStudies.R | 72 +++++++++++++++++---------- inst/help/processCapabilityStudies.md | 4 +- inst/qml/processCapabilityStudies.qml | 5 +- 3 files changed, 49 insertions(+), 32 deletions(-) diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index a9428964..f1bfed4d 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -461,7 +461,9 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (options[["processCapabilityPlot"]]) .qcProcessCapabilityPlot(options, dataset, ready, normalContainer, measurements, stages, "normal") if (options[["processCapabilityTable"]]) { - .qcProcessCapabilityTableWithin(options, dataset, ready, normalContainer, measurements, stages) + if (.qcWithinProcessValid(options)) + .qcProcessCapabilityTableWithin(options, dataset, ready, normalContainer, measurements, stages) + .qcProcessCapabilityTableOverall(options, dataset, ready, normalContainer, measurements, stages) } } @@ -491,7 +493,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { transformsContainer <- jaspResults[["transformsContainer"]] %setOrRetrieve% createJaspContainer( title = gettext("Data transformation"), - dependencies = .getDataDependencies(), + dependencies = .qcDataOptionNames(), position=0 ) @@ -516,7 +518,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { options <- try(.qcTransformOptions(options = options, parameters = parameters), silent=TRUE) if(isTryError(options)) { - message <- gettextf("Data could not be transformed: %1$s", .extractErrorMessage(options)) + message <- gettextf("Specification limits could not be transformed: %1$s", .extractErrorMessage(options)) .quitAnalysis(message) } @@ -556,7 +558,8 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { table$addColumnInfo(name = "n", type = "integer", title = gettext("Sample size")) table$addColumnInfo(name = "mean", type = "number", title = gettext("Mean")) table$addColumnInfo(name = "sd", type = "number", title = gettext("Std. dev. (total)")) - table$addColumnInfo(name = "sdw", type = "number", title = gettext("Std. dev. (within)")) + if (.qcWithinProcessValid(options)) + table$addColumnInfo(name = "sdw", type = "number", title = gettext("Std. dev. (within)")) table$showSpecifiedColumnsOnly <- TRUE if (!ready) @@ -750,13 +753,18 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (options[["processCapabilityPlotDistributions"]]) { if (distribution == "normal") { p <- p + ggplot2::stat_function(fun = dnorm, args = list(mean = mean(allData), sd = sd(allData)), - mapping = ggplot2::aes(color = "sdoDist", linetype = "sdoDist")) + - ggplot2::stat_function(fun = dnorm, args = list(mean = mean(allData), sd = sdw), - mapping = ggplot2::aes(color = "sdwDist", linetype = "sdwDist")) - legendColors <- c(legendColors, "dodgerblue", "red") - legendLty <- c(legendLty, "solid", "solid") - legendLabels <- c(legendLabels, gettext("Normal dist.\n(std. dev. total)"), - gettext("Normal dist.\n(std. dev. within)")) + mapping = ggplot2::aes(color = "sdoDist", linetype = "sdoDist")) + legendColors <- c(legendColors, "dodgerblue") + legendLty <- c(legendLty, "solid") + legendLabels <- c(legendLabels, gettext("Normal dist.\n(std. dev. total)")) + + if (.qcWithinProcessValid(options)) { + p <- p + ggplot2::stat_function(fun = dnorm, args = list(mean = mean(allData), sd = sdw), + mapping = ggplot2::aes(color = "sdwDist", linetype = "sdwDist")) + legendColors <- c(legendColors, "red") + legendLty <- c(legendLty, "solid") + legendLabels <- c(legendLabels, gettext("Normal dist.\n(std. dev. within)")) + } } else if (distribution == "weibull") { distParameters <- .distributionParameters(data = allData, distribution = distribution) @@ -1315,7 +1323,8 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { expWithinColName <- paste0("expWithin", stage) table2$addColumnInfo(name = observedColName, type = "integer", title = "Observed", overtitle = colOvertitle) table2$addColumnInfo(name = expOverallColName, type = "integer", title = "Expected total", overtitle = colOvertitle) - table2$addColumnInfo(name = expWithinColName, type = "integer", title = "Expected within", overtitle = colOvertitle) + if (.qcWithinProcessValid(options)) + table2$addColumnInfo(name = expWithinColName, type = "integer", title = "Expected within", overtitle = colOvertitle) # Table columns for comparison if (i > 1) { @@ -2526,11 +2535,12 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { lambda <- options[["dataTransformationLambda"]] shift <- options[["dataTransformationShift"]] method <- options[["dataTransformationMethod"]] + ca <- options[["dataTransformationContinuityAdjustment"]] dataset[["value"]] <- switch( options[["dataTransformation"]], - boxCox = jaspBase::BoxCox(x, lambda=lambda, shift=shift), - boxCoxAuto = jaspBase::BoxCoxAuto(x, shift=shift, method = method), + boxCox = jaspBase::BoxCox(x, lambda=lambda, shift=shift, continuityAdjustment=ca), + boxCoxAuto = jaspBase::BoxCoxAuto(x, predictor=as.factor(group), shift=shift, method=method, continuityAdjustment=ca), yeoJohnson = jaspBase::YeoJohnson(x, lambda=lambda), yeoJohnsonAuto = jaspBase::YeoJohnsonAuto(x), johnson = jaspBase::Johnson(x) @@ -2562,6 +2572,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { limits <- unlist(limits) + if (length(limits) == 0L) return(options) if (options[["dataTransformation"]] %in% c("boxCox", "boxCoxAuto")) { shift <- options[["dataTransformationShift"]] @@ -2569,9 +2580,9 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (any(limits + shift <= 0)) stop(gettextf("Some specification limits or target value are outside of the support of the Box-Cox transform. The lower bound of the Box-Cox transform is -shift (%1$f).", -shift)) - limits <- BoxCox(limits, lambda=lambda, shift=shift, continuityAdjustment = options[["dataTransformationContinuityAdjustment"]]) + limits <- BoxCox(limits, lambda=lambda, shift=shift, continuityAdjustment=options[["dataTransformationContinuityAdjustment"]]) } else if(options[["dataTransformation"]] %in% c("yeoJohnson", "yeoJohnsonAuto")) { - lambda <- if(options[["dataTransformation"]] == "boxCox") options[["dataTransformationLambda"]] else parameters[["lambda"]] + lambda <- if(options[["dataTransformation"]] == "yeoJohnson") options[["dataTransformationLambda"]] else parameters[["lambda"]] limits <- YeoJohnson(limits, lambda=lambda) } else if (options[["dataTransformation"]] == "johnson") { args <- parameters[["params"]] @@ -2620,19 +2631,19 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (shift == 0) { if (lambda == 0) { - formula <- r"(\ln(x))" + formula <- r"(y = \ln(x))" } else if (!options[["dataTransformationContinuityAdjustment"]]) { - formula <- r"(x^\lambda)" + formula <- r"(y = x^\lambda)" } else { - formula <- r"(\frac{x^\lambda - 1}{\lambda})" + formula <- r"(y = \frac{x^\lambda - 1}{\lambda})" } } else { if (lambda == 0) { - formula <- r"(\ln(x + \text{shift}))" + formula <- r"(y = \ln(x + \text{shift}))" } else if (!options[["dataTransformationContinuityAdjustment"]]) { - formula <- r"((x+\text{shift})^\lambda)" + formula <- r"(y = (x+\text{shift})^\lambda)" } else { - formula <- r"(\frac{(x+\text{shift})^\lambda - 1}{\lambda})" + formula <- r"(y = \frac{(x+\text{shift})^\lambda - 1}{\lambda})" } } @@ -2641,7 +2652,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { formula <- r"( - y_i^{(\lambda)} = + y = \begin{cases} ((x+1)^\lambda-1)/\lambda & \text{if }\lambda \neq 0, x \geq 0 \\ \ln(x + 1) & \text{if }\lambda = 0, x \geq 0 \\ @@ -2653,9 +2664,9 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { } else if (options[["dataTransformation"]] == "johnson") { formula <- switch( parameters[["type"]], - "sb" = r"(\gamma + \eta \ln \frac{x-\epsilon}{\lambda + \epsilon - x})", - "sl" = r"(\gamma + \eta \ln (x-\epsilon))", - "su" = r"(\gamma + \eta \sinh^{-1} \frac{x-\epsilon}{\lambda})" + "sb" = r"(y = \gamma + \eta \ln \frac{x-\epsilon}{\lambda + \epsilon - x})", + "sl" = r"(y = \gamma + \eta \ln (x-\epsilon))", + "su" = r"(y = \gamma + \eta \sinh^{-1} \frac{x-\epsilon}{\lambda})" ) name <- switch( parameters[["type"]], @@ -2687,7 +2698,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (options[["dataTransformation"]] %in% c("boxCox", "yeoJohnson")) { table$addRows(list(par=mathExpression("\\lambda"), value=options[["dataTransformationLambda"]])) - } else if (options[["dataTransformation"]] %in% c("boxCoxAuto", "yeoJohnson")) { + } else if (options[["dataTransformation"]] %in% c("boxCoxAuto", "yeoJohnsonAuto")) { table$addRows(list(par=mathExpression("\\lambda"), value=parameters[["lambda"]]), rowNames = "lambda") table$addFootnote(gettext("Estimated from data"), rowNames = "lambda", colNames = "value") @@ -2735,3 +2746,10 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { return(dependencies) } +.qcWithinProcessValid <- function(options) { + # within process results make sense only for selected transforms: + # - none, + # - those that have only fixed parameters (Box-Cox and Yeo-Johnson with manually fixed params) + # - Box-Cox auto (normalizes within groups, not across groups) + return(options[["dataTransformation"]] %in% c("none", "boxCox", "boxCoxAuto", "yeoJohnson")) +} diff --git a/inst/help/processCapabilityStudies.md b/inst/help/processCapabilityStudies.md index 98a2e257..c622718b 100644 --- a/inst/help/processCapabilityStudies.md +++ b/inst/help/processCapabilityStudies.md @@ -38,11 +38,11 @@ The size of the subgroups is relevant for the calculation of the process varianc - **Box-Cox (auto)**: The data is transformed using the Box-Cox transformation, but with the $\lambda$ parameter automatically estimated using one of the methods specified (see 'Method'). - **Yeo-Johnson**: The data is transformed using the Yeo-Johnson transform as described in Yeo & Johnson (2000). It can be used for unbounded data. - **Yeo-Johnson (auto)**: The data is transformed using the Yeo-Johnson transform, but with the $\lambda$ parameter automatically estimated using the profile likelihood of a normal distribution. This procedure allows only process performance results (no process capability). - - **Johnson**: The data is transformed using the Johnson transform. It can be used for unbounded data. The transform is fully automatic, as described in Chou, Polanski, & Mason (1998). This procedure allows only process performance results (no process capability). + - **Johnson**: The data is transformed using the Johnson transform. It can be used for unbounded data (but some forms of the transform will impose restrictions on the specification limits). The transform is fully automatic, as described in Chou, Polanski, & Mason (1998). This procedure allows only process performance results (no process capability). - **Shift** numerical value of the shift parameter used for transforms that accept bounded data. This option is disabled for unbounded transforms (Yeo-Johnson, Johnson) - **Lambda** numerical value of the $\lambda$ parameter of the transforms. This option is disabled for transforms which automatically estimate their parameter(s). -- **Method** method for selecting the best $\lambda$ value. 'Log-Lik' maximizes the normal-likelihood of the transformed variable. 'Sd' minimizes the sums of squares of the power-transformed variable. 'Average moving range' minimizes the estimate of variabiliy based on the average moving range of the power-transformed variable. 'Log-Lik' and 'Sd' are appropriate for grouped data, 'Average moving range' is appropriate for individual's data. +- **Method** method for selecting the best $\lambda$ value. 'Log-Lik' maximizes the normal-likelihood of the transformed variable. 'SD' minimizes the sums of squares of the power-transformed variable. 'Average moving range' minimizes the estimate of variabiliy based on the average moving range of the power-transformed variable. 'Log-Lik' and 'Sd' are appropriate for grouped data, 'Average moving range' is appropriate for individual's data. - **Continuity Adjustment** if enabled, the Box-Cox transform includes the adjustment term $y = \frac{(x+\text{shift})^\lambda-1}{\lambda}$. #### Type of data distribution diff --git a/inst/qml/processCapabilityStudies.qml b/inst/qml/processCapabilityStudies.qml index d82157f3..2bdbe463 100644 --- a/inst/qml/processCapabilityStudies.qml +++ b/inst/qml/processCapabilityStudies.qml @@ -240,13 +240,12 @@ Form DropDown { name: "dataTransformationMethod" - id: dataTransformation label: qsTr("Type") values: [ {label: qsTr("Log. Lik"), value: "loglik"}, - {label: qsTr("Sd"), value: "sd"}, - {label: qsTr("Average moving range)"), value: "movingRange"}, + {label: qsTr("SD"), value: "sd"}, + {label: qsTr("Average moving range"), value: "movingRange"}, ] enabled: ["boxCoxAuto"].includes(dataTransformation.value) } From c19d082ce8bab496e1f1d12d57f7d07b527739af Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 21 Nov 2025 19:40:34 +0100 Subject: [PATCH 7/9] fix state issue --- R/processCapabilityStudies.R | 58 +++++++++++++++++------------------- 1 file changed, 28 insertions(+), 30 deletions(-) diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index f1bfed4d..91dfa6ee 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -108,7 +108,9 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (ready) { results <- .qcDataTransformations(jaspResults, dataset, measurements, options) dataset <- results[["dataset"]] - options <- results[["options"]] + # change specifications (limits + target value) + transformedSpecs <- results[["transformedSpecs"]] + options <- modifyList(options, transformedSpecs) } # Plot note about R/S chart recommendation @@ -487,10 +489,10 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { # as a side product, this function generates output that shows to the user how was the data transformed # if no transform, don't show anything and return unchanged inputs - if (options[["dataTransformation"]] == "none") return(list(dataset=dataset, options=options)) + if (options[["dataTransformation"]] == "none") return(list(dataset=dataset, transformedSpecs=list())) # create the main output (fill later) - transformsContainer <- jaspResults[["transformsContainer"]] %setOrRetrieve% + dataTransformationContainer <- jaspResults[["dataTransformationContainer"]] %setOrRetrieve% createJaspContainer( title = gettext("Data transformation"), dependencies = .qcDataOptionNames(), @@ -498,8 +500,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { ) # return state if available - state <- transformsContainer[["state"]] %setOrRetrieve% createJaspState() - if (!isRecomputed(transformsContainer)) return(state$object) + if(!is.null(jaspResults[["dataTransformationState"]])) return(jaspResults[["dataTransformationState"]]$object) # transform data and return parameters of the transform result <- try(.qcTransformData(dataset = dataset, measurements = measurements, options = options)) @@ -515,18 +516,18 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { # transform lower and upper spec limits, target - options <- try(.qcTransformOptions(options = options, parameters = parameters), silent=TRUE) + transformedSpecs <- try(.qcTransformSpecs(options = options, parameters = parameters), silent=TRUE) - if(isTryError(options)) { - message <- gettextf("Specification limits could not be transformed: %1$s", .extractErrorMessage(options)) + if(isTryError(transformedSpecs)) { + message <- gettextf("Specification limits could not be transformed: %1$s", .extractErrorMessage(transformedSpecs)) .quitAnalysis(message) } - .qcFillTransformOutput(transformsContainer, options=options, parameters=parameters) + .qcFillTransformOutput(dataTransformationContainer, options=options, parameters=parameters) - output <- list(dataset=dataset, options=options) + output <- list(dataset=dataset, transformedSpecs=transformedSpecs) - state$object <- output + jaspResults[["dataTransformationState"]] <- createJaspState(object = output, dependencies = .qcDataOptionNames()) return(output) } @@ -2561,32 +2562,31 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { } -.qcTransformOptions <- function(options, parameters) { - # returns modified options list with - # lower and upper specification limits + target value transformed - limits <- list() +.qcTransformSpecs <- function(options, parameters) { + # lower and upper specification specs + target value transformed + specs <- list() - if(options[["lowerSpecificationLimit"]]) limits <- c(limits, options["lowerSpecificationLimitValue"]) - if(options[["upperSpecificationLimit"]]) limits <- c(limits, options["upperSpecificationLimitValue"]) - if(options[["target"]]) limits <- c(limits, options["targetValue"]) + if(options[["lowerSpecificationLimit"]]) specs <- c(specs, options["lowerSpecificationLimitValue"]) + if(options[["upperSpecificationLimit"]]) specs <- c(specs, options["upperSpecificationLimitValue"]) + if(options[["target"]]) specs <- c(specs, options["targetValue"]) - limits <- unlist(limits) + specs <- unlist(specs) - if (length(limits) == 0L) return(options) + if (length(specs) == 0L) return(list()) if (options[["dataTransformation"]] %in% c("boxCox", "boxCoxAuto")) { shift <- options[["dataTransformationShift"]] lambda <- if(options[["dataTransformation"]] == "boxCox") options[["dataTransformationLambda"]] else parameters[["lambda"]] - if (any(limits + shift <= 0)) + if (any(specs + shift <= 0)) stop(gettextf("Some specification limits or target value are outside of the support of the Box-Cox transform. The lower bound of the Box-Cox transform is -shift (%1$f).", -shift)) - limits <- BoxCox(limits, lambda=lambda, shift=shift, continuityAdjustment=options[["dataTransformationContinuityAdjustment"]]) + specs <- BoxCox(specs, lambda=lambda, shift=shift, continuityAdjustment=options[["dataTransformationContinuityAdjustment"]]) } else if(options[["dataTransformation"]] %in% c("yeoJohnson", "yeoJohnsonAuto")) { lambda <- if(options[["dataTransformation"]] == "yeoJohnson") options[["dataTransformationLambda"]] else parameters[["lambda"]] - limits <- YeoJohnson(limits, lambda=lambda) + specs <- YeoJohnson(specs, lambda=lambda) } else if (options[["dataTransformation"]] == "johnson") { args <- parameters[["params"]] - args[["x"]] <- limits + args[["x"]] <- specs # check for errors (invalid bounds) # there might be some corrections for these cases but I could not find proper references except for documentation of other software. @@ -2595,17 +2595,17 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { min <- args[["epsilon"]] max <- args[["epsilon"]] + args[["lambda"]] - if (any(limits <= min) || any(limits >= max)) + if (any(specs <= min) || any(specs >= max)) stop(gettextf("Some specification limits or target value are outside of the support of the Johnson (SB) transform. The bounds of the transform were identified to between %1$f and %2$f.", min, max)) } else if(parameters[["type"]] == "sl") { # bounded from below by epsilon min <- args[["epsilon"]] - if (any(limits <= min)) + if (any(specs <= min)) stop(gettextf("Some specification limits or target value are outside of the support of the Johnson (SL) transform. The lower bound of the transform was identified as %1$f.", min)) } #TODO: export these functions from jaspBase - limits <- switch( + specs <- switch( parameters[["type"]], sb = with(data=args, gamma + eta * log((x - epsilon) / (lambda + epsilon - x))), sl = with(data=args, gamma + eta * log(x - epsilon)), @@ -2613,9 +2613,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { ) } - # overwrite the old specs with transformed specs - options <- modifyList(options, as.list(limits)) - return(options) + return(as.list(specs)) } .qcFillTransformOutput <- function(container, options, parameters) { From f10f3c2eae4c1c2fd36586b4e7b905b59b436720 Mon Sep 17 00:00:00 2001 From: Kucharssim Date: Fri, 21 Nov 2025 19:57:53 +0100 Subject: [PATCH 8/9] fix report --- R/processCapabilityStudies.R | 47 ++++++++++++++++++++++++++---------- 1 file changed, 34 insertions(+), 13 deletions(-) diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index 91dfa6ee..53dd9153 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -260,20 +260,36 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (options[["reportProcessCapabilityTables"]]) { if (options[["capabilityStudyType"]] == "normalCapabilityAnalysis") { processSummaryDF <- .qcProcessSummaryTable(options, dataset, ready, container, measurements, stages, returnDataframe = TRUE) - potentialWithinDF <- .qcProcessCapabilityTableWithin(options, dataset, ready, container, measurements, stages, returnDataframe = TRUE) overallCapDF <- .qcProcessCapabilityTableOverall(options, dataset, ready, container, measurements, stages, returnOverallCapDataframe = TRUE) performanceDF <- .qcProcessCapabilityTableOverall(options, dataset, ready, container, measurements, stages, returnPerformanceDataframe = TRUE) - if (identical(stages, "")) { - tables[[1]] <- list(potentialWithinDF, overallCapDF, performanceDF, processSummaryDF) - tableTitles <- list(list("Process capability (within)", "Process performance (total)", "Non-conformance statistics", "Process summary")) - tableSize <- 6 - } else { - tables[[1]] <- list(potentialWithinDF, overallCapDF) - tables[[2]] <- processSummaryDF - tables[[3]] <- performanceDF - tableTitles <- list(list("Process capability (within)", "Process performance (total)"), "Process summary", "Non-conformance statistics") - tableSize <- 5 + + if (.qcWithinProcessValid(options)) { + potentialWithinDF <- .qcProcessCapabilityTableWithin(options, dataset, ready, container, measurements, stages, returnDataframe = TRUE) + if (identical(stages, "")) { + tables[[1]] <- list(potentialWithinDF, overallCapDF, performanceDF, processSummaryDF) + tableTitles <- list(list("Process capability (within)", "Process performance (total)", "Non-conformance statistics", "Process summary")) + tableSize <- 6 + } else { + tables[[1]] <- list(potentialWithinDF, overallCapDF) + tables[[2]] <- processSummaryDF + tables[[3]] <- performanceDF + tableTitles <- list(list("Process capability (within)", "Process performance (total)"), "Process summary", "Non-conformance statistics") + tableSize <- 5 + } + } else { # leave out within tables + if (identical(stages, "")) { + tables[[1]] <- list(overallCapDF, performanceDF, processSummaryDF) + tableTitles <- list(list("Process performance (total)", "Non-conformance statistics", "Process summary")) + tableSize <- 6 + } else { + tables[[1]] <- list(overallCapDF) + tables[[2]] <- processSummaryDF + tables[[3]] <- performanceDF + tableTitles <- list(list("Process performance (total)"), "Process summary", "Non-conformance statistics") + tableSize <- 5 + } } + } else { processSummaryDF <- .qcProcessCapabilityTableNonNormal(options, dataset, ready, container, measurements, stages, returnSummaryDF = TRUE) overallCapDF <- .qcProcessCapabilityTableNonNormal(options, dataset, ready, container, measurements, stages, returnCapabilityDF = TRUE) @@ -620,9 +636,12 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { if (returnDataframe) { lslTitle <- if (options[["lowerSpecificationLimitBoundary"]]) gettext("LB") else gettext("LSL") uslTitle <- if (options[["upperSpecificationLimitBoundary"]]) gettext("UB") else gettext("USL") - sourceVector <- c(lslTitle, "Target", uslTitle, "N", "Mean", "SD (total)", "SD (within)") + sourceVector <- c(lslTitle, "Target", uslTitle, "N", "Mean", "SD (total)") if (nStages > 1) sourceVector <- c("Stage", sourceVector) + if (.qcWithinProcessValid(options)) { + sourceVector <- c(sourceVector, "SD (within)") + } tableNRows <- if (nStages > 1) nStages * 2 - 1 else 1 formattedTableDf <- data.frame(matrix(nrow = tableNRows, ncol = 0)) if (nStages > 1) { @@ -650,7 +669,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { formattedTableDf[["n"]] <- tableList[["n"]] formattedTableDf[["mean"]] <- round(tableList[["mean"]], nDecimals) formattedTableDf[["sd"]] <- round(tableList[["sd"]], nDecimals) - formattedTableDf[["sdw"]] <- round(tableList[["sdw"]], nDecimals) + if (.qcWithinProcessValid(options)) formattedTableDf[["sdw"]] <- round(tableList[["sdw"]], nDecimals) colnames(formattedTableDf) <- sourceVector return(formattedTableDf) } @@ -1456,6 +1475,8 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { tableDf2$`Expected Overall`[is.na(tableDf2$`Expected Overall`)] <- "*" # This looks better in the table and makes clearer that there is not an error tableDf2$`Expected Within`[is.na(tableDf2$`Expected Within`)] <- "*" tableDf2$Observed[is.na(tableDf2$Observed)] <- "*" + + if (!.qcWithinProcessValid(options)) tableDf2$`Expected Within` <- "*" return(tableDf2) } From 056b0b6ea426d0aa7fb4b5c127e2df4915b18bd7 Mon Sep 17 00:00:00 2001 From: Simon Kucharsky Date: Thu, 27 Nov 2025 13:40:50 +0100 Subject: [PATCH 9/9] Fix typo Co-authored-by: Julius Pfadt <38500953+juliuspfadt@users.noreply.github.com> --- R/processCapabilityStudies.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/processCapabilityStudies.R b/R/processCapabilityStudies.R index 53dd9153..2dfc099c 100644 --- a/R/processCapabilityStudies.R +++ b/R/processCapabilityStudies.R @@ -2697,7 +2697,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) { formula <- mathExpression(formula, inline=FALSE) - intro <- gettextf("The measrements, specification limits and target value were transformed using the %s transformation, with the following formula,", name) + intro <- gettextf("The measurements, specification limits and target value were transformed using the %s transformation, with the following formula,", name) html <- createJaspHtml(title="", text = paste(intro, formula, sep="
"))