Unit test fix

.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/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/processCapabilityStudies.md

@@ -141,7 +141,6 @@ The size of the subgroups is relevant for the calculation of the process varianc
 - FAdist
 - goftest
 - fitdistrplus
-- mle.tools
 - tidyr
 - tibble
 - EnvStats

inst/help/variablesChartsSubgroups.md

@@ -93,4 +93,3 @@ Select manually which tests you want to apply and modify them as desired:
 - ggrepel
 - tidyr
 - tibble
-- mle.tools