Minor issues

.Rbuildignore

@@ -3,3 +3,5 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^\examples$
+^\.positai$
+^\.claude$

.gitignore

@@ -64,3 +64,4 @@ renv/
 _processedLockFile.lock
 
 .vscode/
+.positai

DESCRIPTION

@@ -28,7 +28,6 @@ Imports:
   jaspDescriptives,
   jaspGraphs,
   lubridate,
-  mle.tools,
   psych,
   qcc,
   rsm,

R/TimeWeightedCharts.R

@@ -58,7 +58,7 @@ timeWeightedCharts <- function(jaspResults, dataset, options) {
       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))) {
+           any(table(dplyr::count(dataset, dplyr::across(dplyr::all_of(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.<br>"))
       }
       if (anyNA(dataset[[stages]])) {

R/doeAnalysis.R

@@ -23,10 +23,11 @@
       # avoid e-notation for small-to-moderate numbers
       mag <- floor(log10(absVal))
       sigDigits <- max(digits, mag + 1 + digits)
-      trimws(formatC(val, digits = sigDigits, format = "g", drop0trailing = TRUE))
+      formatted <- trimws(formatC(val, digits = sigDigits, format = "g", drop0trailing = TRUE))
     } else {
-      trimws(formatC(val, digits = digits, format = "g", drop0trailing = TRUE))
+      formatted <- trimws(formatC(val, digits = digits, format = "g", drop0trailing = TRUE))
     }
+    sub("^-", "\u2013", formatted)
   }, character(1))
 }
 
@@ -1485,7 +1486,7 @@ get_levels <- function(var, num_levels, dataset) {
       return()
     }
 
-    tb <- createJaspTable(gettext("ANOVA"))
+    tb <- createJaspTable(gettext("Analysis of Variance"))
     tb$addColumnInfo(name = "terms", title = gettext("Source"), type = "string")
     tb$addColumnInfo(name = "adjss", title = gettext("Sum of squares"), type = "number")
     tb$addColumnInfo(name = "df",    title = gettext("df"), type = "integer")
@@ -1916,6 +1917,13 @@ get_levels <- function(var, num_levels, dataset) {
       plotTitle <- gettextf("%1$s of %2$s vs %3$s", plotTypeString, dep, variablePairString)
       plot <- createJaspPlot(title = plotTitle, width = 500, height = 500)
       result <- jaspResults[[dep]][["doeResult"]]$object[["regression"]]
+      termLabels <- attr(stats::terms(result[["object"]]), "term.labels")
+      missingVars <- variablePair[!sapply(variablePair, function(var) any(grepl(var, termLabels, fixed = TRUE)))]
+      if (length(missingVars) > 0) {
+        plot$setError(gettext("Could not plot (some of the) selected variables as they were not included in the final model. They might have been removed during model selection."))
+        jaspResults[[dep]][["contourSurfacePlot"]][[plotTitle]] <- plot
+        next
+      }
       if (plotType == "contourPlot") {
         plot$plotObject <- function(){.doeContourSurfacePlotObject(result, options, dep, variablePair, type = "contour")}
       } else if (plotType == "surfacePlot") {

R/msaGaugeRR.R

@@ -250,7 +250,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
     # Gauge r&R ANOVA Table
     if (options[["anova"]]) {
       if (is.null(jaspResults[["gaugeANOVA"]])) {
-        jaspResults[["gaugeANOVA"]] <- createJaspContainer(gettext("Gauge r&R ANOVA table"))
+        jaspResults[["gaugeANOVA"]] <- createJaspContainer(gettext("Gauge r&R Analysis of Variance table"))
         jaspResults[["gaugeANOVA"]]$dependOn(c("processVariationReference", "historicalSdValue", "report"))
         jaspResults[["gaugeANOVA"]]$position <- 1
       }
@@ -334,7 +334,11 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
     if(options[["trafficLightChart"]] & is.null(jaspResults[["trafficPlot"]] )) {
       jaspResults[["trafficPlot"]] <- createJaspContainer(gettext("Traffic light chart"))
       jaspResults[["trafficPlot"]]$position <- 9
-      jaspResults[["trafficPlot"]]$dependOn(c("trafficLightChart", "toleranceValue", "tolerance", "gaugeRRmethod", "processVariationReference", "historicalSdValue", "report"))
+      jaspResults[["trafficPlot"]]$dependOn(c("trafficLightChart", "toleranceValue", "tolerance", "gaugeRRmethod",
+                        "processVariationReference", "historicalSdValue", "studyVarianceMultiplierType",
+                        "studyVarianceMultiplierValue", "measurementLongFormat", "operatorLongFormat",
+                        "partLongFormat", "measurementsWideFormat", "operatorWideFormat",
+                        "partWideFormat", "dataFormat", "type3", "report"))
       trafficContainer <- jaspResults[["trafficPlot"]]
 
       valuesVec <- .gaugeANOVA(dataset = dataset, measurements = measurements, parts = parts, operators = operators, options =  options, ready = ready, returnTrafficValues = TRUE, Type3 = Type3)
@@ -348,11 +352,11 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
 
 .gaugeANOVA <- function(dataset, measurements, parts, operators, options, ready, returnPlotOnly = FALSE, returnTrafficValues = FALSE,
                         gaugeEvaluationDfOnly = FALSE, Type3 = FALSE) {
-  anovaTables <- createJaspContainer(gettext("Gauge r&R study - crossed ANOVA"))
+  anovaTables <- createJaspContainer(gettext("Gauge r&R study - crossed Analysis of Variance"))
   anovaTables$dependOn(c("anova", "gaugeRRmethod", "report"))
   anovaTables$position <- 1
 
-  anovaTable1 <- createJaspTable(title = ifelse(Type3, gettext("One-way ANOVA table"), gettext("Two-way ANOVA table with interaction")))
+  anovaTable1 <- createJaspTable(title = ifelse(Type3, gettext("One-way Analysis of Variance table"), gettext("Two-way Analysis of Variance table with interaction")))
   anovaTable1$addColumnInfo(title = gettext("Source"),       name = "source",   type = "string" )
   anovaTable1$addColumnInfo(title = gettext("df"),             name = "Df",      type = "integer")
   anovaTable1$addColumnInfo(title = gettext("Sum of squares"), name = "Sum Sq",  type = "number")
@@ -569,7 +573,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
 
     } else {
 
-      anovaTable2 <- createJaspTable(title = gettext("Two-way ANOVA table without interaction"))
+      anovaTable2 <- createJaspTable(title = gettext("Two-way Analysis of Variance table without interaction"))
       anovaTable2$addColumnInfo(title = gettext("Source"),        name = "source",   type = "string" )
       anovaTable2$addColumnInfo(title = gettext("df"),             name = "Df",      type = "integer")
       anovaTable2$addColumnInfo(title = gettext("Sum of squares"), name = "Sum Sq",  type = "number")
@@ -904,7 +908,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
 }
 
 .gaugeVarCompGraph <- function(percentContributionValues, studyVariationValues, percentToleranceValues, Type3 = FALSE) {
-  sources <- gettext(c('Gauge r&R', 'Repeat', 'Reprod', 'Part-to-part'))
+  sources <- gettext(c("Gauge r&R", "Repeatability", "Reproducibility", "Part-to-part"))
   if (!all(is.na(percentToleranceValues))) {
     references <- gettextf(c('%% Contribution', '%% Study variation', '%% Tolerance'))
     values <- c(percentContributionValues, studyVariationValues, percentToleranceValues)
@@ -927,7 +931,8 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
                       position="dodge", stat = "identity") +
     jaspGraphs::themeJaspRaw() +
     jaspGraphs::geom_rangeframe() +
-    ggplot2::theme(legend.position = 'right', legend.title = ggplot2::element_blank()) +
+    ggplot2::theme(legend.position = "right", legend.title = ggplot2::element_blank(),
+             plot.margin = ggplot2::margin(5.5, 30, 5.5, 5.5, "pt")) +
     ggplot2::xlab(NULL) +
     ggplot2::scale_y_continuous(name = "Percent", breaks = yBreaks, limits = range(c(yBreaks, plotframe$value)))
   return(p)

R/msaGaugeRRnonrep.R

@@ -267,14 +267,19 @@ msaGaugeRRnonrep <- function(jaspResults, dataset, options, ...) {
       jaspResults[["trafficLightChart"]] <- .trafficplot(StudyVar = percentMSVar, ToleranceUsed = options[["tolerance"]],
                                                          ToleranceVar = percentMSTolerance, options = options,
                                                          ready = ready)
-      jaspResults[["trafficLightChart"]]$dependOn(c("trafficLightChart", "report"))
+      jaspResults[["trafficLightChart"]]$dependOn(c("trafficLightChart", "report", "processVariationReference",
+                        "historicalSdValue", "tolerance", "toleranceValue",
+                        "studyVarianceMultiplierType", "studyVarianceMultiplierValue",
+                        "measurementLongFormat", "operatorLongFormat", "partLongFormat",
+                        "measurementsWideFormat", "operatorWideFormat", "partWideFormat",
+                        "dataFormat"))
     }
   }
 }
 
 .gaugeRRNonRep <- function(dataset, measurements, parts, operators, options, ready, plotOnly = FALSE, trafficPlotValuesOnly = FALSE,
                            gaugeEvaluationDfOnly = FALSE) {
-  gaugeRRNonRepTables <- createJaspContainer(gettext("Gauge r&R study - nested ANOVA"))
+  gaugeRRNonRepTables <- createJaspContainer(gettext("Gauge r&R study - nested Analysis of Variance"))
   gaugeRRNonRepTables$position <- 1
 
   gaugeRRNonRepTable1 <- createJaspTable(title = gettext("Gauge r&R (nested)"))

R/msaTestRetest.R

@@ -107,7 +107,10 @@ msaTestRetest <- function(jaspResults, dataset, options, ...) {
   if(options[["trafficLightChart"]] && is.null(jaspResults[["trafficPlot"]] )) {
     jaspResults[["trafficPlot"]] <- createJaspContainer(gettext("Traffic light chart"))
     jaspResults[["trafficPlot"]]$position <- 4
-    jaspResults[["trafficPlot"]]$dependOn(c("trafficLightChart", "manualProcessSdValue", "manualProcessSd", "toleranceValue", "tolerance"))
+      jaspResults[["trafficPlot"]]$dependOn(c("trafficLightChart", "manualProcessSdValue", "manualProcessSd",
+                "toleranceValue", "tolerance", "measurementLongFormat", "measurementsWideFormat",
+                "partLongFormat", "partWideFormat", "operator", "dataFormat",
+                "measurementLongFormat", "measurementsWideFormat", "partLongFormat", "partWideFormat", "operator", "dataFormat"))
     TrafficContainer <- jaspResults[["trafficPlot"]]
 
     valuesVec <- .rAndRtableRange(dataset = dataset, measurements = measurements, parts = parts, operators = operators, options =  options, jaspResults, ready = ready, GRRpercent = TRUE)

R/processCapabilityStudies.R

@@ -59,7 +59,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) {
       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))) {
+           any(table(dplyr::count(dataset, dplyr::across(dplyr::all_of(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.<br>"))
       }
       if (anyNA(dataset[[stages]])) {
@@ -2703,6 +2703,37 @@ processCapabilityStudies <- function(jaspResults, dataset, options) {
   return(plot)
 }
 
+.qcObservedVarcov <- function(logdensity, X, parms, mle) {
+  mle <- unlist(mle)
+
+  if (!all(parms %in% names(mle))) {
+    if (length(mle) != length(parms))
+      stop(gettext("Could not compute variance-covariance matrix: parameter vector has unexpected length."), call. = FALSE)
+
+    names(mle) <- parms
+  }
+
+  mle <- as.numeric(mle[parms])
+  names(mle) <- parms
+
+  negLogLik <- function(theta) {
+    names(theta) <- parms
+    env <- list2env(c(as.list(theta), list(x = X)), parent = baseenv())
+    ll <- eval(logdensity, envir = env)
+    -sum(ll)
+  }
+
+  hessian <- stats::optimHess(par = mle, fn = negLogLik)
+
+  if (anyNA(hessian) || any(!is.finite(hessian)))
+    stop(gettext("Could not compute variance-covariance matrix: Hessian contains invalid values."), call. = FALSE)
+
+  varcov <- solve(hessian)
+  dimnames(varcov) <- list(parms, parms)
+
+  list(varcov = varcov)
+}
+
 .qcProbabilityPlotObject <- function(options, dataset, measurements, stages) {
   if (identical(stages, "")) {
     nStages <- 1
@@ -2749,8 +2780,8 @@ processCapabilityStudies <- function(jaspResults, dataset, options) {
     # Computing according to the distribution
     if (options[["nullDistribution"]] == "normal") {
       lpdf <- quote(-log(sigma) - 0.5 / sigma ^ 2 * (x - mu) ^ 2)
-      matrix <- try(mle.tools::observed.varcov(logdensity = lpdf, X = dataCurrentStage, parms = c("mu", "sigma"),
-                                               mle = c(mean(dataCurrentStage), sd(dataCurrentStage))))
+      matrix <- try(.qcObservedVarcov(logdensity = lpdf, X = dataCurrentStage, parms = c("mu", "sigma"),
+                  mle = c(mean(dataCurrentStage), sd(dataCurrentStage))))
       # Gracefully handle confidence band computation failure
       if (jaspBase::isTryError(matrix)) {
         hasConfidenceBands <- FALSE
@@ -2781,7 +2812,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) {
       meanlog <- as.numeric(fit$parameters[1])
       sdlog <- as.numeric(fit$parameters[2])
       lpdf <- quote(log(1/(sqrt(2*pi)*x*sdlog) * exp(-(log(x)- meanlog)^2/(2*sdlog^2))))
-      matrix <- try(mle.tools::observed.varcov(logdensity = lpdf, X = dataCurrentStage, parms = c("meanlog", "sdlog"), mle = fit$parameters))
+      matrix <- try(.qcObservedVarcov(logdensity = lpdf, X = dataCurrentStage, parms = c("meanlog", "sdlog"), mle = fit$parameters))
       # Gracefully handle confidence band computation failure
       if (jaspBase::isTryError(matrix)) {
         hasConfidenceBands <- FALSE
@@ -2819,7 +2850,7 @@ processCapabilityStudies <- function(jaspResults, dataset, options) {
       shape <- as.numeric(fit_Weibull[["beta"]])
       scale <- as.numeric(fit_Weibull[["theta"]])
       lpdf <- quote(log(shape) - shape * log(scale) + shape * log(x) - (x/scale)^shape)
-      matrix <- try(mle.tools::observed.varcov(logdensity = lpdf, X = dataCurrentStage, parms = c("shape", "scale"), mle = c("shape" = shape, "scale" = scale)))
+      matrix <- try(.qcObservedVarcov(logdensity = lpdf, X = dataCurrentStage, parms = c("shape", "scale"), mle = c("shape" = shape, "scale" = scale)))
       # Gracefully handle confidence band computation failure
       if (jaspBase::isTryError(matrix)) {
         hasConfidenceBands <- FALSE

R/variablesChartsSubgroups.R

@@ -74,7 +74,7 @@ variablesChartsSubgroups <- function(jaspResults, dataset, options) {
     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))) {
+         any(table(dplyr::count(dataset, dplyr::across(dplyr::all_of(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.<br>"))
     }
     if (anyNA(dataset[[stages]])) {

inst/help/attributesCharts.md

@@ -60,8 +60,6 @@ In the case that the data of the individual and moving Range chart (X-mR chart)
 
 - 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)
 
 

inst/help/doeAnalysis.md

@@ -18,27 +18,27 @@ A response surface design is an experimental framework used to optimize and unde
 
 ### Assignment box
 - Response: The measured outcome variable of the process under investigation.
-- Discrete predictors: The columns corresponding to the discrete predictors in the design.
-- Continuous predictors: The columns corresponding to the continuous predictors in the design.
-- Covariates: The columns corresponding to the covariates in the design. The difference between a covariate and a continuous predictor is that the covariate will not be analysed for interaction effects and excluded from effect plots.
-- Blocks: The columns corresponding to the blocks in the design. The difference between a block variable and a discrete predictor is that the blocks will not be analysed for interaction effects and excluded from effect plots.
+- Discrete factors: The columns corresponding to the discrete factors in the design.
+- Continuous factors: The columns corresponding to the continuous factors in the design.
+- Covariates: The columns corresponding to the covariates in the design. The difference between a covariate and a continuous factor is that the covariate will not be analysed for interaction effects and excluded from effect plots.
+- Blocks: The columns corresponding to the blocks in the design. The difference between a block variable and a discrete factor is that the blocks will not be analysed for interaction effects and excluded from effect plots.
 
 ## Analysis options
 -------
 
-### Predictor levels
-For the ordering of contrasts and to identify the alpha points in a response surface design, the low and high levels of all predictors need to be specified. There are two options to handle this.
+### Factor levels
+For the ordering of contrasts and to identify the alpha points in a response surface design, the low and high levels of all factors need to be specified. There are two options to handle this.
 
-- Automatically detect low/high: Attempts to automatically detect the low and high levels by taking the minimum and maximum for continuous predictors, and by ordering discrete predictors alphabetically. For response surface designs, this might recognize alpha values as low/high levels. In this case, manual specification is needed.
+- Automatically detect low/high: Attempts to automatically detect the low and high levels by taking the minimum and maximum for continuous factors, and by ordering discrete factors alphabetically. For response surface designs, this might recognize alpha values as low/high levels. In this case, manual specification is needed.
 
-- Manually specify low/high: Shows all predictors in the analysis to allow for manual specification of the low and high levels.
+- Manually specify low/high: Shows all factors in the analysis to allow for manual specification of the low and high levels.
 
 ### Other analysis options
 
-- Use alias names: Check to assign alias names to predictors. Useful when predictors have long names.
+- Use alias names: Check to assign alias names to factors. Useful when factors have long names.
 - Show regression equation: Check to display the regression coefficients as an equation predicting the response.
-- Display result in coded units: Check to display the results in coded units. This means, all predictor levels are standardized between -1 and 1.
-- Show optimal response: Check to display the predictor levels yielding the optimal response.
+- Display result in coded units: Check to display the results in coded units. This means, all factor levels are standardized between -1 and 1.
+- Show optimal response: Check to display the factor levels yielding the optimal response.
 
 ## Model options
 -------