diff --git a/.github/workflows/build-bundle.yml b/.github/workflows/build-bundle.yml new file mode 100644 index 0000000..d45d1f1 --- /dev/null +++ b/.github/workflows/build-bundle.yml @@ -0,0 +1,23 @@ +name: Build JASP Module on PR Comment + +on: + issue_comment: + types: [created] + +permissions: + pull-requests: write + contents: read + +jobs: + call-build-module: + # Only run if it's a PR, starts with 'build', and user has permissions + if: > + github.event.issue.pull_request && + startsWith(github.event.comment.body, 'build') && + contains(fromJson('["OWNER", "MEMBER", "COLLABORATOR"]'), github.event.comment.author_association) + + # Calls the reusable workflow from your central repo + uses: jasp-stats/jasp-actions/.github/workflows/build-bundle.yml@v1 + + # Passes the local repository's GITHUB_TOKEN down so the central action can comment and checkout code + secrets: inherit diff --git a/.github/workflows/test-coverage.yml b/.github/workflows/test-coverage.yml new file mode 100644 index 0000000..426887a --- /dev/null +++ b/.github/workflows/test-coverage.yml @@ -0,0 +1,21 @@ +on: + push: + branches: + - master # Essential for Codecov baseline + paths: ['**.R', 'tests/**', '**.c', '**.cpp', '**.h', '**.hpp', 'DESCRIPTION', 'NAMESPACE', 'MAKEVARS', 'MAKEVARS.win', '**.yml'] + + pull_request: + # Triggers when a PR is opened, updated, or marked ready for review + types: [opened, synchronize, reopened, ready_for_review] + paths: ['**.R', 'tests/**', '**.c', '**.cpp', '**.h', '**.hpp', 'DESCRIPTION', 'NAMESPACE', 'MAKEVARS', 'MAKEVARS.win'] + +jobs: + coverage: + # Run if it is a push (merge) OR if the PR is NOT a draft + if: github.event_name == 'push' || github.event.pull_request.draft == false + + uses: jasp-stats/jasp-actions/.github/workflows/coverage.yml@master + with: + needs_JAGS: false + secrets: + CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }} \ No newline at end of file diff --git a/.github/workflows/unittests.yml b/.github/workflows/unittests.yml index d175855..2954c49 100644 --- a/.github/workflows/unittests.yml +++ b/.github/workflows/unittests.yml @@ -1,15 +1,12 @@ on: + push: + paths: ['**.R', 'tests/**', '**.Rd', '**.c', '**.cpp', '**.h', '**.hpp', 'DESCRIPTION', 'NAMESPACE', 'MAKEVARS', 'MAKEVARS.win', '**.yml', 'renv.lock'] + pull_request: + paths: ['**.R', 'tests/**', '**.Rd', '**.c', '**.cpp', '**.h', '**.hpp', 'DESCRIPTION', 'NAMESPACE', 'MAKEVARS', 'MAKEVARS.win', '**.yml', 'renv.lock'] + schedule: + - cron: '13 12 * * 1-5' workflow_dispatch: -# once the module takes shape you may want to uncomment these lines -#on: -# push: -# paths: ['**.R', 'tests/**', '**.Rd', '**.c', '**.cpp', '**.h', '**.hpp', 'DESCRIPTION', 'NAMESPACE', 'MAKEVARS', 'MAKEVARS.win', '**.yml'] -# pull_request: -# paths: ['**.R', 'tests/**', '**.Rd', '**.c', '**.cpp', '**.h', '**.hpp', 'DESCRIPTION', 'NAMESPACE', 'MAKEVARS', 'MAKEVARS.win'] -# schedule: -# - cron: '13 12 * * 1-5' - name: unit-tests jobs: diff --git a/DESCRIPTION b/DESCRIPTION index 1c65efc..89db3f7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,19 +1,31 @@ -Package: jaspModuleTemplate -Type: Package -Title: A module for JASP -Version: 0.1.2 -Date: 2020-10-15 +Package: jaspBayesianQualityControl +Type: Package +Title: Bayesian Quality Control Module for JASP +Version: 0.1.0 +Date: 2026-08-06 Author: JASP Team -Website: jasp-stats.org -Maintainer: JASP Team -Description: Example module showing basic functionality. Use it for inspiration when creating your own module. +Website: https://github.com/jasp-stats/jaspBayesianQualityControl +Maintainer: JASP +Description: Bayesian counterparts to the quality control analyses, covering process capability and measurement systems analysis. License: GPL (>= 2) Encoding: UTF-8 +Depends: + R (>= 4.4.0) Imports: + BayesTools, + ggh4x, + ggplot2, + HDInterval, jaspBase, - jaspGraphs + jaspGraphs, + qc, + stats, + tibble Suggests: testthat Remotes: jasp-stats/jaspBase, - jasp-stats/jaspGraphs + jasp-stats/jaspGraphs, + FBartos/qc +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.3.3 diff --git a/NAMESPACE b/NAMESPACE index 316fe98..de0807f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,8 @@ -import(jaspBase) -export(addOne) -export(processTable) -export(parabola) -export(interfaceExample) +# Generated by roxygen2: do not edit by hand + +export(bayesianProcessCapabilityStudies) +importFrom(jaspBase,"%setOrRetrieve%") +importFrom(jaspBase,createJaspPlot) +importFrom(jaspBase,createJaspState) +importFrom(jaspBase,createJaspTable) +importFrom(jaspBase,jaspDeps) diff --git a/R/addOne.R b/R/addOne.R deleted file mode 100644 index 0fbc9fd..0000000 --- a/R/addOne.R +++ /dev/null @@ -1,8 +0,0 @@ -addOne <- function(jaspResults, dataset, options) { - result <- as.character(options$my_number + 1) # options$my_number comes from the menu created by inst/qml/integer.qml - - jaspResults[["result"]] <- createJaspHtml(text = result, - title = "This is your result:") - - return() -} diff --git a/R/bayesianProcessCapabilityStudies.R b/R/bayesianProcessCapabilityStudies.R new file mode 100644 index 0000000..3ae175b --- /dev/null +++ b/R/bayesianProcessCapabilityStudies.R @@ -0,0 +1,995 @@ +# +# Copyright (C) 2013-2025 University of Amsterdam +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +# + +#'@importFrom jaspBase jaspDeps %setOrRetrieve% createJaspPlot createJaspState createJaspTable + + +#'@export +bayesianProcessCapabilityStudies <- function(jaspResults, dataset, options) { + + fit <- .bpcsCapabilityTable(jaspResults, dataset, options, position = 1) + priorFit <- .bpcsSamplePosteriorOrPrior(jaspResults, dataset, options, prior = TRUE) + + .bpcsCapabilityPlot(jaspResults, options, fit, priorFit, position = 2) + .bpcsCapabilityPlot(jaspResults, options, fit, priorFit, position = 3, base = "priorDistributionPlot") + + .bpcsIntervalTable(jaspResults, options, fit, position = 4) + + .bpcsSequentialPointEstimatePlot( jaspResults, dataset, options, fit, position = 5) + .bpcsSequentialIntervalEstimatePlot(jaspResults, dataset, options, fit, position = 6) + + .bpcsPlotPredictive(jaspResults, dataset, options, fit, position = 7, base = "posteriorPredictiveDistributionPlot") + .bpcsPlotPredictive(jaspResults, dataset, options, priorFit, position = 8, base = "priorPredictiveDistributionPlot") + +} + +.bpcsIsReady <- function(options) { + # hasData <- if (options[["dataFormat"]] == "longFormat") { + # length(options[["measurementLongFormat"]]) > 0L && options[["measurementLongFormat"]] != "" + # } else { + # length(options[["measurementsWideFormat"]]) > 0L + # } + hasData <- length(options[["measurementLongFormat"]]) > 0L && options[["measurementLongFormat"]] != "" + hasData && + options[["lowerSpecificationLimit"]] && + options[["upperSpecificationLimit"]] && + options[["target"]] +} + +.bpcsStateDeps <- function() { + c( + # data + # "dataFormat", "measurementLongFormat", "measurementsWideFormat", + # "subgroupSizeType", "manualSubgroupSizeValue", "subgroup", "groupingVariableMethod", + # "stagesLongFormat", "stagesWideFormat", + "measurementLongFormat", + # specification + "target", "lowerSpecificationLimit", "upperSpecificationLimit", + "targetValue", "lowerSpecificationLimitValue", "upperSpecificationLimitValue", + # likelihood + "capabilityStudyType", + # prior + "priorSettings", "normalModelComponentsList", "tModelComponentsList", + # MCMC settings + "noIterations", "noWarmup", "noChains" + ) +} + +.bpcsDefaultDeps <- function() { + c( + .bpcsStateDeps(), + "axisLabels", + # metrics + "Cp", "Cpu", "Cpl", "Cpk", "Cpc", "Cpm" + ) +} + +.bpcsPlotLayoutDeps <- function(base, hasPrior = TRUE, hasEstimate = TRUE, hasCi = TRUE, hasType = FALSE, hasAxes = TRUE) { + c( + base, + if (hasEstimate) .bpcsPlotLayoutEstimateDeps(base), + if (hasCi) .bpcsPlotLayoutCiDeps(base), + if (hasType) .bpcsPlotLayoutTypeDeps(base), + if (hasAxes) .bpcsPlotLayoutAxesDeps(base), + if (hasPrior) .bpcsPlotLayoutPriorDeps(base) + ) +} + +.bpcsPlotLayoutEstimateDeps <- function(base) { paste0(base, c("IndividualPointEstimate", "IndividualPointEstimateType")) } +.bpcsPlotLayoutCiDeps <- function(base) { paste0(base, c("IndividualCi", "IndividualCiType", "IndividualCiMass", "IndividualCiLower", "IndividualCiUpper", "IndividualCiBf")) } +.bpcsPlotLayoutTypeDeps <- function(base) { paste0(base, c("TypeLower", "TypeUpper")) } +.bpcsPlotLayoutAxesDeps <- function(base) { paste0(base, c("PanelLayout", "Axes", "custom_x_min", "custom_x_max", "custom_y_min", "custom_y_max")) } +.bpcsPlotLayoutPriorDeps <- function(base) { paste0(base, "PriorDistribution") } + +.bpcsProcessCriteriaDeps <- function() { + c(paste0("interval", 1:4), paste0("intervalLabel", 1:5)) +} + +.bpcsPriorComponentByName <- function(options, name) { + components <- options$normalModelComponentsList + for (comp in components) { + if (comp$name == name) + return(comp) + } + return(NULL) +} + +.bpcsPriorFromComponent <- function(optionsPrior, paramName) { + if (is.null(optionsPrior)) + return(NULL) + + if (optionsPrior$type == "jeffreys") + return(paste0("Jeffreys_", paramName)) + + arguments <- list() + + arguments[["distribution"]] <- switch( + optionsPrior[["type"]], + "gammaAB" = "gamma", + "gammaK0" = "gamma", + optionsPrior[["type"]] + ) + + arguments[["parameters"]] <- switch( + optionsPrior[["type"]], + "normal" = list("mean" = optionsPrior[["mu"]], "sd" = optionsPrior[["sigma"]]), + "t" = list("location" = optionsPrior[["mu"]], "scale" = optionsPrior[["sigma"]], "df" = optionsPrior[["nu"]]), + "cauchy" = list("location" = optionsPrior[["mu"]], "scale" = optionsPrior[["theta"]]), + "gammaAB" = list("shape" = optionsPrior[["alpha"]], "rate" = optionsPrior[["beta"]]), + "gammaK0" = list("shape" = optionsPrior[["k"]], "rate" = 1/optionsPrior[["theta"]]), + "invgamma" = list("shape" = optionsPrior[["alpha"]], "scale" = optionsPrior[["beta"]]), + "lognormal" = list("meanlog" = optionsPrior[["mu"]], "sdlog" = optionsPrior[["sigma"]]), + "beta" = list("alpha" = optionsPrior[["alpha"]], "beta" = optionsPrior[["beta"]]), + "uniform" = list("a" = optionsPrior[["a"]], "b" = optionsPrior[["b"]]), + "exponential" = list("rate" = optionsPrior[["lambda"]]), + "spike" = list("location" = optionsPrior[["x0"]]) + ) + + if(!arguments[["distribution"]] %in% c("spike", "uniform")) { + arguments[["truncation"]] <- list( + lower = optionsPrior[["truncationLower"]], + upper = optionsPrior[["truncationUpper"]] + ) + } + + return(do.call(BayesTools::prior, arguments)) +} + +.bpcsMuPriorFromOptions <- function(options) { + if (options$priorSettings == "default") { + return("Jeffreys_mu") + } else { + comp <- .bpcsPriorComponentByName(options, "mean") + return(.bpcsPriorFromComponent(comp, "mu")) + } +} + +.bpcsSigmaPriorFromOptions <- function(options) { + if (options$priorSettings == "default") { + return("Jeffreys_sigma") + } else { + comp <- .bpcsPriorComponentByName(options, "sigma") + return(.bpcsPriorFromComponent(comp, "sigma")) + } +} +.bpcsTPriorFromOptions <- function(options) { + + switch(options[["capabilityStudyType"]], + "normalCapabilityAnalysis" = NULL, + "tCapabilityAnalysis" = .bpcsPriorFromComponent(.bpcsPriorComponentByName(options, "df"), "df"), + + stop("Unknown capability study type: ", options[["capabilityStudyType"]]) + ) +} + +.bpcsPriorHelper <- function(options) { + if (options$priorSettings == "default") { + if (options[["capabilityStudyType"]] == "normalCapabilityAnalysis") { + return("DCSI") + } + return("Jeffreys") + } + + mu_prior <- .bpcsMuPriorFromOptions(options) + sigma_prior <- .bpcsSigmaPriorFromOptions(options) + nu_prior <- .bpcsTPriorFromOptions(options) + + args <- list(mu = mu_prior, sigma = sigma_prior) + if (!is.null(nu_prior)) { + args$nu <- nu_prior + } + + do.call(qc::prior_independent, args) +} + +# Tables ---- +.bpcsCapabilityTable <- function(jaspResults, dataset, options, position) { + + # Check if we already have the results cached + if (!is.null(jaspResults[["bpcsCapabilityTable"]])) + return(.bpcsSamplePosteriorOrPrior(jaspResults, dataset, options)) # will return object from state (if it exists) + + table <- .bpcsCapabilityTableMeta(jaspResults, options, position = position) + if (!.bpcsIsReady(options)) { + + if (options[["measurementLongFormat"]] != "" || length(options[["measurementsWideFormat"]]) > 0) + table$addFootnote(gettext( + "Please specify the Lower Specification Limit, Upper Specification Limit, and Target Value to compute the capability measures." + )) + + return(NULL) + } + + resultsObject <- .bpcsSamplePosteriorOrPrior(jaspResults, dataset, options) + + .bpcsCapabilityTableFill(table, resultsObject, options) + return(resultsObject) + +} + +.bpcsSamplePosteriorOrPrior <- function(jaspResults, dataset, options, prior = FALSE) { + + base <- if (prior) "bpcsPriors" else "bpcs" + if (prior && !.bpcsCanSampleFromPriors(options)) + return(NULL) + + if (!is.null(jaspResults[[paste0(base, "ResultsObject")]])) + return(jaspResults[[paste0(base, "ResultsObject")]]$object) + + x <- if (ncol(dataset) > 0L) dataset[[1L]] else NULL + + rawfit <- jaspResults[[paste0(base, "State")]] %setOrRetrieve% ( + qc::bpc( + x, chains = options[["noChains"]], warmup = options[["noWarmup"]], iter = options[["noIterations"]], + silent = TRUE, seed = 1, + target = options[["targetValue"]], + LSL = options[["lowerSpecificationLimitValue"]], + USL = options[["upperSpecificationLimitValue"]], + prior = .bpcsPriorHelper(options), + sample_priors = prior + ) |> + createJaspState(jaspDeps(.bpcsStateDeps())) + ) + + summaryObject <- jaspResults[[paste0(base, "SummaryState")]] %setOrRetrieve% ( + summary( + rawfit, ci.level = options[["credibleIntervalWidth"]] + ) |> + createJaspState(jaspDeps( + options = c(.bpcsStateDeps(), "credibleIntervalWidth") + )) + ) + + resultsObject <- list( + rawfit = rawfit, + summaryObject = summaryObject + ) + + jaspResults[[paste0(base, "ResultsObject")]] <- createJaspState(resultsObject) + + return(resultsObject) +} + +.bpcsCanSampleFromPriors <- function(options) { + if (options$priorSettings != "default") { + return(TRUE) + } + options[["capabilityStudyType"]] == "normalCapabilityAnalysis" +} + +.bpcsCapabilityTableMeta <- function(jaspResults, options, position) { + + table <- createJaspTable(title = gettext("Capability Table"), position = position) + table$addColumnInfo(name = "metric", title = gettext("Measure"), type = "string") + table$addColumnInfo(name = "mean", title = gettext("Mean"), type = "number") + table$addColumnInfo(name = "median", title = gettext("Median"), type = "number") + table$addColumnInfo(name = "sd", title = gettext("Std"), type = "number") + + overtitle <- gettextf("%s%% Credible Interval", 100 * options[["credibleIntervalWidth"]]) + table$addColumnInfo(name = "lower", title = gettext("Lower"), type = "number", overtitle = overtitle) + table$addColumnInfo(name = "upper", title = gettext("Upper"), type = "number", overtitle = overtitle) + + table$dependOn(c(.bpcsDefaultDeps(), "credibleIntervalWidth")) + + jaspResults[["bpcsCapabilityTable"]] <- table + return(table) + +} + +.bpcsGetSelectedMetrics <- function(options) { + # casing must match the metric names qc uses, it errors on CpU / CpL + allMetrics <- c("Cp", "Cpu", "Cpl", "Cpk", "Cpc", "Cpm") + selectedMetrics <- allMetrics[c(options[["Cp"]], options[["Cpu"]], options[["Cpl"]], + options[["Cpk"]], options[["Cpc"]], options[["Cpm"]])] + return(selectedMetrics) +} + +.bpcsGetCustomAxisLimits <- function(options, base) { + keys <- c(paste0(base, "custom_x_", c("min", "max")), paste0(base, "custom_y_", c("min", "max"))) + values <- lapply(keys, function(k) options[[k]]) + names(values) <- c("xmin", "xmax", "ymin", "ymax") + values +} +# end utils + +.bpcsCapabilityTableFill <- function(table, resultsObject, options) { + + df <- as.data.frame(resultsObject[["summaryObject"]][["summary"]]) + + # Filter metrics based on user selection + selectedMetrics <- .bpcsGetSelectedMetrics(options) + + if (length(selectedMetrics) > 0) { + df <- df[df$metric %in% selectedMetrics, , drop = FALSE] + } + + table$setData(df) + +} + +.bpcsIntervalTable <- function(jaspResults, options, fit, position) { + + if (!options[["intervalTable"]]) + return() + + table <- .bpcsIntervalTableMeta(jaspResults, options, position) + if (!.bpcsIsReady(options) || is.null(fit)) + return() + + selectedMetrics <- .bpcsGetSelectedMetrics(options) + tryCatch({ + + # qc does c(-Inf, interval_probability, Inf) + interval_probability <- unlist(options[paste0("interval", 1:4)], use.names = FALSE) + interval_summary <- summary(fit[["rawfit"]], interval_probability = interval_probability)[["interval_summary"]] + colnames(interval_summary) <- c("metric", paste0("interval", 1:5)) + interval_summary <- subset(interval_summary, metric %in% selectedMetrics) + table$setData(interval_summary) + + }, error = function(e) { + + table$setError(gettextf("Unexpected error in interval table: %s", e$message)) + + }) + + return() +} + +.bpcsIntervalTableMeta <- function(jaspResults, options, position) { + + table <- createJaspTable(title = gettext("Interval Table"), position = position) + + table$addColumnInfo(name = "metric", title = gettext("Capability\nMeasure"), type = "string") + + intervalBounds <- c(-Inf, unlist(options[paste0("interval", 1:4)], use.names = FALSE), Inf) + intervalNames <- unlist(options[paste0("intervalLabel", 1:5)], use.names = FALSE) + n <- length(intervalBounds) + + # custom format helper. we don't use e.g., %.3f directly because that adds trailing zeros (2.000 instead of 2) + fmt <- \(x) formatC(x, digits = 3, format = "f", drop0trailing = TRUE) + for (i in 1:(n - 1)) { + j <- i + 1 + lhs <- if (i == 1) "(" else "[" + rhs <- if (i == n - 1) ")" else "]" + title <- sprintf("%s %s%s, %s%s", intervalNames[i], lhs, fmt(intervalBounds[i]), fmt(intervalBounds[j]), rhs) + table$addColumnInfo(name = paste0("interval", i), title = title, type = "number") + } + table$dependOn(c("intervalTable", .bpcsDefaultDeps(), .bpcsProcessCriteriaDeps())) + + jaspResults[["bpcsIntervalTable"]] <- table + return(table) +} + + +# Plots ---- +.bpcsCapabilityPlot <- function(jaspResults, options, fit, priorFit, position, base = "posteriorDistributionPlot") { + + if (!options[[base]] || !is.null(jaspResults[[base]])) + return() + + singlePanel <- options[[paste0(base, "PanelLayout")]] != "multiplePanels" + + isPost <- base == "posteriorDistributionPlot" + summaryObject <- if (isPost) fit$summaryObject else priorFit$summaryObject + # only if the user asked for it + priorSummaryObject <- if (isPost && options[[paste0(base, "PriorDistribution")]]) priorFit$summaryObject else NULL + + jaspPlt <- createJaspPlot( + title = if (isPost) gettext("Posterior Distribution") else gettext("Prior Distribution"), + width = 400 * (if (singlePanel) 1 else 3), + height = 400 * (if (singlePanel) 1 else 2), + position = position, + dependencies = jaspDeps( + options = c( + .bpcsDefaultDeps(), + # .bpcsPosteriorPlotDeps(options), + .bpcsPlotLayoutDeps(base, hasType = FALSE) + ) + ) + ) + jaspResults[[base]] <- jaspPlt + + if (!.bpcsIsReady(options) || (isPost && is.null(fit)) || (!isPost && is.null(priorFit))) + return() + + if (!isPost && !.bpcsCanSampleFromPriors(options)) { + jaspPlt$width <- 400 + jaspPlt$height <- 400 + jaspPlt$setError(gettext("Prior distribution cannot be shown for improper priors.")) + return() + } + + tryCatch({ + + # Get selected metrics + selectedMetrics <- .bpcsGetSelectedMetrics(options) + + if (length(selectedMetrics) == 0) { + NULL + } else { + + jaspPlt$plotObject <- qc::plot_density( + summaryObject, + what = selectedMetrics, + point_estimate = if (options[[paste0(base, "IndividualPointEstimate")]]) options[[paste0(base, "IndividualPointEstimateType")]] else "none", + ci = if (options[[paste0(base, "IndividualCi")]]) options[[paste0(base, "IndividualCiType")]] else "none", + ci_level = options[[paste0(base, "IndividualCiMass")]], + ci_custom_left = options[[paste0(base, "IndividualCiLower")]], + ci_custom_right = options[[paste0(base, "IndividualCiUpper")]], + bf_support = options[[paste0(base, "IndividualCiBf")]], + single_panel = singlePanel, + axes = options[[paste0(base, "Axes")]], + axes_custom = .bpcsGetCustomAxisLimits(options, base), + priorSummaryObject = priorSummaryObject + ) + + jaspGraphs::geom_rangeframe() + + jaspGraphs::themeJaspRaw() + + + } + }, error = function(e) { + jaspPlt$width <- 400 + jaspPlt$height <- 400 + jaspPlt$setError( + if (isPost) gettextf("Unexpected error in posterior distribution plot: %s", e$message) + else gettextf("Unexpected error in prior distribution plot: %s", e$message) + ) + }) + +} + +# .bpcsPosteriorPlotDeps <- function(options) { +# c( +# "posteriorDistributionPlot", +# "posteriorDistributionPlotIndividualPointEstimate", +# "posteriorDistributionPlotIndividualPointEstimateType", +# "posteriorDistributionPlotPriorDistribution", +# "posteriorDistributionPlotIndividualCi", +# "posteriorDistributionPlotIndividualCiType", +# # these match which options are conditionally enabled in the qml file. +# switch(options[["posteriorDistributionPlotIndividualCiType"]], +# "central" = "posteriorDistributionPlotIndividualCiMass", +# "HPD" = "posteriorDistributionPlotIndividualCiMass", +# "custom" = c("posteriorDistributionPlotIndividualCiLower", "posteriorDistributionPlotIndividualCiUpper"), +# "support" = "posteriorDistributionPlotIndividualCiBf" +# ) +# ) +# } + +.bpcsSequentialPointEstimatePlot <- function(jaspResults, dataset, options, fit, position) { + + base <- "sequentialAnalysisPointEstimatePlot" + # "sequentialAnalysisPointIntervalPlot" + if (!options[[base]] || !is.null(jaspResults[[base]])) + return() + + w <- 400 + plt <- createJaspPlot(title = gettext("Sequential Analysis Point Estimate"), width = 3*w, height = 2*w, + position = position, + dependencies = jaspDeps(c( + .bpcsDefaultDeps(), + .bpcsPlotLayoutDeps(base, hasPrior = FALSE), + "sequentialAnalysisPlotAdditionalInfo" + ))) + jaspResults[[base]] <- plt + + if (!.bpcsIsReady(options) || jaspResults$getError()) return() + + sequentialPlotData <- .bpcsGetSequentialAnalysis(jaspResults, dataset, options, fit) + + if (!is.null(sequentialPlotData$error)) { + plt$setError(sequentialPlotData$error) + } else { + tryCatch({ + plt$plotObject <- .bpcsMakeSequentialPlot(sequentialPlotData$data, options, base) + }, error = function(e) { + plt$setError(gettextf("Unexpected error in sequential analysis point estimate plot: %s", e$message)) + } + ) + } +} + +.bpcsSequentialIntervalEstimatePlot <- function(jaspResults, dataset, options, fit, position) { + + # base <- "sequentialAnalysisPointEstimatePlot" + base <- "sequentialAnalysisPointIntervalPlot" + if (!options[[base]] || !is.null(jaspResults[[base]])) + return() + + w <- 400 + plt <- createJaspPlot(title = gettext("Sequential Analysis Interval Estimate"), width = 3*w, height = 2*w, + position = position, + dependencies = jaspDeps(c( + .bpcsDefaultDeps(), + # mirrors the flags set on this plot's Common.PlotLayout in the qml + .bpcsPlotLayoutDeps(base, hasPrior = FALSE, hasEstimate = FALSE, hasCi = FALSE, hasType = TRUE) + ))) + jaspResults[[base]] <- plt + + if (!.bpcsIsReady(options) || jaspResults$getError()) return() + + sequentialPlotData <- .bpcsGetSequentialAnalysis(jaspResults, dataset, options, fit) + + if (!is.null(sequentialPlotData$error)) { + plt$setError(sequentialPlotData$error) + } else { + tryCatch({ + plt$plotObject <- .bpcsMakeSequentialPlot(sequentialPlotData$data, options, base, custom = TRUE) + }, error = function(e) { + plt$setError(gettextf("Unexpected error in sequential analysis interval estimate plot: %s", e$message)) + } + ) + } +} + +.bpcsGetSequentialAnalysis <- function(jaspResults, dataset, options, fit) { + + if (!.bpcsIsReady(options) || jaspResults$getError()) return() + + base1 <- "sequentialAnalysisPointEstimatePlot" + base2 <- "sequentialAnalysisPointIntervalPlot" + + baseData <- "SequentialAnalysisData" + tryCatch({ + sequentialPlotData <- jaspResults[[baseData]] %setOrRetrieve% ( + .bpcsComputeSequentialAnalysis(dataset, options, fit) |> + createJaspState(dependencies = jaspDeps( + options = c(.bpcsStateDeps(), + paste0(base2, c("TypeLower", "TypeUpper"))) + )) + ) + + return(list(data = sequentialPlotData, error = NULL)) + + }, error = function(e) { + + return(list(data = NULL, error = e$message)) + + }) + +} + +.bpcsComputeSequentialAnalysis <- function(dataset, options, fit) { + + n <- nrow(dataset) + if (!is.finite(n) || n < 3L) { + stop("Sequential analysis requires at least 3 observations.", call. = FALSE) + } + nfrom <- 3L + nto <- n + nby <- 1L + nseq <- seq(nfrom, nto, by = nby) + estimates <- array(NA, c(6, 5, length(nseq))) + + hasCustom <- options$sequentialAnalysisPointIntervalPlot + customBounds <- c(options$sequentialAnalysisPointIntervalPlotTypeLower, + options$sequentialAnalysisPointIntervalPlotTypeUpper) + + keys <- c("mean", "median", "lower", "upper", "custom") + dimnames(estimates) <- list(list(), keys, list()) + + x <- dataset[[1L]] + + jaspBase::startProgressbar(length(nseq), label = gettext("Running sequential analysis")) + + prior <- .bpcsPriorHelper(options) + n_failed <- 0L + for (i in seq_along(nseq)) { + + x_i <- x[1:nseq[i]] + fit_i <- tryCatch( + qc::bpc( + x_i, chains = options[["noChains"]], warmup = options[["noWarmup"]], iter = options[["noIterations"]], + silent = TRUE, seed = 1, + target = options[["targetValue"]], + LSL = options[["lowerSpecificationLimitValue"]], + USL = options[["upperSpecificationLimitValue"]], + prior = prior + ), + error = function(e) NULL + ) + + if (is.null(fit_i)) { + n_failed <- n_failed + 1L + jaspBase::progressbarTick() + next + } + + sum_fit_i <- summary(fit_i, interval_probability = customBounds) + sum_i <- sum_fit_i$summary + custom_i <- sum_fit_i$interval_summary[, 3, drop = FALSE] + colnames(custom_i) <- "custom" + sum_i <- cbind(sum_i, custom_i) + + if (is.null(rownames(estimates))) + rownames(estimates) <- sum_i$metric + + estimates[, , i] <- as.matrix(sum_i[keys]) + jaspBase::progressbarTick() + } + + if (n_failed > 0L && n_failed / length(nseq) > 0.1) { + stop( + sprintf( + "%d of %d sequential fits failed (%.0f%%). Cannot render plot.", + n_failed, length(nseq), 100 * n_failed / length(nseq) + ), + call. = FALSE + ) + } + + attr(estimates, "nseq") <- nseq + + # we could use this one, but only if the CI width is exactly equal to the one requested here. + # that would be nice to add at some point so the values in the table are identical to those in the plot + # sum_n <- summary(fit)$summary + # estimates[, , n] <- as.matrix(sum_n[keys]) + + return(estimates) +} + +.bpcsMakeSequentialPlot <- function(estimates, options, base, custom = FALSE) { + + # this function should move to qc, and these are the arguments that should be passed to the arguments of that function + single_panel <- options[[paste0(base, "PanelLayout")]] != "multiplePanels" + axes <- options[[paste0(base, "Axes")]] + axes_custom <- .bpcsGetCustomAxisLimits(options, base) + + pointEstimateOption <- paste0(base, "IndividualPointEstimateType") + pointEstimateName <- if (options[[pointEstimateOption]] == "mean") "mean" else "median" + add_additional_info <- options[["sequentialAnalysisPlotAdditionalInfo"]] + + selectedMetrics <- .bpcsGetSelectedMetrics(options) + if (length(selectedMetrics) == 0L) + return(NULL) + + ciOption <- paste0(base, "IndividualCi") + has_ci <- options[[ciOption]] + + if (custom) { + has_ci <- FALSE + pointEstimateName <- "custom" + add_additional_info <- FALSE + y_limits <- c(0, 1) + y_title <- gettextf("P(%1$.3f \u2264 x \u2264 %2$.3f)", + options$sequentialAnalysisPointIntervalPlotTypeLower, + options$sequentialAnalysisPointIntervalPlotTypeUpper) + } else { + + y_title <- if (has_ci) { + gettextf("Estimate with 95%% credible interval") + } else { + gettext("Estimate") + } + } + + # this is somewhat ugly, but we convert the 3d array to a tibble for plotting + # we don't create the tibble immediately in the previous function, because + # it takes up more space in the state (which means larger jasp files) + + categoryNames <- c(gettext("Incapable"), gettext("Capable"), gettext("Satisfactory"), gettext("Excellent"), gettext("Super")) + gridLines <- c(1, 4/3, 3/2, 2) + # the extrema are missing here, these should be determined based on any leftover space. + defaultCategoryPositions <- (gridLines[-1] + gridLines[-length(gridLines)]) / 2 + + nseq <- attr(estimates, "nseq") + + tb <- tibble::tibble( + metric = factor(rep(rownames(estimates), times = length(nseq))), + n = rep(nseq, each = nrow(estimates)), + mean = as.vector(estimates[, pointEstimateName, ]), + lower = as.vector(estimates[, "lower", ]), + upper = as.vector(estimates[, "upper", ]), + ) + tb <- tb[tb$metric %in% selectedMetrics, , drop = FALSE] + if (length(selectedMetrics) == 1L) + single_panel <- TRUE + + # get y scales per facet + if (single_panel) { + + observedRange <- range(tb$lower, tb$upper, na.rm = TRUE) + if (!all(is.finite(observedRange))) { + observedRange <- c(0, 1) + } + dist <- observedRange[2L] - observedRange[1L] + + observedRange[1L] <- min(observedRange[1L], gridLines[1L] - 0.1 * dist) + observedRange[2L] <- max(observedRange[2L], gridLines[length(gridLines)] + 0.1 * dist) + + leftBreaks <- jaspGraphs::getPrettyAxisBreaks(observedRange) + leftLimits <- range(leftBreaks) + + rightAxis <- ggplot2::waiver() + if (add_additional_info) { + rightBreaksShown <- c( + (leftLimits[1L] + gridLines[1L]) / 2, + defaultCategoryPositions, + (leftLimits[2L] + gridLines[length(gridLines)]) / 2 + ) + rightBreaks <- numeric(2L*length(rightBreaksShown) + 1L) + rightBreaks[1L] <- leftLimits[1L] + rightBreaks[seq(2, length(rightBreaks), 2)] <- rightBreaksShown + rightBreaks[seq(3, length(rightBreaks) - 2, 2)] <- gridLines + rightBreaks[length(rightBreaks)] <- leftLimits[2L] + + rightLabels <- character(length(rightBreaks)) + rightLabels[seq(2, length(rightLabels), 2)] <- categoryNames + rightAxis <- ggplot2::sec_axis(identity, breaks = rightBreaks, labels = rightLabels) + } + + y_breaks_per_scale <- ggplot2::scale_y_continuous(breaks = leftBreaks, limits = range(leftBreaks), + minor_breaks = gridLines, + sec.axis = rightAxis) + + } else { + y_breaks_per_scale <- tapply(tb, tb$metric, \(x) { + + # x <- tb[tb$metric == tb$metric[1L], , drop = FALSE] + observedRange <- range(x$lower, x$upper, na.rm = TRUE) + if (!all(is.finite(observedRange))) { + observedRange <- c(0, 1) + } + dist <- observedRange[2L] - observedRange[1L] + + observedRange[1L] <- min(observedRange[1L], gridLines[1L] - 0.1 * dist) + observedRange[2L] <- max(observedRange[2L], gridLines[length(gridLines)] + 0.1 * dist) + + if (custom) { + observedRange[1L] <- max(observedRange[1L], y_limits[1L]) + observedRange[2L] <- min(observedRange[2L], y_limits[2L]) + } + + leftBreaks <- jaspGraphs::getPrettyAxisBreaks(observedRange) + leftLimits <- range(leftBreaks) + + rightAxis <- ggplot2::waiver() + if (add_additional_info) { + rightBreaksShown <- c( + (leftLimits[1L] + gridLines[1L]) / 2, + defaultCategoryPositions, + (leftLimits[2L] + gridLines[length(gridLines)]) / 2 + ) + rightBreaks <- numeric(2L*length(rightBreaksShown) + 1L) + rightBreaks[1L] <- leftLimits[1L] + rightBreaks[seq(2, length(rightBreaks), 2)] <- rightBreaksShown + rightBreaks[seq(3, length(rightBreaks) - 2, 2)] <- gridLines + rightBreaks[length(rightBreaks)] <- leftLimits[2L] + + rightLabels <- character(length(rightBreaks)) + rightLabels[seq(2, length(rightLabels), 2)] <- categoryNames + rightAxis <- ggplot2::sec_axis(identity, breaks = rightBreaks, labels = rightLabels) + } + + ggplot2::scale_y_continuous(breaks = leftBreaks, limits = range(leftBreaks), + minor_breaks = gridLines, + sec.axis = rightAxis) + }, simplify = FALSE) + } + + ribbon <- NULL + if (has_ci) + ribbon <- ggplot2::geom_ribbon(ggplot2::aes(ymin = .data$lower, ymax = .data$upper), alpha = 0.3) + + extraTheme <- gridLinesLayer <- NULL + sides <- "bl" + if (add_additional_info) { + # there are 11 ticks, the outermost we hide (NA) because one of their bounds is infinite + # the inner ticks alternate between black and NA, so there is a tick at the grid lines + # but no tick at the criteria text (which is secretly an axis tick label). + rightTickColors <- c(NA, rep(c(NA, "black"), length.out = 9), NA) + extraTheme <- ggplot2::theme(axis.ticks.y.right = ggplot2::element_line(colour = rightTickColors)) + sides <- "blr" + # I tried using minor.breaks for this, but these are not drawn properly with facet_grid and facetted_pos_scales + gridLinesLayer <- ggplot2::geom_hline( + data = data.frame(yintercept = gridLines), + ggplot2::aes(yintercept = .data$yintercept), + # show.legend = FALSE, + linewidth = .5, color = "lightgray", linetype = "dashed" + ) + + } + + scale_x <- scale_facet <- facet <- NULL + noMetrics <- nrow(estimates) + if (noMetrics == 1L || single_panel) { + xBreaks <- jaspGraphs::getPrettyAxisBreaks(tb$n) + xLimits <- range(tb$n) + scale_x <- ggplot2::scale_x_continuous(breaks = xBreaks, limits = xLimits) + scale_facet <- y_breaks_per_scale + } else { + scales <- switch(axes, + "automatic" = "free_y", + "fixed" = "fixed", + "free" = "free_y", + "custom" = "fixed", + stop("Unknown axes option.") + ) + if (axes == "custom") { + if (!is.null(axes_custom[["xmin"]]) && !is.null(axes_custom[["xmax"]])) { + xbreaks <- jaspGraphs::getPrettyAxisBreaks(c(axes_custom[["xmin"]], axes_custom[["xmax"]])) + scale_x <- ggplot2::scale_x_continuous(limits = sort(c(axes_custom[["xmin"]], axes_custom[["xmax"]]))) + } + if (!is.null(axes_custom[["ymin"]]) && !is.null(axes_custom[["ymax"]])) { + ybreaks <- jaspGraphs::getPrettyAxisBreaks(c(axes_custom[["ymin"]], axes_custom[["ymax"]])) + leftLimits <- sort(c(axes_custom[["ymin"]], axes_custom[["ymax"]])) + rightAxis <- ggplot2::waiver() + if (add_additional_info) { + rightBreaksShown <- c( + (leftLimits[1L] + gridLines[1L]) / 2, + defaultCategoryPositions, + (leftLimits[2L] + gridLines[length(gridLines)]) / 2 + ) + rightBreaks <- numeric(2L*length(rightBreaksShown) + 1L) + rightBreaks[1L] <- leftLimits[1L] + rightBreaks[seq(2, length(rightBreaks), 2)] <- rightBreaksShown + rightBreaks[seq(3, length(rightBreaks) - 2, 2)] <- gridLines + rightBreaks[length(rightBreaks)] <- leftLimits[2L] + + rightLabels <- character(length(rightBreaks)) + rightLabels[seq(2, length(rightLabels), 2)] <- categoryNames + rightAxis <- ggplot2::sec_axis(identity, breaks = rightBreaks, labels = rightLabels) + } + scale_facet <- ggplot2::scale_y_continuous(breaks = ybreaks, limits = leftLimits, + minor_breaks = gridLines, sec.axis = rightAxis) + } + } else if (axes == "automatic" || axes == "free") { + scale_facet <- ggh4x::facetted_pos_scales(y = y_breaks_per_scale) + } + facet <- ggplot2::facet_wrap(~metric, scales = scales) + } + + ggplot2::ggplot(tb, ggplot2::aes(x = .data$n, y = .data$mean, group = .data$metric, + color = .data$metric, fill = .data$metric)) + + gridLinesLayer + + ribbon + + ggplot2::geom_line(linewidth = 1) + + facet + scale_facet + scale_x + + ggplot2::labs( + x = gettext("Number of observations"), + y = y_title, + color = gettext("Metric"), + fill = gettext("Metric") + ) + + jaspGraphs::geom_rangeframe(sides = sides) + + jaspGraphs::themeJaspRaw(legend.position = if (single_panel) "right" else "none") + + extraTheme + +} + +# Additional plot functions ---- +.bpcsPlotPredictive <- function(jaspResults, dataset, options, fit, position, base = c("posteriorPredictiveDistributionPlot", "priorPredictiveDistributionPlot")) { + + base <- match.arg(base) + isPrior <- base == "priorPredictiveDistributionPlot" + + if (!options[[base]] || !is.null(jaspResults[[base]])) + return() + + plot <- createJaspPlot( + title = if (isPrior) gettext("Prior predictive distribution") else gettext("Posterior Predictive Distribution"), + width = 400, + height = 400, + position = position, + dependencies = c( + .bpcsDefaultDeps(), + base, + paste0(base, "IndividualPointEstimate"), + paste0(base, "IndividualPointEstimateType"), + paste0(base, "IndividualCi"), + paste0(base, "IndividualCiType"), + paste0(base, "IndividualCiMass"), + paste0(base, "IndividualCiLower"), + paste0(base, "IndividualCiUpper") + )) + + jaspResults[[base]] <- plot + + if (!.bpcsIsReady(options) || is.null(fit) || jaspResults$getError()) return() + + tryCatch({ + rawfit <- fit$rawfit + predictiveSamples <- tryCatch( + qc::extract_predictive_samples(rawfit), + # qc can only draw predictives from an integration fit when the prior is conjugate; + # for any other prior refit with mcmc so the plot can still be shown + error = function(e) { + mcmcfit <- qc::bpc( + x = if (ncol(dataset) > 0L) dataset[[1L]] else NULL, + method = "mcmc", + distribution = rawfit$distribution %||% "normal", + prior = rawfit$prior, + LSL = options[["lowerSpecificationLimitValue"]], + USL = options[["upperSpecificationLimitValue"]], + target = options[["targetValue"]], + chains = options[["noChains"]], + warmup = options[["noWarmup"]], + iter = options[["noIterations"]], + silent = TRUE, seed = 1, + sample_priors = isPrior + ) + qc::extract_predictive_samples(mcmcfit) + } + ) + + plt <- jaspGraphs::jaspHistogram( + predictiveSamples, + xName = if (isPrior) gettext("Prior predictive") else gettext("Posterior predictive"), + density = TRUE + ) + + # Calculate density for positioning elements above histogram + dens <- stats::density(predictiveSamples) + maxDensity <- max(dens$y) + + # Add point estimate if requested + if (options[[paste0(base, "IndividualPointEstimate")]]) { + pointEstimateType <- options[[paste0(base, "IndividualPointEstimateType")]] + pointEstimate <- switch(pointEstimateType, + "mean" = mean(predictiveSamples), + "median" = stats::median(predictiveSamples), + "mode" = dens$x[which.max(dens$y)] + ) + plt <- plt + ggplot2::geom_point( + data = data.frame(x = pointEstimate, y = 0), + ggplot2::aes(x = .data$x, y = .data$y), + size = 3, + inherit.aes = FALSE + ) + } + + # Add CI if requested + if (options[[paste0(base, "IndividualCi")]]) { + ciType <- options[[paste0(base, "IndividualCiType")]] + + ciInterval <- if (ciType == "custom") { + c(options[[paste0(base, "IndividualCiLower")]], + options[[paste0(base, "IndividualCiUpper")]]) + } else { + ciMass <- options[[paste0(base, "IndividualCiMass")]] / 100 + if (ciType == "central") { + stats::quantile(predictiveSamples, probs = c((1 - ciMass) / 2, (1 + ciMass) / 2)) + } else if (ciType == "HPD") { + # For HPD, we need HDInterval package or implement it + if (requireNamespace("HDInterval", quietly = TRUE)) { + HDInterval::hdi(predictiveSamples, credMass = ciMass) + } else { + # Fallback to central interval + stats::quantile(predictiveSamples, probs = c((1 - ciMass) / 2, (1 + ciMass) / 2)) + } + } + } + + # Position errorbar above the histogram + yPosition <- maxDensity * 1.1 + plt <- plt + ggplot2::geom_errorbarh( + data = data.frame(x = mean(ciInterval), xmin = ciInterval[1], xmax = ciInterval[2], y = yPosition), + ggplot2::aes(x = .data$x, xmin = .data$xmin, xmax = .data$xmax, y = .data$y), + height = maxDensity * 0.05, + linewidth = 0.75, + inherit.aes = FALSE + ) + } + + plot$plotObject <- plt + }, error = function(e) { + plot$setError( + if (isPrior) gettextf("Unexpected error in prior predictive distribution plot: %s", e$message) + else gettextf("Unexpected error in posterior predictive distribution plot: %s", e$message) + ) + }) +} diff --git a/R/interface.R b/R/interface.R deleted file mode 100644 index 99d5240..0000000 --- a/R/interface.R +++ /dev/null @@ -1,47 +0,0 @@ -interfaceExample <- function(jaspResults, dataset, options) { - # Just show the options as they are understood the R backend - jaspResults[["explanation"]] <- createJaspHtml(title = "User inputs, returned as html", - text = sprintf("Here we show, for pedagogical purposes, the user inputs as they are understood by the R backend.")) - - jaspResults[["logicals"]] <- createJaspHtml( - title = "Logical controls", - text = sprintf("The tick mark is set to: %s - The radio buttons are set to: %s", - as.character(options$my_tick_mark), # These variables are defined in .inst/qml/Interface.qml - as.character(options$radio_buttons)) # Notice we have to be careful with the data type - ) - - jaspResults[["others"]] <- createJaspHtml( - title = "Other controls", - text = sprintf("The chosen dropdown element is: %s - The slider value is: %s", - as.character(options$my_dropdown), - as.character(options$my_slider)) - ) - - jaspResults[["keyboard"]] <- createJaspHtml( - title = "Keyboard controls", - text = sprintf("The integer is set to: %s - The double is set to: %s - The percentage is set to: %s - The confidence interval is set to: %s - The text box is set to: %s", - as.character(options$my_integer), - as.character(options$my_double), - as.character(options$my_percent), - as.character(options$my_ci), - options$my_text) # No data-type conversion needed for text - ) - - jaspResults[["developers"]] <- createJaspHtml( - title = "Note for developers", - text = sprintf("Potential developers will find it useful to inspect the following files: - ") - ) - - return() -} diff --git a/R/loadingData.R b/R/loadingData.R deleted file mode 100644 index 3427eda..0000000 --- a/R/loadingData.R +++ /dev/null @@ -1,30 +0,0 @@ -processTable <- function(jaspResults, dataset, options) { - - # Auxiliary function. - # Returns TRUE if and only if an option has been assigned in the GUI - .isAssigned <- function(option) { - not_assigned <- as.character(option) == "" - return(!not_assigned) - } - - # Only if everything has been assigned ... - if(.isAssigned(options$ts) && .isAssigned(options$xs)) { - # ... print the inputs as a table - stats <- createJaspTable(gettext("Some descriptives")) - stats$dependOn(c("ts", "xs")) # Declare dependencies to make the object disappear / reappear when needed - - stats$addColumnInfo(name = gettext("times")) - stats$addColumnInfo(name = gettext("xs")) - - stats[["times"]] <- dataset[[options$ts]] - stats[["xs"]] <- dataset[[options$xs]] - - jaspResults[["stats"]] <- stats - } else { - expl <- createJaspHtml(text = "Select times and positions") - expl$dependOn(c("ts", "xs")) # Declare dependencies to make the object disappear / reappear when needed - - jaspResults[["Explanation"]] <- expl - } - -} diff --git a/R/parabola.R b/R/parabola.R deleted file mode 100644 index 3c6019a..0000000 --- a/R/parabola.R +++ /dev/null @@ -1,21 +0,0 @@ -parabola <- function(jaspResults, dataset, options) { - # Analysis - f <- function(x) { options$a * x^2 } # Function to be plotted - p <- ggplot2::ggplot() + # Plotting command - ggplot2::xlim(-3, 3) + - ggplot2::ylim(0, 10) + - ggplot2::geom_function(fun = f) - # add jasp theme - p <- p + jaspGraphs::geom_rangeframe() + - jaspGraphs::themeJaspRaw() - # Aesthetics - parabolaPlot <- createJaspPlot(title = gettext("Parabola"), - width = 160, - height = 320) - parabolaPlot$dependOn(c("a")) # Refresh view whenever a changes - parabolaPlot$info <- gettext("This figure displays a parabola specified via the `a` option.") - jaspResults[["parabolaPlot"]] <- parabolaPlot - parabolaPlot$plotObject <- p - - return() -} diff --git a/inst/Description.qml b/inst/Description.qml index a86a4b7..af7bf6b 100644 --- a/inst/Description.qml +++ b/inst/Description.qml @@ -3,64 +3,28 @@ import JASP.Module Description { - name : "jaspModuleTemplate" - title : qsTr("Jasp Module") - description : qsTr("Examples for module builders") - version : "0.1" + name : "jaspBayesianQualityControl" + title : qsTr("Bayesian Quality Control") + description : qsTr("Bayesian analyses for investigating whether a manufactured product adheres to a defined set of quality criteria") + version : "0.1.0" author : "JASP Team" - maintainer : "JASP Team " - website : "https://jasp-stats.org" + maintainer : "JASP " + website : "https://github.com/jasp-stats/jaspBayesianQualityControl" license : "GPL (>= 2)" - icon : "exampleIcon.png" // Located in /inst/icons/ - preloadData: true - requiresData: true + icon : "qualityControl-module.svg" + hasWrappers : false + preloadData : false GroupTitle { - title: qsTr("Basic interactivity") + title: qsTr("Capability Analysis") + icon: "qualityControl-capability.svg" } Analysis { - title: qsTr("Using the interface") // Title for window - menu: qsTr("Using the interface") // Title for ribbon - func: "interfaceExample" // Function to be called - qml: "Interface.qml" // Design input window - requiresData: false // Allow to run even without data - } - - Analysis - { - title: qsTr("Loading data") - menu: qsTr("Loading data") - func: "processTable" - qml: "LoadingData.qml" - } - - GroupTitle - { - title: qsTr("Basic functions") - } - - Analysis - { - title: qsTr("Add one") // Title for window - menu: qsTr("Add one") // Title for ribbon - func: "addOne" // Function to be called - qml: "AddOne.qml" // Design input window - requiresData: false // Allow to run even without data - } - - GroupTitle - { - title: qsTr("Plotting") - } - - Analysis - { - title: qsTr("Plot a parabola") - func: "parabola" - qml: "Parabola.qml" - requiresData: false + title: qsTr("Bayesian Process Capability Study") + func: "bayesianProcessCapabilityStudies" + preloadData: true } } diff --git a/inst/icons/exampleIcon.png b/inst/icons/exampleIcon.png deleted file mode 100644 index 09c807f..0000000 Binary files a/inst/icons/exampleIcon.png and /dev/null differ diff --git a/inst/icons/exampleIcon.svg b/inst/icons/exampleIcon.svg deleted file mode 100644 index 1399625..0000000 --- a/inst/icons/exampleIcon.svg +++ /dev/null @@ -1,83 +0,0 @@ - - - - - - - - - - - - - - - -ABC diff --git a/inst/icons/qualityControl-capability.svg b/inst/icons/qualityControl-capability.svg new file mode 100644 index 0000000..1ccbbc3 --- /dev/null +++ b/inst/icons/qualityControl-capability.svg @@ -0,0 +1,95 @@ + + + +image/svg+xml + + + + + + + + + + \ No newline at end of file diff --git a/inst/icons/qualityControl-module.svg b/inst/icons/qualityControl-module.svg new file mode 100644 index 0000000..d649433 --- /dev/null +++ b/inst/icons/qualityControl-module.svg @@ -0,0 +1,110 @@ + + + +image/svg+xml + + + + + + + + + + \ No newline at end of file diff --git a/inst/qml/AddOne.qml b/inst/qml/AddOne.qml deleted file mode 100644 index 8566f84..0000000 --- a/inst/qml/AddOne.qml +++ /dev/null @@ -1,60 +0,0 @@ -// -// Copyright (C) 2013-2018 University of Amsterdam -// -// This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU Affero General Public License as -// published by the Free Software Foundation, either version 3 of the -// License, or (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU Affero General Public License for more details. -// -// You should have received a copy of the GNU Affero General Public -// License along with this program. If not, see -// . -// -import QtQuick -import QtQuick.Layouts -import JASP.Controls -import JASP.Widgets -import JASP - -Form -{ - - info: qsTr("This analysis just adds one to the input. \ - It's purpose is to show an easy example of how a manual input gets processed \ - by the backend, and returned. - \\ - \\ - From the technical point of view, the most challenging part of JASP module \ - development is the communication between the QML interface and the R backend. - \\ - \\ - Playing with the current JASP analysis while simultaneously inspecting the R \ - code in the files `./inst/qml/AddOne.qml` and `./R/examples.R` is a good \ - way to learn how this communication works. - ") - - Text - { - text: qsTr("This example shows how to manually introduce an input and perform a simple operation on it") - } - - IntegerField - { - info: qsTr("This is the number that will be used in the operation") - - name: "my_number" // This will map to options$my_number in R - label: qsTr("Type a number") // qsTr allows for future translations - - // We can add some extra control parameters - min: 1 - defaultValue: 10 - fieldWidth: 50 - max: 1000 - } - -} diff --git a/inst/qml/Interface.qml b/inst/qml/Interface.qml deleted file mode 100644 index da8154c..0000000 --- a/inst/qml/Interface.qml +++ /dev/null @@ -1,188 +0,0 @@ -// -// Copyright (C) 2013-2018 University of Amsterdam -// -// This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU Affero General Public License as -// published by the Free Software Foundation, either version 3 of the -// License, or (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU Affero General Public License for more details. -// -// You should have received a copy of the GNU Affero General Public -// License along with this program. If not, see -// . -// -import QtQuick -import QtQuick.Layouts -import JASP.Controls -import JASP.Widgets -import JASP - -Form -{ - - info: qsTr("This analysis shows you different interface elements of JASP, such as tick marks, text boxes, ... \\ - Its purpose is pedagogical, and its target audience is that of JASP module developers. \\ - \\ - From the technical point of view, the most challenging part of JASP module development is the communication between the QML interface and the R backend. \\ - Playing with the current JASP analysis while simultaneously inspecting the R code in the files `./inst/qml/Interface.qml` and `./R/examples.R` is a good way to learn how this communication works. \\ - \\ - The source code is available at [github.com/jasp-stats/jaspModuleTemplate](https://github.com/jasp-stats/jaspModuleTemplate)") - - Text - { - text: qsTr("This analysis shows you different interface elements of JASP") - // The qsTr wrapper allows for future translations. As a rule of thumb, you should always use qsTr for any text that will be displayed to the user. - } - - Group - { - title: qsTr("Logical controls") - - CheckBox - { - info: qsTr("This is a tick mark that can be used to control the flow of the analysis") - - name: "my_tick_mark" - label: qsTr("Tick mark") - - // We can add some extra control parameters - checked: false // Default value - } - - RadioButtonGroup - { - name: "radio_buttons" - title: qsTr("Radio buttons") - - RadioButton { value: "one value"; label: qsTr("One"); checked: true } // Single-line definition is also possible - RadioButton { value: "another value"; label: qsTr("Another") } - } - } - - Group - { - title: qsTr("Other controls") - - DropDown - { - info: qsTr("This is a dropdown that can be used to select one of a list of options") - - name: "my_dropdown" - label: qsTr("Select an option") - - // We can add some extra control parameters - values: ["option 1", "option 2", "option 3"] - } - - Slider - { - - info: qsTr("This is a slider that can be used to select a value in a range") - - name: "my_slider" - label: qsTr("Select a value") - - // We can add some extra control parameters - min: 0 - max: 1 - value: 0.5 - decimals: 3 - vertical: false - } - } - - Group - { - title: qsTr("Keyboard inputs") - - IntegerField - { - info: qsTr("This is the number that will be used in the operation") - - name: "my_integer" // This will map to options$my_integer in R - label: qsTr("Input an integer") // qsTr allows for future translations - - // We can add some extra control parameters - min: 1 - defaultValue: 10 - fieldWidth: 50 - max: 1000 - } - - DoubleField - { - info: qsTr("This is the number that will be used in the operation") - - name: "my_double" - label: qsTr("Input a number with decimals") - - // We can add some extra control parameters - defaultValue: 3.14 - fieldWidth: 50 - max: 5 - decimals: 2 - } - - PercentField - { - info: qsTr("This is the number that will be used in the operation") - - name: "my_percent" - label: qsTr("Input a percentage") - } - - CIField - { - info: qsTr("This is the number that will be used in the operation") - - name: "my_ci" - label: qsTr("Input a confidence interval") - } - - TextField - { - info: qsTr("This is a text field that can be used to input any text") - - name: "my_text" - label: qsTr("Input some text") - - // We can add some extra control parameters - fieldWidth: 200 - defaultValue: qsTr("Hello world!") - } - } - - Section - { - title: qsTr("Advanced controls") - - - Group - { - title: qsTr("Subordinate menus") - - CheckBox - { - - name: "my_advanced_tick_mark" - label: qsTr("Activate advanced options?") - - // We can add some extra control parameters - checked: false // Default value - - // The tic mark below is only available if the above tick mark is checked - CheckBox - { - name: "my_subordinate_tick_mark" - label: qsTr("Subordinate tick mark") - checked: false // Default value - } - } - } - } - -} diff --git a/inst/qml/LoadingData.qml b/inst/qml/LoadingData.qml deleted file mode 100644 index c61caf0..0000000 --- a/inst/qml/LoadingData.qml +++ /dev/null @@ -1,113 +0,0 @@ -// -// Copyright (C) 2013-2018 University of Amsterdam -// -// This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU Affero General Public License as -// published by the Free Software Foundation, either version 3 of the -// License, or (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU Affero General Public License for more details. -// -// You should have received a copy of the GNU Affero General Public -// License along with this program. If not, see -// . -// -import QtQuick -import QtQuick.Layouts -import JASP.Controls -import JASP.Widgets -import JASP - -Form -{ - info: qsTr("This example shows how to load a dataset and output it as a table") - - Text - { - text: "This example shows how to load a dataset and output it as a table" - } - - VariablesForm - { - AvailableVariablesList { name: "allVariables" } - - AssignedVariablesList { - name: "ts" - label: qsTr("Times (t)") - info: qsTr("This info entry adds documentation to the (i) icon in the analysis file. E.g., Specify variable containing the time.") - singleVariable: true - allowedColumns: ["scale"] - } - - AssignedVariablesList { - name: "xs" - label: qsTr("Positions (x)") - info: qsTr("This info entry adds documentation to the (i) icon in the analysis file. E.g., Specify variable containing the positions.") - singleVariable: true - allowedColumns: ["scale"] - } - } - - Section - { - title : qsTr("Advanced") - columns: 1 - - Text { text: qsTr("This example shows how to get the factors of a variable") } - - DropDown - { - id : nominalOrOrdinalVariables - name : "nominalOrOrdinalVariables" - label : "Nominal or Ordinal variable" - addEmptyValue : true - placeholderText : qsTr("Select one variable") - source : [{isDataSetVariables: true, use: "type=nominal|ordinal" } ] - info : qsTr("Only nominal or ordinal variable are available. Choose one of them.") - } - - Text - { - text : qsTr("Warning: No nominal or ordinal variable in your dataset.
Either change a variable type from scale to nominal (or ordinal), or load another dataset") - visible : nominalOrOrdinalVariables.count === 1 // Empty value is already 1 element. - } - - Group - { - visible : nominalOrOrdinalVariables.value !== "" - - ComponentsList - { - id : valuePerLevel - title : "Set value for each factor" - name : "values" - source : nominalOrOrdinalVariables.value !== "" ? [{values: [nominalOrOrdinalVariables.value], use: "levels" }] : [] - headerLabels : [qsTr("Check"), qsTr("Value")] - - rowComponent: RowLayout - { - Text { text: rowValue ; Layout.preferredWidth: 100 * jaspTheme.uiScale } - CheckBox { name: "check" ; Layout.preferredWidth: 100 * jaspTheme.uiScale } - DoubleField { name: "double" } - } - } - - Text - { - text : qsTr("The factors checked in the list above will be present in the dropdown below") - } - - DropDown - { - label : "Checked factors" - name : "checkedFactor" - source : [{ name: "values", condition: "check"}] - addEmptyValue : true - } - } - } - -} diff --git a/inst/qml/Parabola.qml b/inst/qml/Parabola.qml deleted file mode 100644 index 416138c..0000000 --- a/inst/qml/Parabola.qml +++ /dev/null @@ -1,47 +0,0 @@ -// -// Copyright (C) 2013-2018 University of Amsterdam -// -// This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU Affero General Public License as -// published by the Free Software Foundation, either version 3 of the -// License, or (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU Affero General Public License for more details. -// -// You should have received a copy of the GNU Affero General Public -// License along with this program. If not, see -// . -// -import QtQuick -import QtQuick.Layouts -import JASP.Controls -import JASP.Widgets -import JASP - -Form -{ - info: qsTr("This example shows how to plot a curve.") - - Text - { - text: qsTr("This example shows how to plot a curve") - } - - IntegerField - { - info: qsTr("The shape of the parabola is dynamically determined by this number") - - name: "a" // This will map to options$a in R - label: qsTr("Type a number") // qsTr allows for future translations - - // We can add some extra control parameters - min: -10 - defaultValue: 1 - fieldWidth: 50 - max: 10 - } - -} diff --git a/inst/qml/bayesianProcessCapabilityStudies.qml b/inst/qml/bayesianProcessCapabilityStudies.qml new file mode 100644 index 0000000..8bfa4f9 --- /dev/null +++ b/inst/qml/bayesianProcessCapabilityStudies.qml @@ -0,0 +1,463 @@ +// Copyright (C) 2013-2018 University of Amsterdam +// This program is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU Affero General Public License for more details. +// You should have received a copy of the GNU Affero General Public +// License along with this program. If not, see +// . +// + +import QtQuick +import QtQuick.Layouts +import JASP.Controls + +import "./common" as Common + +Form +{ + function sortIntervalValues() { + + var values = [ + interval1.displayValue, + interval2.displayValue, + interval3.displayValue, + interval4.displayValue + ] + values.sort(function(a, b) { return a - b }) + interval1.value = values[0] + interval2.value = values[1] + interval3.value = values[2] + interval4.value = values[3] + interval1b.value = values[0] + interval2b.value = values[1] + interval3b.value = values[2] + interval4b.value = values[3] + } + function sortIntervalValuesb() { + + var values = [ + interval1b.displayValue, + interval2b.displayValue, + interval3b.displayValue, + interval4b.displayValue + ] + values.sort(function(a, b) { return a - b }) + interval1.value = values[0] + interval2.value = values[1] + interval3.value = values[2] + interval4.value = values[3] + interval1b.value = values[0] + interval2b.value = values[1] + interval3b.value = values[2] + interval4b.value = values[3] + } + columns: 2 + + VariablesForm + { + id: variablesFormLongFormat + + AvailableVariablesList + { + name: "variablesFormLongFormat" + } + + AssignedVariablesList + { + name: "measurementLongFormat" + title: qsTr("Measurement") + id: measurementLongFormat + allowedColumns: ["scale"] + singleVariable: true + } + + } + + + // Section + // { + // title: qsTr("Process capability options") + + Group + { + title: qsTr("Type of data distribution") + + + RadioButtonGroup + { + name: "capabilityStudyType" + id: capabilityStudyType + + RadioButton + { + name: "normalCapabilityAnalysis" + id : normalCapabilityAnalysis + label: qsTr("Normal distribution") + checked: true + } + + RadioButton + { + name: "tCapabilityAnalysis" + id : tCapabilityAnalysis + label: qsTr("Student's t-distribution") + // checked: true + } + + } + } + + Group + { + columns: 2 + title: qsTr("Metrics") + info: qsTr("Select the process capability metrics to report.") + CheckBox { name: "Cp"; label: qsTr("Cp"); checked: true } + CheckBox { name: "Cpu"; label: qsTr("Cpu"); checked: true } + CheckBox { name: "Cpl"; label: qsTr("Cpl"); checked: true } + CheckBox { name: "Cpk"; label: qsTr("Cpk"); checked: true } + CheckBox { name: "Cpc"; label: qsTr("Cpc"); checked: true } + CheckBox { name: "Cpm"; label: qsTr("Cpm"); checked: true } + } + + Group + { + title: qsTr("Capability Study") + + CheckBox + { + name: "lowerSpecificationLimit" + label: qsTr("Lower specification limit") + id: lowerSpecificationLimit + childrenOnSameRow: true + + DoubleField + { + name: "lowerSpecificationLimitValue" + id: lowerSpecificationLimitValue + negativeValues: true + defaultValue: -1 + decimals: 9 + } + + } + + CheckBox + { + name: "target" + label: qsTr("Target value") + id: target + childrenOnSameRow: true + + DoubleField + { + name: "targetValue" + id: targetValue + negativeValues: true + defaultValue: 0 + decimals: 9 + } + } + + CheckBox + { + name: "upperSpecificationLimit" + label: qsTr("Upper specification limit") + id: upperSpecificationLimit + childrenOnSameRow: true + + DoubleField + { + name: "upperSpecificationLimitValue" + id: upperSpecificationLimitValue + negativeValues: true + defaultValue: 1 + decimals: 9 + } + + } + + } + + Group + { + + title: qsTr("Process Criteria") + GridLayout + { + // title: qsTr("Process Criteria") + columns: 5 + columnSpacing: 2 + rowSpacing: jaspTheme.rowGridSpacing / 3 + id: intervalRow + property int dbWidth: 50 + property int txtWidth: 100 + + // Row 0: Headers + Label {text: qsTr("Left bound")} + Item{} + Label {text: qsTr("Classification")} + Item{} + Label {text: qsTr("Right bound")} + + // Row 1: Incapable + Item{} + Item{} + TextField { name: "intervalLabel1"; defaultValue: qsTr("Incapable"); fieldWidth: intervalRow.txtWidth} + Label { text: "<"; } + DoubleField { name: "interval1"; id: interval1; fieldWidth: intervalRow.dbWidth; defaultValue: 1.00; onEditingFinished: sortIntervalValues() } + + // Row 2: Capable + DoubleField { name: "interval1b";id: interval1b; fieldWidth: intervalRow.dbWidth; editable: true; value: interval1.value; onEditingFinished: {sortIntervalValuesb()} } + Label { text: "<"; } + TextField { name: "intervalLabel2"; defaultValue: qsTr("Capable"); fieldWidth: intervalRow.txtWidth} + Label { text: "≤"; } + DoubleField { name: "interval2"; id: interval2; fieldWidth: intervalRow.dbWidth; defaultValue: 1.33; onEditingFinished: sortIntervalValues() } + + // Row 3: Satisfactory + DoubleField { name: "interval2b"; id: interval2b; fieldWidth: intervalRow.dbWidth; editable: true; value: interval2.value; onEditingFinished: {sortIntervalValuesb()} } + Label { text: "<"; } + TextField { name: "intervalLabel3"; defaultValue: qsTr("Satisfactory"); fieldWidth: intervalRow.txtWidth} + Label { text: "≤"; } + DoubleField { name: "interval3"; id: interval3; fieldWidth: intervalRow.dbWidth; defaultValue: 1.50; onEditingFinished: sortIntervalValues() } + + // Row 4: Excellent + DoubleField { name: "interval3b"; id: interval3b; fieldWidth: intervalRow.dbWidth; editable: true; value: interval3.value; onEditingFinished: {sortIntervalValuesb()} } + Label { text: "<"; } + TextField { name: "intervalLabel4"; defaultValue: qsTr("Excellent"); fieldWidth: intervalRow.txtWidth} + Label { text: "≤"; } + DoubleField { name: "interval4"; id: interval4; fieldWidth: intervalRow.dbWidth; defaultValue: 2.00; onEditingFinished: sortIntervalValues() } + + // Row 5: Super + DoubleField { name: "interval4b"; id: interval4b; fieldWidth: intervalRow.dbWidth; editable: true; value: interval4.value; onEditingFinished: {sortIntervalValuesb()} } + Label { text: ">"; } + TextField { name: "intervalLabel5"; defaultValue: qsTr("Super"); fieldWidth: intervalRow.txtWidth} + Item{} + Item{} + } + } + + // } + + // Section + // { + // title: qsTr("Prior distributions") + + // } + + Section + { + title: qsTr("Tables") + CheckBox + { + name: "intervalTable" + label: qsTr("Interval table") + info: qsTr("Show the posterior probabilities of the interval specified with the input on the right. Note that the input is automatically sorted and that the first and last fields are always negative and positive infinity.") + } + CIField + { + name: "credibleIntervalWidth" + label: qsTr("Credible interval") + info: qsTr("Width of the credible interval used for the posterior distribution in the Capability table.") + } + } + + Section + { + + title: qsTr("Prior and Posterior Inference") + + Common.PlotLayout {} + + Common.PlotLayout + { + baseName: "priorDistributionPlot" + baseLabel: qsTr("Prior distribution") + hasPrior: false + } + + } + + Section + { + title: qsTr("Sequential Analysis") + + Common.PlotLayout + { + id: sequentialAnalysisPointEstimatePlot + baseName: "sequentialAnalysisPointEstimatePlot" + baseLabel: qsTr("Point estimate plot") + hasPrior: false + } + + Common.PlotLayout + { + id: sequentialAnalysisIntervalEstimatePlot + baseName: "sequentialAnalysisPointIntervalPlot" + baseLabel: qsTr("Interval estimate plot") + hasPrior: false + hasEstimate: false + hasCi: false + hasType: true + } + + Group + { + CheckBox + { + enabled: sequentialAnalysisPointEstimatePlot.checked || sequentialAnalysisIntervalEstimatePlot.checked + id: sequentialAnalysisAdditionalInfo + name: "sequentialAnalysisPlotAdditionalInfo" + label: qsTr("Show process criteria") + checked: true + info: qsTr("Add a secondary right axis with condition bounds for the process") + } + + CheckBox + { + // TODO: + enabled: sequentialAnalysisPointEstimatePlot.checked || sequentialAnalysisIntervalEstimatePlot.checked + name: "sequentialAnalysisUpdatingTable" + label: qsTr("Posterior updating table") + checked: false + info: qsTr("Show the data from the sequential analysis in a table. Will show both the information for the point estimate and interval estimate plots, if both are selected.") + } + } + } + + Section + { + + title: qsTr("Prior and Posterior Predictive Plots") + + Common.PlotLayout + { + baseName: "posteriorPredictiveDistributionPlot" + baseLabel: qsTr("Posterior predictive distribution") + hasPrior: false + hasAxes: false + hasPanels: false + } + + Common.PlotLayout + { + baseName: "priorPredictiveDistributionPlot" + baseLabel: qsTr("Prior predictive distribution") + hasPrior: false + hasAxes: false + hasPanels: false + } + + } + + + Section + { + title: qsTr("Prior distributions") + + // TODO: this dropdown should just show the same GUI as the custom one + // but disable e.g., the DropDown itself and instead show the prior + // also disable all truncation for non-custom ones + // NOTE: the above is done, but default values cannot be set yet. + + DropDown + { + id: priorSettings + name: "priorSettings" + label: qsTr("Prior distributions") + values: + [ + {label: qsTr("Default"), value: "default"}, + {label: qsTr("Informed conjugate"), value: "conjugate"}, + // {label: qsTr("Informed conjugate"), value: "weaklyInformativeConjugate"}, + {label: qsTr("Informed uniform"), value: "weaklyInformativeUniform"}, + {label: qsTr("Custom informative"), value: "customInformative"}, + ] + } + + Common.Priors + { + + // visible: priorSettings.currentValue === "customInformative" + priorType: capabilityStudyType.value === "normalCapabilityAnalysis" ? "normalModel" : "tModel" + + hasTruncation: priorSettings.currentValue === "customInformative" + hasParameters: priorSettings.currentValue !== "default" + visible: priorSettings.currentValue !== "default" + + dropDownValuesMap: { + switch (priorSettings.currentValue) { + case "default": + return { + "mean": [{ label: qsTr("Jeffreys"), value: "jeffreys"}], + "sigma": [{ label: qsTr("Jeffreys"), value: "jeffreys"}], + "df": [{ label: qsTr("Gamma(α,β)"), value: "gammaAB" }] + } + case "conjugate": + return { + "mean": [{ label: qsTr("Normal(μ,σ)"), value: "normal"}], + "sigma": [{ label: qsTr("Gamma(α,β)"), value: "gammaAB" }], + "df": [{ label: qsTr("Gamma(α,β)"), value: "gammaAB" }] + }; + // case "weaklyInformativeConjugate": + // return { + // "mean": [{ label: qsTr("Normal(μ,σ)"), value: "normal"}], + // "sigma": [{ label: qsTr("Gamma(α,β)"), value: "gammaAB" }], + // "df": [{ label: qsTr("Gamma(α,β)"), value: "gammaAB" }] + // } + case "weaklyInformativeUniform": + return { + "mean": [{ label: qsTr("Uniform(a,b)"), value: "uniform"}], + "sigma": [{ label: qsTr("Uniform(a,b)"), value: "uniform"}], + "df": [{ label: qsTr("Gamma(α,β)"), value: "gammaAB" }] + } + case "customInformative": + return undefined; + } + } + } + } + + Section + { + title: qsTr("Advanced options") + + Group + { + title: qsTr("MCMC Settings") + info: qsTr("Adjust the Markov Chain Monte Carlo (MCMC) settings for estimating the posterior distribution.") + IntegerField + { + name: "noIterations" + label: qsTr("No. iterations") + defaultValue: 5000 + min: 100 + max: 100000000 + info: qsTr("Number of MCMC iterations used for estimating the posterior distribution.") + } + IntegerField + { + name: "noWarmup" + label: qsTr("No. warmup samples") + defaultValue: 1000 + min: 0 + max: 100000000 + info: qsTr("Number of initial MCMC samples to discard.") + } + IntegerField + { + name: "noChains" + label: qsTr("No. chains") + defaultValue: 1 + min: 1 + max: 128 + info: qsTr("Number of MCMC chains to run.") + } + } + } +} diff --git a/inst/qml/common/PlotLayout.qml b/inst/qml/common/PlotLayout.qml new file mode 100644 index 0000000..abc3957 --- /dev/null +++ b/inst/qml/common/PlotLayout.qml @@ -0,0 +1,266 @@ +// +// Copyright (C) 2013-2018 University of Amsterdam +// +// This program is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public +// License along with this program. If not, see +// . +// +import QtQuick +import QtQuick.Layouts +import JASP +import JASP.Controls + + +Group +{ + id: root + property string baseName: "posteriorDistributionPlot" + property string baseLabel: qsTr("Posterior distribution") + property bool hasPrior: true + property bool hasEstimate: true + property bool hasCi: true + property bool hasType: false + property bool hasAxes: true + property bool hasPanels: true + + readonly property alias checked: mainCheckBox.checked + + CheckBox + { + id: mainCheckBox + name: baseName + label: baseLabel + + // Group so the options are shown in a 2-column layout + Group + { + + columns: 2 + columnSpacing: 10 * jaspTheme.columnGroupSpacing + + // Group so point estimate and CI options are shown in a single column + Group + { + enabled: hasEstimate || hasCi + visible: hasEstimate || hasCi + + CheckBox + { + enabled: hasEstimate + visible: hasEstimate + label: qsTr("Point estimate") + name: baseName + "IndividualPointEstimate" + childrenOnSameRow: true + + DropDown + { + name: baseName + "IndividualPointEstimateType" + label: "" + values: [ + {label: qsTr("mean"), value: "mean"}, + {label: qsTr("median"), value: "median"}, + {label: qsTr("mode"), value: "mode"} + ] + } + } + + // Group so CI checkbox and options are shown in a single column (with subgroup so CI options are indented) + Group + { + enabled: hasCi + visible: hasCi + + columns: 1 + CheckBox + { + name: baseName + "IndividualCi" + label: qsTr("CI") + id: posteriorPlotIndividualCI + childrenOnSameRow: true + + DropDown + { + name: baseName + "IndividualCiType" + label: "" + id: posteriorPlotIndividualType + values: [ + {label: qsTr("central"), value: "central"}, + {label: qsTr("HPD"), value: "HPD"}, + {label: qsTr("custom"), value: "custom"}//, + // {label: qsTr("support"), value: "support"} + ] + } + } + + Group + { + columns: 2 + indent: true + enabled: posteriorPlotIndividualCI.checked + + CIField + { + visible: posteriorPlotIndividualType.currentValue === "central" || posteriorPlotIndividualType.currentValue === "HPD" + name: baseName + "IndividualCiMass" + label: qsTr("Mass") + fieldWidth: 50 + defaultValue: 95 + min: 1 + max: 100 + inclusive: JASP.MinMax + } + + DoubleField + { + visible: posteriorPlotIndividualType.currentValue === "custom" + name: baseName + "IndividualCiLower" + label: qsTr("Lower") + id: plotsPosteriorLower + fieldWidth: 50 + defaultValue: 0 + negativeValues: true + inclusive: JASP.MinMax + } + + DoubleField + { + visible: posteriorPlotIndividualType.currentValue === "custom" + name: baseName + "IndividualCiUpper" + label: qsTr("Upper") + id: plotsPosteriorUpper + fieldWidth: 50 + defaultValue: 1 + negativeValues: true + inclusive: JASP.MinMax + } + + FormulaField + { + visible: posteriorPlotIndividualType.currentValue === "support" + name: baseName + "IndividualCiBf" + label: qsTr("BF") + fieldWidth: 50 + defaultValue: "1" + min: 0 + inclusive: JASP.None + } + } + } + } + + Group + { + enabled: hasType + visible: hasType + + title: qsTr("Type") + + columns: 2 + FormulaField + { + name: baseName + "TypeLower" + label: qsTr("Lower") + id: typeLower + fieldWidth: 50 + defaultValue: 0.0 + max: typeUpper.value + } + + FormulaField + { + name: baseName + "TypeUpper" + label: qsTr("Upper") + id: typeUpper + fieldWidth: 50 + defaultValue: 1.0 + min: typeLower.value + + } + } + + RadioButtonGroup + { + enabled: hasPanels + visible: hasPanels + name: baseName + "PanelLayout" + title: qsTr("Layout") + id: posteriorDistributionPlotPanelLayout + + RadioButton { value: "multiplePanels"; label: qsTr("One plot per metric"); checked: true } + RadioButton { value: "singlePanel"; label: qsTr("All metrics in one plot") } + + } + + RadioButtonGroup + { + enabled: hasAxes + visible: hasAxes + name: baseName + "Axes" + title: qsTr("Axes") + id: posteriorDistributionPlotAxes + + RadioButton { value: "free"; label: qsTr("Automatic"); checked: true } + RadioButton { value: "fixed"; label: qsTr("Identical across panels"); enabled: posteriorDistributionPlotPanelLayout.value === "multiplePanels" } + RadioButton { value: "custom"; label: qsTr("Custom axes"); } + } + + Group + { + + title: qsTr("Custom axes") + enabled: hasAxes && posteriorDistributionPlotAxes.value === "custom" + visible: hasAxes && posteriorDistributionPlotAxes.value === "custom" + + GridLayout + { + columns: 5 + columnSpacing: 2 + rowSpacing: jaspTheme.rowGridSpacing / 3 + id: customAxesLayout + property int dbWidth: 50 + property int txtWidth: 100 + + // Row 0: Headers + Label {text: qsTr("Axis")} + Item{} + Label {text: qsTr("Min")} + Item{} + Label {text: qsTr("Max")} + + // Row 1: x axis + Label { text: qsTr("x axis"); } + Item{} + DoubleField { name: baseName + "custom_x_min"; id: custom_x_min; fieldWidth: customAxesLayout.dbWidth; defaultValue: 0.00; negativeValues: true; max: custom_x_max.value} + Item{} + DoubleField { name: baseName + "custom_x_max"; id: custom_x_max; fieldWidth: customAxesLayout.dbWidth; defaultValue: 1.00; negativeValues: true; min: custom_x_min.value} + + // Row 2: y axis + Label { text: qsTr("y axis"); } + Item{} + DoubleField { name: baseName + "custom_y_min"; id: custom_y_min; fieldWidth: customAxesLayout.dbWidth; defaultValue: 0.00; negativeValues: false; max: custom_y_max.value} + Item{} + DoubleField { name: baseName + "custom_y_max"; id: custom_y_max; fieldWidth: customAxesLayout.dbWidth; defaultValue: 1.00; negativeValues: false; min: custom_y_min.value} + } + } + + CheckBox + { + enabled: hasPrior + visible: hasPrior + name: baseName + "PriorDistribution" + label: qsTr("Show prior distribution") + checked: false + } + } + } +} \ No newline at end of file diff --git a/inst/qml/common/Priors.qml b/inst/qml/common/Priors.qml new file mode 100644 index 0000000..1693e73 --- /dev/null +++ b/inst/qml/common/Priors.qml @@ -0,0 +1,352 @@ +// +// Copyright (C) 2013-2018 University of Amsterdam +// +// This program is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public +// License along with this program. If not, see +// . +// +import QtQuick +import QtQuick.Layouts +import JASP.Controls +import JASP + +ColumnLayout +{ + spacing: 0 + property string priorType: "normalModel" + property bool hasTruncation: false + property bool hasParameters: true + + Component.onCompleted: { + console.log("Component completed, priorType: " + priorType); + console.log("Current component values: " + JSON.stringify(currentComponentValues)); + } + + onPriorTypeChanged: { + // this is not shown? + console.log("Prior type changed to: " + priorType); + } + + // TODO: these should not be fixed, no? + // property var meanValues: { "name": "mean", "type": "normal", "mu": "0", "sigma": "1" } + // property var sigmaValues: { "name": "sigma", "type": "invgamma", "alpha": "1", "beta": "0.15", "truncationLower": 0 } + // property var dfValues: { "name": "t", "type": "invgamma", "alpha": "1", "beta": "0.15", "truncationLower": 0, "hasJeffreys": false } + + property var nameMap: { + "mean": "Mean", + "sigma": "Sigma", + "df": "df" + } + property var defaultDistributionMap: { + "mean": "normal", + "sigma": "invgamma", + "df": "invgamma" + } + property var truncationLowerMap: { + "mean": -Infinity, + "sigma": 0, + "df": 0 + } + property var allPriors : [ + { label: qsTr("Normal(μ,σ)"), value: "normal"}, + { label: qsTr("Student-t(μ,σ,v)"), value: "t"}, + { label: qsTr("Cauchy(x₀,θ)"), value: "cauchy"}, + { label: qsTr("Jeffreys"), value: "jeffreys"}, + { label: qsTr("Gamma(α,β)"), value: "gammaAB"}, + { label: qsTr("Gamma(k,θ)"), value: "gammaK0"}, + { label: qsTr("Inverse-Gamma(α,β)"), value: "invgamma"}, + { label: qsTr("Log-Normal(μ,σ)"), value: "lognormal"}, + { label: qsTr("Beta(α,β)"), value: "beta"}, + { label: qsTr("Uniform(a,b)"), value: "uniform"} + ] + property var priorTruncationMap: { + "normal" : [-Infinity, Infinity], + "t" : [-Infinity, Infinity], + "cauchy" : [-Infinity, Infinity], + "jeffreys": [-Infinity, Infinity], + "gammaAB": [0, Infinity], + "gammaK0": [0, Infinity], + "invgamma": [0, Infinity], + "lognormal": [0, Infinity], + "beta": [0, 1 ], + "uniform": [-Infinity, Infinity] + } + property var defaultDropDownValuesMap: { + "mean": allPriors, + "sigma": allPriors, + "df": allPriors.filter(p => p.value !== "jeffreys") + } + property var dropDownValuesMap: undefined + property var activeDropDownValuesMap: dropDownValuesMap !== undefined ? dropDownValuesMap : defaultDropDownValuesMap + property var hasJeffreysMap: { + "mean": true, + "sigma": true, + "df": false + } + + onDropDownValuesMapChanged: console.log("dropDownValuesMap changed: " + dropDownValuesMap) + // property var defaultParametersMap: { + // "mean": { "mu": "0", "sigma": "1" }, + // "sigma": { "alpha": "1", "beta": "0.15", "truncationLower": 0 }, + // "t": { "alpha": "1", "beta": "0.15", "truncationLower": 0, "hasJeffreys": false } + // } + + property var currentComponentValues: { + switch (priorType) { + case "normalModel": + return [ "mean", "sigma" ]; + case "tModel": + return [ "mean", "sigma", "df" ]; + } + // switch (priorType) { + // case "normalModel": + // return [ meanValues, sigmaValues ]; + // case "tModel": + // return [ meanValues, sigmaValues, dfValues ]; + // } + } + + + // TODO: this could also be a gridLayout, no? + property double width1: 70 * preferencesModel.uiScale; + property double width2: 140 * preferencesModel.uiScale; + property double width3: 155 * preferencesModel.uiScale; + property double width4: 130 * preferencesModel.uiScale; + + RowLayout + { + Label { text: qsTr("Parameter"); Layout.preferredWidth: width1; Layout.leftMargin: 5 * preferencesModel.uiScale} + Label { text: qsTr("Distribution"); Layout.preferredWidth: width2; Layout.leftMargin: 5 * preferencesModel.uiScale} + Label { text: qsTr("Parameters"); Layout.preferredWidth: width3 ; visible: hasParameters } + Label { text: qsTr("Truncation"); Layout.preferredWidth: width4 ; visible: hasTruncation } + } + + + ComponentsList + { + name: priorType + "ComponentsList" + optionKey: "name" + + addItemManually: false + + // defaultValues: currentComponentValues + values: currentComponentValues + + rowComponent: RowLayout + { + Row + { + spacing: 4 * preferencesModel.uiScale + Layout.preferredWidth: width1 + Label { text: nameMap[rowValue] } + } + + Row + { + spacing: 4 * preferencesModel.uiScale + Layout.preferredWidth: width2 + + DropDown + { + visible: activeDropDownValuesMap[rowValue].length > 1 + id: typeItem + name: "type" + useExternalBorder: true + value: defaultDistributionMap[rowValue] + values: activeDropDownValuesMap[rowValue] + } + + Label + { + visible: activeDropDownValuesMap[rowValue].length === 1 + text: activeDropDownValuesMap[rowValue][0].label + } + } + + Row + { + spacing: 4 * preferencesModel.uiScale + Layout.preferredWidth: width3 + visible: hasParameters + + FormulaField + { + label: "μ" + name: "mu" + visible: typeItem.currentValue === "normal" || + typeItem.currentValue === "lognormal" || + typeItem.currentValue === "t" + value: "0" + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + + } + FormulaField + { + label: "x₀" + name: "x0" + visible: typeItem.currentValue === "cauchy" || + typeItem.currentValue === "spike" + value: "0" + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + FormulaField + { + label: "σ" + name: "sigma" + id: sigma + visible: typeItem.currentValue === "normal" || + typeItem.currentValue === "lognormal" || + typeItem.currentValue === "t" + value: "1" + min: 0 + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + FormulaField + { + label: "k " + name: "k" + visible: typeItem.currentValue === "gammaK0" + value: "1" + min: 0 + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + } + FormulaField + { + label: "θ" + name: "theta" + visible: typeItem.currentValue === "cauchy" || + typeItem.currentValue === "gammaK0" + value: "1" + min: 0 + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + FormulaField + { + label: "ν" + name: "nu" + visible: typeItem.currentValue === "t" + value: "2" + min: 1 + inclusive: JASP.MinOnly + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + FormulaField + { + label: "α " + name: "alpha" + visible: typeItem.currentValue === "gammaAB" || + typeItem.currentValue === "invgamma" || + typeItem.currentValue === "beta" + value: "1" + min: 0 + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + FormulaField + { + label: "β" + name: "beta" + visible: typeItem.currentValue === "gammaAB" || + typeItem.currentValue === "invgamma" || + typeItem.currentValue === "beta" + value: "0.15" + min: 0 + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + FormulaField + { + label: "a " + name: "a" + id: a + visible: typeItem.currentValue === "uniform" + value: "0" + max: b.value + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + FormulaField + { + label: "b" + name: "b" + id: b + visible: typeItem.currentValue === "uniform" + value: "1" + min: a.value + inclusive: JASP.None + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + } + + Row + { + spacing: 4 * preferencesModel.uiScale + Layout.preferredWidth: width4 + + FormulaField + { + id: truncationLower + label: qsTr("lower") + name: "truncationLower" + visible: hasTruncation && typeItem.currentValue !== "spike" && typeItem.currentValue !== "uniform" && typeItem.currentValue !== "jeffreys" + value: Math.max((priorTruncationMap[typeItem.currentValue] || [-Infinity, Infinity])[0], truncationLowerMap[rowValue]) + min: Math.max((priorTruncationMap[typeItem.currentValue] || [-Infinity, Infinity])[0], truncationLowerMap[rowValue]) + max: truncationUpper.value + inclusive: JASP.MinOnly + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + FormulaField + { + id: truncationUpper + label: qsTr("upper") + name: "truncationUpper" + visible: hasTruncation && typeItem.currentValue !== "spike" && typeItem.currentValue !== "uniform" && typeItem.currentValue !== "jeffreys" + value: (priorTruncationMap[typeItem.currentValue] || [-Infinity, Infinity])[1] + max: (priorTruncationMap[typeItem.currentValue] || [-Infinity, Infinity])[1] + min: truncationLower ? truncationLower.value : 0 + inclusive: JASP.MaxOnly + fieldWidth: 40 * preferencesModel.uiScale + useExternalBorder: false + showBorder: true + } + } + } + } + +} diff --git a/jaspModule.Rproj b/jaspBayesianQualityControl.Rproj similarity index 100% rename from jaspModule.Rproj rename to jaspBayesianQualityControl.Rproj diff --git a/renv.lock b/renv.lock index 17c464a..7bb95ef 100644 --- a/renv.lock +++ b/renv.lock @@ -1,7 +1,11 @@ { "R": { - "Version": "4.5.0", + "Version": "4.5.2", "Repositories": [ + { + "Name": "RSPM", + "URL": "https://packagemanager.posit.co/cran/2026-04-22" + }, { "Name": "CRAN", "URL": "https://cloud.r-project.org" @@ -9,24 +13,56 @@ ] }, "Packages": { - "MASS": { - "Package": "MASS", - "Version": "7.3-65", + "BH": { + "Package": "BH", + "Version": "1.90.0-1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "87905902999e70199a81869ef4ccaf82" + }, + "BayesTools": { + "Package": "BayesTools", + "Version": "0.3.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", - "grDevices", + "Rdpack", + "bridgesampling", + "coda", + "extraDistr", + "ggplot2", "graphics", - "methods", - "stats", - "utils" + "grid", + "mvtnorm", + "parallel", + "rlang", + "stats" ], - "Hash": "a41d0fc833ea756a1136b60a437efe26" + "Hash": "e68b5a1960e3f423701db43fc3115d6e" + }, + "Brobdingnag": { + "Package": "Brobdingnag", + "Version": "1.2-9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Matrix", + "R", + "methods" + ], + "Hash": "00077243042334c50b74cdfafe172870" + }, + "HDInterval": { + "Package": "HDInterval", + "Version": "0.2.4", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "b5b77433b286dd869ff33ee7fd5c545f" }, "Matrix": { "Package": "Matrix", - "Version": "1.7-3", + "Version": "1.7-4", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -39,7 +75,14 @@ "stats", "utils" ], - "Hash": "fb578c2b5d796882c60e9f770352f7c4" + "Hash": "7dbe8933065523bfc227027091bf2b1f" + }, + "QuickJSR": { + "Package": "QuickJSR", + "Version": "1.10.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "08b7b1ee36f1ad560fe72b1588a6f5d2" }, "R6": { "Package": "R6", @@ -63,14 +106,101 @@ }, "Rcpp": { "Package": "Rcpp", - "Version": "1.0.14", + "Version": "1.1.2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ + "R", "methods", "utils" ], - "Hash": "e7bdd9ee90e96921ca8a0f1972d66682" + "Hash": "f481f89daa906a34eab8ef8658c8a89c" + }, + "RcppArmadillo": { + "Package": "RcppArmadillo", + "Version": "15.4.2-1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "methods", + "stats", + "utils" + ], + "Hash": "f7694f9bd161314b273073279998a69b" + }, + "RcppEigen": { + "Package": "RcppEigen", + "Version": "0.3.4.0.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "stats", + "utils" + ], + "Hash": "4ac8e423216b8b70cb9653d1b3f71eb9" + }, + "RcppParallel": { + "Package": "RcppParallel", + "Version": "6.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "ae97343f2392836689f02881879ff787" + }, + "Rdpack": { + "Package": "Rdpack", + "Version": "2.6.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "rbibutils", + "tools", + "utils" + ], + "Hash": "9aafb16a721acbb1f793e7b9e26de471" + }, + "S7": { + "Package": "S7", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "6a72e94a8c9be4ef719af3aa3628f2dc" + }, + "StanHeaders": { + "Package": "StanHeaders", + "Version": "2.32.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "RcppEigen", + "RcppParallel" + ], + "Hash": "c35dc5b81d7ffb1018aa090dff364ecb" + }, + "abind": { + "Package": "abind", + "Version": "1.4-8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "utils" + ], + "Hash": "2288423bb0f20a457800d7fc47f6aa54" }, "askpass": { "Package": "askpass", @@ -82,59 +212,196 @@ ], "Hash": "c39f4155b3ceb1a9a2799d700fbd4b6a" }, + "backports": { + "Package": "backports", + "Version": "1.5.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "e3e65442a2749b59692220f368f46c46" + }, "base64enc": { "Package": "base64enc", - "Version": "0.1-3", + "Version": "0.1-6", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R" ], - "Hash": "543776ae6848fde2f48ff3816d0628bc" + "Hash": "5edb675b7baa6e9a0d86dd2c28de1676" + }, + "bridgesampling": { + "Package": "bridgesampling", + "Version": "1.2-1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Brobdingnag", + "Matrix", + "R", + "coda", + "methods", + "mvtnorm", + "parallel", + "scales", + "stringr", + "utils" + ], + "Hash": "da64ef771aeb8daeaed65ef1e5ea419a" + }, + "bslib": { + "Package": "bslib", + "Version": "0.12.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "cachem", + "fastmap", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "lifecycle", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "b2d0b0a17142ed4858f252d88eb56223" + }, + "cachem": { + "Package": "cachem", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "cd9a672193789068eb5a2aad65a0dedf" }, "callr": { "Package": "callr", - "Version": "3.7.6", + "Version": "3.8.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", "R6", + "otel", "processx", "utils" ], - "Hash": "d7e13f49c19103ece9e58ad2d83a7354" + "Hash": "cb2799e0a02c2ac4d0395b0e29bb6799" + }, + "checkmate": { + "Package": "checkmate", + "Version": "2.3.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "backports", + "utils" + ], + "Hash": "86cbe221fc19b56242f6c3eb0d4c5ab5" }, "cli": { "Package": "cli", - "Version": "3.6.5", + "Version": "3.6.6", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", "utils" ], - "Hash": "16850760556401a2eeb27d39bd11c9cb" + "Hash": "a73d822b669d443ff8de6928f9c49850" + }, + "coda": { + "Package": "coda", + "Version": "0.19-4.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "lattice" + ], + "Hash": "af436915c590afc6fffc3ce3a5be1569" }, "codetools": { "Package": "codetools", - "Version": "0.2-19", + "Version": "0.2-20", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R" ], - "Hash": "c089a619a7fae175d149d89164f8c7d8" + "Hash": "61e097f35917d342622f21cdc79c256e" + }, + "commonmark": { + "Package": "commonmark", + "Version": "2.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "8cba62334c1088d21689d353a7e87663" }, "cpp11": { "Package": "cpp11", - "Version": "0.5.2", + "Version": "0.5.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "20ecb9105a3fb48a8390919abc3b7e90" + }, + "crosstalk": { + "Package": "crosstalk", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "htmltools", + "jsonlite", + "lazyeval" + ], + "Hash": "8b008bc619e0bbebb5646b3d37efdad1" + }, + "cubature": { + "Package": "cubature", + "Version": "2.1.4-1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "Rcpp" + ], + "Hash": "59e1f90dd605a6258a7686686d08f732" + }, + "curl": { + "Package": "curl", + "Version": "7.1.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R" ], - "Hash": "2720e3fd3dad08f34b19b56b3d6f073d" + "Hash": "2e004ed19964915a8faf48a574439be9" + }, + "data.table": { + "Package": "data.table", + "Version": "1.18.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "da9ddede68a6f6e5d3098c0ab81b6e1f" }, "desc": { "Package": "desc", @@ -151,14 +418,77 @@ }, "digest": { "Package": "digest", - "Version": "0.6.37", + "Version": "0.6.39", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", "utils" ], - "Hash": "33698c4b3127fc9f506654607fb73676" + "Hash": "d18028e978a88b2b16ef8d400cb49adf" + }, + "distributional": { + "Package": "distributional", + "Version": "0.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "generics", + "lifecycle", + "numDeriv", + "pillar", + "rlang", + "stats", + "utils", + "vctrs" + ], + "Hash": "72f50cd7f9ae374a323c832ab6c25171" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "d71f190466b9496cf8543c76641be5cf" + }, + "evaluate": { + "Package": "evaluate", + "Version": "1.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "94cf2c54237f6841cee68e3ba4ab5a14" + }, + "extraDistr": { + "Package": "extraDistr", + "Version": "1.10.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "RcppArmadillo" + ], + "Hash": "678411b96db4b871bd98336049adc566" }, "farver": { "Package": "farver", @@ -194,6 +524,18 @@ ], "Hash": "f918c5e723f86f409912104d5b7a71d6" }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "bd1297f9b5b1fc1372d19e2c4cd82215" + }, "fontquiver": { "Package": "fontquiver", "Version": "0.2.1", @@ -206,9 +548,20 @@ ], "Hash": "fc0f4226379e451057d55419fd31761e" }, + "fs": { + "Package": "fs", + "Version": "2.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "09278623bca442bc53b0940ffa2f6d87" + }, "gdtools": { "Package": "gdtools", - "Version": "0.4.2", + "Version": "0.5.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -219,47 +572,89 @@ "systemfonts", "tools" ], - "Hash": "d022502651388a6bb8545988514d8780" + "Hash": "bca589967c4b7360ced3c08c69a96787" + }, + "generics": { + "Package": "generics", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4b29bf698d0c7bdb9f1e4976e7ade41d" + }, + "ggh4x": { + "Package": "ggh4x", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "S7", + "cli", + "ggplot2", + "grid", + "gtable", + "lifecycle", + "rlang", + "scales", + "stats", + "vctrs" + ], + "Hash": "024c1c1d5894bf313a1625b167984f2e" }, "ggplot2": { "Package": "ggplot2", - "Version": "3.5.2", + "Version": "4.0.3", "Source": "Repository", "Repository": "CRAN", "Requirements": [ - "MASS", "R", + "S7", "cli", - "glue", "grDevices", "grid", "gtable", "isoband", "lifecycle", - "mgcv", "rlang", "scales", "stats", - "tibble", "vctrs", "withr" ], - "Hash": "7ad64861e028a777d7d67ff83231b548" + "Hash": "98520fe6b2745c466dca8e46aaa86242" + }, + "ggtext": { + "Package": "ggtext", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "ggplot2", + "grid", + "gridtext", + "rlang", + "scales" + ], + "Hash": "c5ba8f5056487403a299b91984be86ca" }, "glue": { "Package": "glue", - "Version": "1.8.0", + "Version": "1.8.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", "methods" ], - "Hash": "5899f1eaa825580172bb56c08266f37c" + "Hash": "f8122473e9a49e00d0642f78235ca5e3" }, "gridExtra": { "Package": "gridExtra", - "Version": "2.3", + "Version": "2.3.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -269,7 +664,7 @@ "gtable", "utils" ], - "Hash": "7d7f283939f563670a697165b2cf5560" + "Hash": "4e172eb9a8e2e01e0494ea230b73f068" }, "gridGraphics": { "Package": "gridGraphics", @@ -283,6 +678,36 @@ ], "Hash": "5b79228594f02385d4df4979284879ae" }, + "gridtext": { + "Package": "gridtext", + "Version": "0.1.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "curl", + "grDevices", + "grid", + "jpeg", + "markdown", + "png", + "rlang", + "stringr", + "xml2" + ], + "Hash": "44ba01d9fa1dda584a3f880c212dcd93" + }, + "gsl": { + "Package": "gsl", + "Version": "2.1-9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "6c2e67b032a0a3dba59dfc7acb71bb64" + }, "gtable": { "Package": "gtable", "Version": "0.3.6", @@ -299,9 +724,20 @@ ], "Hash": "de949855009e2d4d0e52a844e30617ae" }, + "highr": { + "Package": "highr", + "Version": "0.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "2a2f862ade01a56dcbcd60944de11255" + }, "htmltools": { "Package": "htmltools", - "Version": "0.5.8.1", + "Version": "0.5.9", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -313,30 +749,73 @@ "rlang", "utils" ], - "Hash": "81d371a9cc60640e74e4ab6ac46dcedc" + "Hash": "102298e238c14eb830cc4b5edd23c3e8" + }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.6.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "htmltools", + "jsonlite", + "knitr", + "rmarkdown", + "yaml" + ], + "Hash": "04291cc45198225444a397606810ac37" + }, + "httr": { + "Package": "httr", + "Version": "1.4.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ], + "Hash": "10bcae7793493db63a6872096132e10c" + }, + "inline": { + "Package": "inline", + "Version": "0.3.21", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "a816db522447eb5ca56e7d4e6e82e4eb" }, "isoband": { "Package": "isoband", - "Version": "0.2.7", + "Version": "0.3.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ + "cli", + "cpp11", "grid", + "rlang", "utils" ], - "Hash": "0080607b4a1a7b28979aecef976d8bc2" + "Hash": "0f9a864bbd7ce0232ad05cb76249cc1a" }, "jaspBase": { "Package": "jaspBase", - "Version": "0.20.0", + "Version": "0.20.4", "Source": "GitHub", "RemoteType": "github", + "Remotes": "jasp-stats/jaspGraphs", "RemoteHost": "api.github.com", "RemoteUsername": "jasp-stats", "RemoteRepo": "jaspBase", "RemoteRef": "master", - "RemoteSha": "9dd637722c25bf0ea035ccaabf58ef9faf36b852", - "Remotes": "jasp-stats/jaspGraphs", + "RemoteSha": "763cb835a7589b72da079b95bbf9491abad4fab3", "Requirements": [ "R6", "Rcpp", @@ -361,7 +840,7 @@ "systemfonts", "withr" ], - "Hash": "75eac9c2c157d37e5f503baebdc54be3" + "Hash": "9932dbefb2240532846b935be759503b" }, "jaspGraphs": { "Package": "jaspGraphs", @@ -372,144 +851,278 @@ "RemoteUsername": "jasp-stats", "RemoteRepo": "jaspGraphs", "RemoteRef": "master", - "RemoteSha": "c884a4239590cdb08c1f18cbeaad9107395425aa", + "RemoteSha": "23cdda0d795329eb99a2659bf6f325a9194ff292", "Requirements": [ "R6", - "RColorBrewer", + "cli", "ggplot2", "gridExtra", "gtable", + "htmlwidgets", "jsonlite", "lifecycle", + "plotly", "rlang", - "scales", - "viridisLite" + "scales" + ], + "Hash": "482289fc59758164e53c1866cc19fd9b" + }, + "jpeg": { + "Package": "jpeg", + "Version": "0.1-11", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c23ab23c370d1ce3a7a80d8c0bdfa105" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "2.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "b0776f526d36d8bd4a3344a88fe165c4" + }, + "knitr": { + "Package": "knitr", + "Version": "1.51", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "27682babb50f03b6eb7939ea69ec79ca" + }, + "labeling": { + "Package": "labeling", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "graphics", + "stats" + ], + "Hash": "b64ec208ac5bc1852b285f665d6368b3" + }, + "later": { + "Package": "later", + "Version": "1.4.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "Rcpp", + "rlang" + ], + "Hash": "824c180e69b9be79ab96a985e233c470" + }, + "lattice": { + "Package": "lattice", + "Version": "0.22-7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "graphics", + "grid", + "stats", + "utils" + ], + "Hash": "934f30aea6442867f57a610034ab06d3" + }, + "lazyeval": { + "Package": "lazyeval", + "Version": "0.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "rlang" + ], + "Hash": "2757e46c2633dd5854f62615df70d0d7" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "rlang" + ], + "Hash": "36dbfe4fba6c064db50a671a90297c85" + }, + "litedown": { + "Package": "litedown", + "Version": "0.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "commonmark", + "utils", + "xfun" ], - "Hash": "a396da19666830203898f153a70816d2" + "Hash": "0bb78ad1932aa147c433f16183382219" }, - "jsonlite": { - "Package": "jsonlite", - "Version": "2.0.0", + "loo": { + "Package": "loo", + "Version": "2.10.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ - "methods" + "R", + "checkmate", + "matrixStats", + "parallel", + "posterior", + "stats" ], - "Hash": "b0776f526d36d8bd4a3344a88fe165c4" + "Hash": "557142a63f951e40db1af9f907365cfc" }, - "labeling": { - "Package": "labeling", - "Version": "0.4.3", + "magrittr": { + "Package": "magrittr", + "Version": "2.0.5", "Source": "Repository", "Repository": "CRAN", "Requirements": [ - "graphics", - "stats" + "R" ], - "Hash": "b64ec208ac5bc1852b285f665d6368b3" + "Hash": "665e77ab6e5f37a7913226d40b324e37" }, - "lattice": { - "Package": "lattice", - "Version": "0.22-5", + "markdown": { + "Package": "markdown", + "Version": "2.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", - "grDevices", - "graphics", - "grid", - "stats", - "utils" + "litedown", + "utils", + "xfun" ], - "Hash": "7c5e89f04e72d6611c77451f6331a091" + "Hash": "b4349847250b103bbbb8bc6819c4fbca" }, - "lifecycle": { - "Package": "lifecycle", - "Version": "1.0.4", + "matrixStats": { + "Package": "matrixStats", + "Version": "1.5.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ - "R", - "cli", - "glue", + "R" + ], + "Hash": "9fd316b52ac8c24fef4c67fdd646e965" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "cachem", "rlang" ], - "Hash": "b8552d117e1b808b09a832f589b79035" + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" }, - "magrittr": { - "Package": "magrittr", - "Version": "2.0.3", + "mime": { + "Package": "mime", + "Version": "0.13", "Source": "Repository", "Repository": "CRAN", "Requirements": [ - "R" + "tools" ], - "Hash": "7ce2733a9826b3aeb1775d56fd305472" + "Hash": "0ec19f34c72fab674d8f2b4b1c6410e1" }, - "mgcv": { - "Package": "mgcv", - "Version": "1.9-1", + "mvtnorm": { + "Package": "mvtnorm", + "Version": "1.4-2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ - "Matrix", "R", - "graphics", - "methods", - "nlme", - "splines", "stats", "utils" ], - "Hash": "110ee9d83b496279960e162ac97764ce" + "Hash": "f12b9432ec251666c49e7d01f1aff3c7" }, - "nlme": { - "Package": "nlme", - "Version": "3.1-168", + "numDeriv": { + "Package": "numDeriv", + "Version": "2016.8-1.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ - "R", - "graphics", - "lattice", - "stats", - "utils" + "R" ], - "Hash": "b1d2ea08d5d392831fbc32c872362b06" + "Hash": "df58958f293b166e4ab885ebcad90e02" }, "officer": { "Package": "officer", - "Version": "0.6.10", + "Version": "0.7.6", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R6", "cli", + "dplyr", "grDevices", "graphics", "openssl", "ragg", "stats", + "tidyr", "utils", "uuid", "xml2", "zip" ], - "Hash": "d8673b646d055738b68e8c54acabe8cf" + "Hash": "8ecbb62f412a5939760ea7eb565acc77" }, "openssl": { "Package": "openssl", - "Version": "2.3.3", + "Version": "2.4.2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "askpass" ], - "Hash": "05ce1ed077e8c97fbb3ec1cb078f1159" + "Hash": "6994d1c3ea954f29de6aeca5da95c99d" + }, + "otel": { + "Package": "otel", + "Version": "0.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "627d6993db1043703c0b084fa432f21f" }, "pillar": { "Package": "pillar", - "Version": "1.10.2", + "Version": "1.11.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -521,7 +1134,7 @@ "utils", "vctrs" ], - "Hash": "1098920a19b5cd5a15bacdc74a89979d" + "Hash": "1395e64f2689ffd503657778e810cee2" }, "pkgbuild": { "Package": "pkgbuild", @@ -548,6 +1161,37 @@ ], "Hash": "01f28d4278f15c76cddbea05899c5d6f" }, + "plotly": { + "Package": "plotly", + "Version": "4.12.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "RColorBrewer", + "base64enc", + "crosstalk", + "data.table", + "digest", + "dplyr", + "ggplot2", + "htmltools", + "htmlwidgets", + "httr", + "jsonlite", + "magrittr", + "promises", + "purrr", + "rlang", + "scales", + "tibble", + "tidyr", + "tools", + "vctrs", + "viridisLite" + ], + "Hash": "3609e47f0d9713dfd7f68bd6e731e27b" + }, "plyr": { "Package": "plyr", "Version": "1.8.9", @@ -559,9 +1203,45 @@ ], "Hash": "6b8177fd19982f0020743fadbfdbd933" }, + "png": { + "Package": "png", + "Version": "0.1-9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "961c433971606243a724eb19b1075e60" + }, + "posterior": { + "Package": "posterior", + "Version": "1.7.0", + "Source": "Repository", + "Repository": "CRAN", + "RemoteType": "repository", + "RemoteUrl": "https://github.com/stan-dev/posterior", + "RemoteRef": "HEAD", + "RemoteSha": "727ac83cb52babb6eb54bdd1ce15f90439626945", + "Requirements": [ + "R", + "abind", + "checkmate", + "distributional", + "matrixStats", + "methods", + "parallel", + "pillar", + "rlang", + "stats", + "tensorA", + "tibble", + "vctrs" + ], + "Hash": "a0f7fccb443ef5069577686efbbbd79b" + }, "processx": { "Package": "processx", - "Version": "3.8.6", + "Version": "3.9.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -570,29 +1250,114 @@ "ps", "utils" ], - "Hash": "720161b280b0a35f4d1490ead2fe81d0" + "Hash": "188d6caf38e81bf15b5e918726a6fd3d" + }, + "promises": { + "Package": "promises", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "fastmap", + "later", + "lifecycle", + "magrittr", + "otel", + "rlang" + ], + "Hash": "62cb899ed5fff70d4e918ec1b762bf7c" }, "ps": { "Package": "ps", - "Version": "1.9.1", + "Version": "1.9.3", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", "utils" ], - "Hash": "093688087b0bacce6ba2f661f36328e2" + "Hash": "83e7e486c434e7acc71766dfc20adf2b" + }, + "purrr": { + "Package": "purrr", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "0a35605539b085a4828ec55ad973fe60" + }, + "qc": { + "Package": "qc", + "Version": "0.0.0.9000", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteUsername": "FBartos", + "RemoteRepo": "qc", + "RemoteRef": "main", + "RemoteSha": "4204e03b4f9e885dbc50bc142a5ff3ec6637281f", + "Requirements": [ + "BH", + "BayesTools", + "HDInterval", + "R", + "Rcpp", + "RcppEigen", + "RcppParallel", + "StanHeaders", + "cubature", + "ggplot2", + "ggtext", + "gsl", + "methods", + "rstan", + "rstantools", + "tibble", + "vctrs" + ], + "Hash": "dda836a23ca2b95e52f339c34fbace88" }, "ragg": { "Package": "ragg", - "Version": "1.4.0", + "Version": "1.5.2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "systemfonts", "textshaping" ], - "Hash": "1591adde9ce8ff7de58072e4a32b66ce" + "Hash": "c06b460d55dd27458977e417e8ff02c7" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "f146a5bfc94db048309712535d4d0aee" + }, + "rbibutils": { + "Package": "rbibutils", + "Version": "2.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "tools", + "utils" + ], + "Hash": "92dd8158e4025e954fd06fcda0def88b" }, "renv": { "Package": "renv", @@ -606,18 +1371,79 @@ }, "rlang": { "Package": "rlang", - "Version": "1.1.6", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "8d05afdb0b0dd5ef01b306db289fe21f" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.31", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "evaluate", + "fontawesome", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "f34039d57d861d2869cbf9be813ed08e" + }, + "rstan": { + "Package": "rstan", + "Version": "2.32.7", "Source": "Repository", "Repository": "CRAN", "Requirements": [ + "BH", + "QuickJSR", "R", + "Rcpp", + "RcppEigen", + "RcppParallel", + "StanHeaders", + "ggplot2", + "gridExtra", + "inline", + "loo", + "methods", + "pkgbuild", + "stats4" + ], + "Hash": "5f47b80f0db40503697eef138a31a6ef" + }, + "rstantools": { + "Package": "rstantools", + "Version": "2.7.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "QuickJSR", + "Rcpp", + "RcppParallel", + "desc", + "stats", "utils" ], - "Hash": "892124978869b74935dc3934c42bfe5a" + "Hash": "cc23398b8a73a7f5a1d893a4344f9fcc" }, "rvg": { "Package": "rvg", - "Version": "0.3.5", + "Version": "0.4.2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -627,9 +1453,24 @@ "grDevices", "officer", "rlang", + "systemfonts", "xml2" ], - "Hash": "5205600ad4a5632089c51434b30db883" + "Hash": "e31ff9b1a3e17e45274109aa917a2aa9" + }, + "sass": { + "Package": "sass", + "Version": "0.4.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "3fb78d066fb92299b1d13f6a7c9a90a8" }, "scales": { "Package": "scales", @@ -652,7 +1493,7 @@ }, "stringi": { "Package": "stringi", - "Version": "1.8.7", + "Version": "1.8.9", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -661,11 +1502,28 @@ "tools", "utils" ], - "Hash": "2b56088e23bdd58f89aebf43a0913457" + "Hash": "67f6c2a9e67d08e1e419ff89ad135444" + }, + "stringr": { + "Package": "stringr", + "Version": "1.6.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "d47392652eedc68bf916657347ff2526" }, "svglite": { "Package": "svglite", - "Version": "2.2.1", + "Version": "2.2.2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -678,7 +1536,7 @@ "systemfonts", "textshaping" ], - "Hash": "a8a754856a1b29a24cbe269b8e03989a" + "Hash": "40b8a31d6734e45bbb44f241afeb4903" }, "sys": { "Package": "sys", @@ -689,7 +1547,7 @@ }, "systemfonts": { "Package": "systemfonts", - "Version": "1.2.3", + "Version": "1.3.2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -702,11 +1560,22 @@ "tools", "utils" ], - "Hash": "fe31683d2c6fd9a5724bcdf8ed44ded9" + "Hash": "1f930828d6590af5da47b3ab4fe161e6" + }, + "tensorA": { + "Package": "tensorA", + "Version": "0.36.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "stats" + ], + "Hash": "0d587599172f2ffda2c09cb6b854e0e5" }, "textshaping": { "Package": "textshaping", - "Version": "1.0.1", + "Version": "1.0.5", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -718,11 +1587,11 @@ "systemfonts", "utils" ], - "Hash": "75b5813527f4154cb467e4cf60911333" + "Hash": "addb750a886a2ac415dea6f8068867de" }, "tibble": { "Package": "tibble", - "Version": "3.3.0", + "Version": "3.3.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -737,7 +1606,56 @@ "utils", "vctrs" ], - "Hash": "784b27d0801c3829de602105757b2cd7" + "Hash": "c55df870972551cac674b50cadb2d51f" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "cpp11", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "a4fa2f5876396f04814cb9d8d9ab89e9" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "829f27b9c4919c16b593794a6344d6c0" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.60", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "xfun" + ], + "Hash": "263651b52279eaa7835e44aa32f9b754" }, "utf8": { "Package": "utf8", @@ -751,17 +1669,17 @@ }, "uuid": { "Package": "uuid", - "Version": "1.2-1", + "Version": "1.2-2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R" ], - "Hash": "34e965e62a41fcafb1ca60e9b142085b" + "Hash": "528fc9e90d70a6a115e21164f37b2c64" }, "vctrs": { "Package": "vctrs", - "Version": "0.6.5", + "Version": "0.7.3", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -771,21 +1689,21 @@ "lifecycle", "rlang" ], - "Hash": "c03fa420630029418f7e6da3667aac4a" + "Hash": "2dcde2d30d3ad67bf1d3a37177457b87" }, "viridisLite": { "Package": "viridisLite", - "Version": "0.4.2", + "Version": "0.4.3", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R" ], - "Hash": "c826c7c4241b6fc89ff55aaea3fa7491" + "Hash": "9380d36888b72faf5ae6c22b44703867" }, "withr": { "Package": "withr", - "Version": "3.0.2", + "Version": "3.0.3", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -793,11 +1711,24 @@ "grDevices", "graphics" ], - "Hash": "cc2d62c76458d425210d1eb1478b30b4" + "Hash": "d979712ec72df779bc2d30bcc5d0d541" + }, + "xfun": { + "Package": "xfun", + "Version": "0.60", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "grDevices", + "stats", + "tools" + ], + "Hash": "8304c2894061f6ae062996f09dd1528e" }, "xml2": { "Package": "xml2", - "Version": "1.3.8", + "Version": "1.6.0", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -806,14 +1737,24 @@ "methods", "rlang" ], - "Hash": "f5130b2f3d461964bac93cc618013231" + "Hash": "568fe669c645b2007e4e8fcf5cde40e7" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.12", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "7cd77cb32abd9220d744307e9fc94ffb" }, "zip": { "Package": "zip", - "Version": "2.3.3", + "Version": "3.0.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "6ebe4b1dc74c3e50e74e316323629583" + "Requirements": [ + "cli" + ], + "Hash": "5807bea03035bfdd7535c1d3eb258cb0" } } } diff --git a/tests/testthat/datasets/processCapability.csv b/tests/testthat/datasets/processCapability.csv new file mode 100644 index 0000000..f85452e --- /dev/null +++ b/tests/testthat/datasets/processCapability.csv @@ -0,0 +1,41 @@ +"measurement" +10.685 +9.718 +10.182 +10.316 +10.202 +9.947 +10.756 +9.953 +11.009 +9.969 +10.652 +11.143 +9.306 +9.861 +9.933 +10.318 +9.858 +8.672 +8.78 +10.66 +9.847 +9.109 +9.914 +10.607 +10.948 +9.785 +9.871 +9.118 +10.23 +9.68 +10.228 +10.352 +10.518 +9.696 +10.252 +9.141 +9.608 +9.575 +8.793 +10.018 diff --git a/tests/testthat/test-bayesianProcessCapabilityStudies.R b/tests/testthat/test-bayesianProcessCapabilityStudies.R new file mode 100644 index 0000000..37b7e8d --- /dev/null +++ b/tests/testthat/test-bayesianProcessCapabilityStudies.R @@ -0,0 +1,195 @@ +context("[Bayesian Quality Control] Bayesian Process Capability Study") + +# jaspTools cannot expand the Common.PlotLayout / Common.Priors components used by +# inst/qml/bayesianProcessCapabilityStudies.qml, so analysisOptions() returns an +# incomplete set. These helpers supply the missing options with their qml defaults. +.plotLayoutOptions <- function(base, checked = FALSE) { + o <- list() + o[[base]] <- checked + o[[paste0(base, "IndividualPointEstimate")]] <- FALSE + o[[paste0(base, "IndividualPointEstimateType")]] <- "mean" + o[[paste0(base, "IndividualCi")]] <- FALSE + o[[paste0(base, "IndividualCiType")]] <- "central" + o[[paste0(base, "IndividualCiMass")]] <- 95 + o[[paste0(base, "IndividualCiLower")]] <- 0 + o[[paste0(base, "IndividualCiUpper")]] <- 1 + o[[paste0(base, "IndividualCiBf")]] <- "1" + o[[paste0(base, "TypeLower")]] <- 0 + o[[paste0(base, "TypeUpper")]] <- 1 + o[[paste0(base, "PanelLayout")]] <- "multiplePanels" + o[[paste0(base, "Axes")]] <- "free" + o[[paste0(base, "custom_x_min")]] <- 0 + o[[paste0(base, "custom_x_max")]] <- 1 + o[[paste0(base, "custom_y_min")]] <- 0 + o[[paste0(base, "custom_y_max")]] <- 1 + o[[paste0(base, "PriorDistribution")]] <- FALSE + o +} + +.plotBases <- c("posteriorDistributionPlot", "priorDistributionPlot", + "sequentialAnalysisPointEstimatePlot", "sequentialAnalysisPointIntervalPlot", + "posteriorPredictiveDistributionPlot", "priorPredictiveDistributionPlot") + +# Default options for the analysis, with spec limits matched to datasets/processCapability.csv +# (40 observations, roughly normal around 10 with sd 0.5). +.bpcsOptions <- function() { + options <- analysisOptions("bayesianProcessCapabilityStudies") + extra <- c(do.call(c, lapply(.plotBases, .plotLayoutOptions)), + list(axisLabels = FALSE, normalModelComponentsList = list(), tModelComponentsList = list())) + options[names(extra)] <- extra + + options$capabilityStudyType <- "normalCapabilityAnalysis" + options$measurementLongFormat <- "measurement" + options$priorSettings <- "default" + options$lowerSpecificationLimit <- TRUE + options$lowerSpecificationLimitValue <- 8.5 + options$target <- TRUE + options$targetValue <- 10 + options$upperSpecificationLimit <- TRUE + options$upperSpecificationLimitValue <- 11.5 + # keep the sampler cheap, this analysis refits per observation in the sequential plots + options$noChains <- 1 + options$noWarmup <- 200 + options$noIterations <- 1000 + options +} + +.capabilityRows <- function(results) { + rows <- results[["results"]][["bpcsCapabilityTable"]][["data"]] + do.call(rbind, lapply(rows, function(r) as.data.frame(r, stringsAsFactors = FALSE))) +} + +## Capability table #### + +options <- .bpcsOptions() +set.seed(1) +results <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + +test_that("Analysis runs to completion", { + expect_equal(results[["status"]], "complete") + expect_null(results[["results"]][["errorMessage"]]) +}) + +test_that("Capability table reports every metric the user selected", { + # regression: qc names these Cpu/Cpl and errors on CpU/CpL, mismatched casing + # silently dropped both metrics from the table + expect_equal(.capabilityRows(results)$metric, c("Cp", "Cpu", "Cpl", "Cpk", "Cpc", "Cpm")) +}) + +test_that("Capability table estimates are plausible for a well centred process", { + df <- .capabilityRows(results) + # LSL 8.5, USL 11.5, sd about 0.5 => Cp near 1 + expect_equal(df$mean[df$metric == "Cp"], 1.0, tolerance = 0.25) + # the sampler makes these stochastic, so only assert the ordering that must hold + expect_true(all(df$lower < df$mean)) + expect_true(all(df$mean < df$upper)) + expect_true(df$mean[df$metric == "Cpk"] <= df$mean[df$metric == "Cp"]) +}) + +test_that("Deselecting metrics removes them from the table", { + options <- .bpcsOptions() + options$Cpu <- FALSE + options$Cpl <- FALSE + options$Cpc <- FALSE + options$Cpm <- FALSE + set.seed(1) + results <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + expect_equal(.capabilityRows(results)$metric, c("Cp", "Cpk")) +}) + +## Estimation #### + +test_that("Estimates are deterministic across runs", { + # qc::bpc defaults to method = "integration", so the fit is numerical rather + # than sampled and repeated runs must agree exactly. + # + # NOTE: this is also why the MCMC Settings group in the qml currently has no + # effect on the capability table. noChains/noWarmup/noIterations are passed to + # qc::bpc (they used to be ignored entirely) but only take effect on the mcmc + # path, which the analysis never selects because there is no qml control for + # the estimation method. Either add that control or drop the settings group. + options <- .bpcsOptions() + set.seed(1) + first <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + set.seed(2) + second <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + + expect_equal(.capabilityRows(first)$mean, .capabilityRows(second)$mean) + expect_equal(.capabilityRows(first)$sd, .capabilityRows(second)$sd) +}) + +## Plots #### + +test_that("Distribution and predictive plots are produced without error", { + options <- .bpcsOptions() + options$posteriorDistributionPlot <- TRUE + options$priorDistributionPlot <- TRUE + options$posteriorPredictiveDistributionPlot <- TRUE + options$priorPredictiveDistributionPlot <- TRUE + set.seed(1) + results <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + + expect_equal(results[["status"]], "complete") + for (base in c("posteriorDistributionPlot", "priorDistributionPlot", + "posteriorPredictiveDistributionPlot", "priorPredictiveDistributionPlot")) { + plotName <- results[["results"]][[base]][["data"]] + expect_true(!is.null(plotName), info = base) + } + expect_length(results[["state"]][["figures"]], 4) +}) + +## Sequential analysis #### + +test_that("Sequential analysis plots are produced without error", { + # slow, the sequential analysis refits once per observation + options <- .bpcsOptions() + options$sequentialAnalysisPointEstimatePlot <- TRUE + options$sequentialAnalysisPointIntervalPlot <- TRUE + set.seed(1) + results <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + + expect_equal(results[["status"]], "complete") + expect_true(!is.null(results[["results"]][["sequentialAnalysisPointEstimatePlot"]][["data"]])) + expect_true(!is.null(results[["results"]][["sequentialAnalysisPointIntervalPlot"]][["data"]])) + expect_length(results[["state"]][["figures"]], 2) +}) + +test_that("Posterior updating table option is not implemented yet", { + # the qml ships a "Posterior updating table" checkbox (marked TODO) with no R + # implementation, so ticking it adds nothing. Guards against the option being + # quietly forgotten: delete this test when the table is implemented. + options <- .bpcsOptions() + options$sequentialAnalysisPointEstimatePlot <- TRUE + options$sequentialAnalysisUpdatingTable <- TRUE + set.seed(1) + results <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + + expect_equal(results[["status"]], "complete") + expect_false("sequentialAnalysisUpdatingTable" %in% names(results[["results"]])) +}) + +## Interval table #### + +test_that("Interval table is produced without error", { + options <- .bpcsOptions() + options$intervalTable <- TRUE + set.seed(1) + results <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + + expect_equal(results[["status"]], "complete") + expect_true(length(results[["results"]][["bpcsIntervalTable"]][["data"]]) > 0) +}) + +## Readiness #### + +test_that("Analysis stays empty until the specification limits are set", { + options <- .bpcsOptions() + options$lowerSpecificationLimit <- FALSE + options$upperSpecificationLimit <- FALSE + options$target <- FALSE + set.seed(1) + results <- runAnalysis("bayesianProcessCapabilityStudies", "datasets/processCapability.csv", options) + + expect_equal(results[["status"]], "complete") + expect_length(.capabilityRows(results), 0) +})