diff --git a/DESCRIPTION b/DESCRIPTION
index c7787d5c..d077daec 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -10,28 +10,39 @@ Description: Investigate if a manufactured product adheres to a defined set of q
License: GPL (>= 2)
Encoding: UTF-8
Imports:
+ BayesFactor,
+ bayesplot,
car,
cowplot,
daewr,
desirability,
DoE.base,
+ dplyr,
+ ellipse,
EnvStats,
+ extraDistr,
FAdist,
fitdistrplus,
FrF2,
+ GeneralizedHyperbolic,
ggplot2,
ggrepel,
goftest,
ggpp,
+ HDInterval,
irr,
jaspBase,
jaspDescriptives,
jaspGraphs,
lubridate,
mle.tools,
+ mvtnorm,
+ posterior,
psych,
qcc,
+ rmetalog,
rsm,
+ rstan,
Rspc,
tidyr,
tibble,
@@ -43,4 +54,4 @@ Remotes:
jasp-stats/jaspDescriptives,
jasp-stats/jaspGraphs
Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.2
+RoxygenNote: 7.3.2
diff --git a/NAMESPACE b/NAMESPACE
index ccae865c..058e5c01 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -5,6 +5,7 @@ export(doeAnalysis)
export(doeFactorial)
export(doeResponseSurfaceMethodology)
export(msaAttribute)
+export(msaBayesianGaugeRR)
export(msaGaugeLinearity)
export(msaGaugeRR)
export(msaGaugeRRnonrep)
@@ -12,8 +13,8 @@ export(msaTestRetest)
export(msaType1Gauge)
export(probabilityOfDetection)
export(processCapabilityStudies)
-export(timeWeightedCharts)
export(rareEventCharts)
+export(timeWeightedCharts)
export(variablesChartsIndividuals)
export(variablesChartsSubgroups)
importFrom(jaspBase,.extractErrorMessage)
diff --git a/R/msaBayesianGaugeRR.R b/R/msaBayesianGaugeRR.R
new file mode 100644
index 00000000..b84060a3
--- /dev/null
+++ b/R/msaBayesianGaugeRR.R
@@ -0,0 +1,2619 @@
+#
+# Copyright (C) 2013-2018 University of Amsterdam
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+#
+
+#' @export
+msaBayesianGaugeRR <- function(jaspResults, dataset, options, ...) {
+ # Compute additional options
+ options <- .msabComputeDerivedOptions(options)
+
+ # Check if ready
+ ready <- .msabIsReady(options)
+
+ # dataset in wide & long format
+ datasets <- .msabReadDataset(dataset, options, ready)
+ dataset <- datasets[["dataLong"]]
+ dataWide <- datasets[["dataWide"]]
+
+ # adjust variable names in options
+ options <- .msabAdjustVarNames(options, dataWide, ready)
+
+ # Error checks
+ .msabCheckErrors(jaspResults, options, ready, dataset, dataWide)
+
+ # note: this can be done better
+ measurements <- options[["measurements"]]
+ parts <- options[["parts"]]
+ operators <- options[["operators"]]
+ measurementsWide <- options[["measurementsWide"]]
+
+ # Results from model comparison
+ bfTest <- .runBFtest(jaspResults, dataset, measurements, parts, operators, options, ready)
+
+ # Model comparison table
+ if(options[["RRTable"]] && !options$report){
+ .createBFtable(jaspResults, dataset, options, measurements, parts, operators, ready)
+ }
+
+ # MCMC
+ .runMCMC(jaspResults, dataset, measurements, parts, operators, options, ready)
+
+ # compute percentages
+ .getStudyVariation(jaspResults, parts, operators, options, ready)
+ .getPercContrib(jaspResults, parts, operators, options, ready)
+ .getPercStudy(jaspResults, ready)
+
+ if(options$tolerance) {
+ .getPercTol(jaspResults, options, ready)
+ }
+
+ # fit distribution to samples
+ .fitDistToSamples(jaspResults, options, ready)
+
+ # insert report here
+ if(options$report) {
+ .createGaugeReport(jaspResults, dataset = dataWide, measurements = measurementsWide, parts, operators, options, ready)
+ } else {
+
+ if(options$RRTable) {
+ # Variance components table
+ .createVarCompTable(jaspResults, parts, operators, ready, options)
+
+ # % Contribution to total variation table
+ .createPercContribTable(jaspResults, options, parts, operators, ready)
+
+ # Gauge evaluation table
+ .createGaugeEval(jaspResults, parts, operators, options, ready)
+ }
+
+ # prior
+ if(options$priorPlot) {
+ .plotPrior(jaspResults, options)
+ }
+
+ # MCMC diagnostics
+ if(options$diagnosticsTable || options$diagnosticsPlots) {
+ .mcmcDiagnostics(jaspResults, parts, operators, options, ready)
+ }
+
+ # posteriors
+ if(options$posteriorPlot){
+ .fillPostSummaryTable(jaspResults, options, parts, operators, ready)
+
+ # summary table & plots
+ .createPostSummaries(jaspResults, options, parts, operators, ready)
+ }
+
+ if(options$varianceComponentsGraph) {
+ .createVarCompPlot(jaspResults, options, ready)
+ }
+
+ # contour plot
+ if(options$contourPlot) {
+ .createContourPlot(jaspResults, parts, operators, measurements, dataset, options, ready)
+ }
+
+ # range chart
+ if(options$rChart) {
+ .createRChart(jaspResults, dataset = dataWide, measurements = measurementsWide, operators, parts, options, ready)
+ }
+
+ # average chart
+ if(options$xBarChart) {
+ .createXbarChart(jaspResults, dataset = dataWide, measurements = measurementsWide, operators, parts, options, ready)
+ }
+
+ # scatter plot
+ if(options$scatterPlot){
+ .createScatterPlotOperators(jaspResults, dataset = dataWide, measurements = measurementsWide, operators, parts, options, ready)
+ }
+
+ # measurement by part plot
+ if(options$partMeasurementPlot) {
+ .createMeasureByPartPlot(jaspResults, dataset = dataWide, measurements = measurementsWide, operators, parts, options, ready)
+ }
+
+ if(options$operatorMeasurementPlot) {
+ .createMeasureByOperatorPlot(jaspResults, dataset = dataWide, measurements = measurementsWide, operators, parts, options, ready, Type3 = options$type3)
+ }
+
+ if(options$partByOperatorMeasurementPlot) {
+ .createPartByOperatorInterPlot(jaspResults, dataset = dataWide, measurements = measurementsWide, operators, parts, options, ready, Type3 = options$type3)
+ }
+
+ if(options$trafficLightChart) {
+ .createTrafficLightPlot(jaspResults, options, ready)
+ }
+ }
+}
+
+
+#### Tables
+.createBFtable <- function(jaspResults, dataset, options, measurements, parts, operators, ready) {
+ if(!is.null(jaspResults[["BFtable"]])) {
+ return()
+ }
+
+ BFtable <- createJaspTable(title = gettext("Model Comparison"))
+ BFtable$position <- 1
+ BFtable$dependOn(.bfTableDependencies())
+
+ jaspResults[["BFtable"]] <- BFtable
+
+ BFtable$addColumnInfo(name = "modelName", title = gettext("Models"), type = "string")
+ BFtable$addColumnInfo(name = "comparisonBF", title = gettext("BF10"), type = "number")
+ BFtable$addColumnInfo(name = "error", title = gettextf("error %%"), type = "number")
+
+ # check for errors & set data
+ if(ready) {
+ if(isTryError(jaspResults[["modelComparison"]][["object"]])) {
+ errorMsg <- jaspResults[["modelComparison"]][["object"]]
+
+ if(options$estimationType == "automatic") {
+ errorMsg <- gettextf("Model comparison Bayes factors could not be computed: %s
Select manual estimation to try running the rest of the analysis.",
+ .rmNewLine(errorMsg))
+ .quitAnalysis(errorMsg)
+ }
+ errorMsg <- gettextf("Model comparison Bayes factors could not be computed: %s",
+ .rmNewLine(errorMsg))
+ BFtable$setError(errorMsg)
+
+ } else {
+ BFtable$setData(jaspResults[["modelComparison"]][["object"]])
+ BFtable$addFootnote(gettext("BF10 compares the full model to the indicated model in each row."))
+ }
+ }
+
+ return()
+}
+
+.createVarCompTable <- function(jaspResults, parts, operators, ready, options) {
+ if(!is.null(jaspResults[["varCompTable"]])) {
+ return()
+ }
+
+ varCompTable <- createJaspTable(title = gettext("Variance Components"))
+ varCompTable$position <- 2
+ varCompTable$dependOn(.varCompTableDependencies())
+
+ jaspResults[["varCompTable"]] <- varCompTable
+
+ varCompTable$addColumnInfo(name = "sourceName", title = gettext("Source"), type = "string")
+ varCompTable$addColumnInfo(name = "postMeans", title = gettext("Mean"), type = "number")
+ varCompTable$addColumnInfo(name = "postSds", title = gettext("Std. Deviation"), type = "number")
+ varCompTable$addColumnInfo(name = "postCrIlower", title = gettext("Lower"), type = "number", overtitle = gettextf("95%% Credible Interval"))
+ varCompTable$addColumnInfo(name = "postCrIupper", title = gettext("Upper"), type = "number", overtitle = gettextf("95%% Credible Interval"))
+
+ # set data
+ if(ready) {
+ fillDat <- .getVarianceComponents(jaspResults, parts, operators, options)
+
+ if(.hasExtremeValues(fillDat)$large) {
+ varCompTable$addFootnote(gettext("Estimates are very large potentially making results unreliable. Consider transfroming the data."),
+ symbol = gettext("Warning:"))
+ }
+
+ if(.hasExtremeValues(fillDat)$small) {
+ varCompTable$addFootnote(gettext("Estimates are very small potentially making results unreliable. Consider transfroming the data."),
+ symbol = gettext("Warning:"))
+ }
+
+ varCompTable$setData(fillDat)
+ varCompTable$addFootnote(gettext("Credible intervals are estimated based on the MCMC samples."))
+
+ if(!options$type3 && .evalInter(jaspResults, parts, operators, options)) {
+ varCompTable$addFootnote(gettext("The components are based on the model only including the main effects."))
+ } else {
+ varCompTable$addFootnote(gettext("The components are based on the full model."))
+ }
+
+ } else {
+ return()
+ }
+
+ return()
+}
+
+.createPercContribTable <- function(jaspResults, options, parts, operators, ready) {
+ if(!is.null(jaspResults[["contribTable"]])) {
+ return()
+ }
+ contribTable <- createJaspTable(title = gettextf("%% Contribution to Total Variation"))
+ contribTable$position <- 3
+ contribTable$dependOn(.varCompTableDependencies())
+ jaspResults[["contribTable"]] <- contribTable
+
+ contribTable$addColumnInfo(name = "sourceName", title = gettext("Source"), type = "string")
+ contribTable$addColumnInfo(name = "means", title = gettext("Mean"), type = "number")
+ overTitle <- gettextf("95%% Credible Interval")
+ contribTable$addColumnInfo(name = "lower", title = gettext("Lower"), type = "number", overtitle = overTitle)
+ contribTable$addColumnInfo(name = "upper", title = gettext("Upper"), type = "number", overtitle = overTitle)
+
+ if(ready) {
+ contribTable$setData(.percentSampleSummaries(jaspResults[["percContribSamples"]][["object"]], options))
+ contribTable$addFootnote(gettext("Credible intervals are estimated based on the MCMC samples."))
+ } else {
+ return()
+ }
+ return()
+}
+
+.createPostSummaries <- function(jaspResults, options, parts, operators, ready){
+ if(!is.null(jaspResults[["posteriorSummaries"]])){
+ return()
+ }
+
+ posteriorSummaries <- createJaspContainer(title = gettext("Posterior Distributions"))
+ posteriorSummaries$position <- 6
+ posteriorSummaries$dependOn(c(.varCompTableDependencies(),
+ .postPlotDependencies()))
+ jaspResults[["posteriorSummaries"]] <- posteriorSummaries
+
+ if(isTryError(jaspResults[["distFit"]][["object"]])) {
+ errorMsg <- gettextf("The %s distribution could not be fit to the samples.
+ Try selecting another distribution.", .getDistNames(options$distType))
+ tempPlot <- createJaspPlot()
+ tempPlot$setError(errorMsg)
+ posteriorSummaries[["errorPlot"]] <- tempPlot
+ return()
+ }
+
+ if(!ready) {
+ # create empty plot for posterior distributions
+ posteriorSummaries[["plot"]] <- createJaspPlot(width = 600, height = 320)
+ }
+
+ # table
+ postSummary <- createJaspTable(title = gettext("Posterior Summary"))
+ postSummary$position <- 1
+ postSummary$dependOn(c(.varCompTableDependencies(),
+ .postPlotDependencies()))
+
+ posteriorSummaries[["postSummary"]] <- postSummary
+
+ # title for point estimate
+ pointEst <- switch (options$posteriorPointEstimateType,
+ "mean" = gettext("Mean"),
+ "mode" = gettext("Mode"),
+ "median" = gettext("Median")
+ )
+
+ # overtitle for CrI
+ if(options$posteriorCiType == "central" || options$posteriorCiType == "HPD") {
+ mass <- round(options$posteriorCiMass * 100)
+ }
+
+ if(options$posteriorCiType == "custom") {
+ mass <- round((options$posteriorCiUpper - options$posteriorCiLower) * 100)
+ }
+
+ overtitle <- gettextf("%s%% Credible Interval", mass)
+
+ postSummary$addColumnInfo(name = "parameter", title = gettext("Source"), type = "string")
+
+ if(options$posteriorPointEstimate) {
+ postSummary$addColumnInfo(name = "pointEstimate", title = pointEst, type = "number")
+ }
+
+ if(options$posteriorCi) {
+ if(options$posteriorCiType != "custom" || (options$posteriorCiType == "custom" && options$customCiType != "customCiCutOff")) {
+ postSummary$addColumnInfo(name = "ciLower", title = gettext("Lower"), type = "number", overtitle = gettext(overtitle))
+ postSummary$addColumnInfo(name = "ciUpper", title = gettext("Upper"), type = "number", overtitle = gettext(overtitle))
+ postSummary$addFootnote(gettext("Credible intervals are estimated based on the distribution fit to the MCMC samples."))
+ } else {
+ cutOff <- options$posteriorCiCutOff
+ if(cutOff == as.integer(cutOff)) {
+ postSummary$addColumnInfo(name = "belowCutOff", title = gettextf("p(x < %d | data)", cutOff), type = "number")
+ } else {
+ postSummary$addColumnInfo(name = "belowCutOff", title = gettextf("p(x < %.2f | data)", cutOff), type = "number")
+ }
+ }
+ }
+
+ if(!ready) {
+ return()
+ }
+
+ dat <- jaspResults[["postSummaryStats"]][["object"]]
+ errors <- .checkProbabilityEstimates(dat$belowCutOff)
+ dat$belowCutOff <- errors[["estimates"]] # cleaned estimates
+
+ if(options$customCiType == "customCiCutOff") {
+ # check for too large cut-off
+ if(errors[["large"]]) {
+ if(cutOff == as.integer(cutOff)) {
+ postSummary$addFootnote(gettextf("p(x < %d | data) could not be calculated for some sources. The cut-off is probably too large or too small.",
+ cutOff), symbol = gettext("Warning:"))
+ } else {
+ postSummary$addFootnote(gettextf("p(x < %.2f | data) could not be calculated for some sources. The cut-off is probably too large or too small.",
+ cutOff), symbol = gettext("Warning:"))
+ }
+ }
+
+ # check for negative estimates
+ if(errors[["negative"]]) {
+ if(cutOff == as.integer(cutOff)) {
+ postSummary$addFootnote(gettextf("Some estimates of p(x < %d | data) were negative and, therefore, removed. Try a different cut-off or distribution.",
+ cutOff), symbol = gettext("Warning:"))
+ } else {
+ postSummary$addFootnote(gettextf("Some estimates of p(x < %.2f | data) were negative and, therefore, removed. Try a different cut-off or distribution.",
+ cutOff), symbol = gettext("Warning:"))
+ }
+ }
+ }
+
+ postSummary$setData(dat)
+
+ # plots
+ .plotVariancePosteriors(jaspResults, options, parts, operators)
+
+ return()
+}
+
+.createGaugeEval <- function(jaspResults, parts, operators, options, ready) {
+ if(!is.null(jaspResults[["gaugeEvaluation"]])) {
+ return()
+ }
+
+ gaugeEvaluation <- createJaspContainer(title = gettext("Gauge Evaluation"))
+ gaugeEvaluation$position <- 4
+ gaugeEvaluation$dependOn(c(.varCompTableDependencies(),
+ "studyVarianceMultiplierType", "studyVarianceMultiplierValue",
+ "tolerance", "toleranceValue"))
+ jaspResults[["gaugeEvaluation"]] <- gaugeEvaluation
+
+ ### Standard deviation & study variation table
+ stdTable <- createJaspTable(title = gettext("Standard Deviation & Study Variation"))
+ stdTable$position <- 1
+ gaugeEvaluation[["stdTable"]] <- stdTable
+
+ stdTable$addColumnInfo(name = "sourceName", title = gettext("Source"), type = "string")
+ stdTable$addColumnInfo(name = "meansStd", title = gettext("Mean
Std"), type = "number")
+ stdTable$addColumnInfo(name = "lowerStd", title = gettext("Lower"), type = "number", overtitle = gettextf("95%% Credible Interval
Std"))
+ stdTable$addColumnInfo(name = "upperStd", title = gettext("Upper"), type = "number", overtitle = gettextf("95%% Credible Interval
Std"))
+ stdTable$addColumnInfo(name = "meansStudyVar", title = gettext("Mean
Study Variation"), type = "number")
+ stdTable$addColumnInfo(name = "lowerStudyVar", title = gettext("Lower"), type = "number", overtitle = gettextf("95%% Credible Interval
Study Variation"))
+ stdTable$addColumnInfo(name = "upperStudyVar", title = gettext("Upper"), type = "number", overtitle = gettextf("95%% Credible Interval
Study Variation"))
+
+ if(ready) {
+ stdData <- .fillTablesGaugeEval(jaspResults, parts, operators, options, whichTable = "sd")
+
+ studyVarData <- .fillTablesGaugeEval(jaspResults, parts, operators, options, whichTable = "studyVar")[, -1] # remove source name
+ stdTable$setData(cbind(stdData, studyVarData))
+
+ stdTable$addFootnote(gettext("Credible intervals are estimated based on the MCMC samples."))
+
+ # number of distinct categories
+ nDistinct <- .getDistinctCategories(jaspResults, parts, operators, options)
+ stdTable$addFootnote(gettextf("Number of distinct categories: %s", nDistinct))
+ }
+
+ ### Percent study variation & percent tolerance table
+ if(options$tolerance) {
+ title <- gettextf("%% Study Variation & %% Tolerance")
+ } else {
+ title <- gettextf("%% Study Variation")
+ }
+ percStudyVarTable <- createJaspTable(title = title)
+ percStudyVarTable$position <- 2
+ gaugeEvaluation[["percStudyVarTable"]] <- percStudyVarTable
+
+ percStudyVarTable$addColumnInfo(name = "sourceName", title = gettext("Source"), type = "string")
+ percStudyVarTable$addColumnInfo(name = "meansPercStudy", title = gettextf("Mean
%% Study Variation"), type = "number")
+ percStudyVarTable$addColumnInfo(name = "lowerPercStudy", title = gettext("Lower"), type = "number", overtitle = gettextf("95%% Credible Interval
%% Study Variation"))
+ percStudyVarTable$addColumnInfo(name = "upperPercStudy", title = gettext("Upper"), type = "number", overtitle = gettextf("95%% Credible Interval
%% Study Variation"))
+
+ if(options$tolerance) {
+ percStudyVarTable$addColumnInfo(name = "meansPercTol", title = gettextf("Mean
%% Tolerance"), type = "number")
+ percStudyVarTable$addColumnInfo(name = "lowerPercTol", title = gettext("Lower"), type = "number", overtitle = gettextf("95%% Credible Interval
%% Tolerance"))
+ percStudyVarTable$addColumnInfo(name = "upperPercTol", title = gettext("Upper"), type = "number", overtitle = gettextf("95%% Credible Interval
%% Tolerance"))
+ }
+
+ if(ready) {
+ percStudyData <- .fillTablesGaugeEval(jaspResults, parts, operators, options, whichTable = "percStudyVar")
+
+ if(!options$tolerance) {
+ percStudyVarTable$setData(percStudyData)
+ } else {
+ percTolData <- .fillTablesGaugeEval(jaspResults, parts, operators, options, whichTable = "percTol")[, -1]
+ percStudyVarTable$setData(cbind(percStudyData, percTolData))
+ }
+ percStudyVarTable$addFootnote(gettext("Credible intervals are estimated based on the MCMC samples."))
+ }
+
+ return()
+}
+
+.runBFtest <- function(jaspResults, dataset, measurements, parts, operators, options, ready) {
+ if(is.null(jaspResults[["modelComparison"]]) && ready) {
+ modelComparison <- createJaspState()
+ modelComparison$dependOn(c("operatorWideFormat", "operatorLongFormat", "partWideFormat", "partLongFormat", "measurementsWideFormat",
+ "measurementLongFormat", "seed", "setSeed", "rscalePrior", "type3"))
+ jaspResults[["modelComparison"]] <- modelComparison
+ } else {
+ return()
+ }
+
+ if(options$setSeed) {
+ set.seed(options$seed)
+ }
+
+ if(options$type3){
+ formula <- as.formula(paste(measurements, "~", parts))
+ bfFit <- try(BayesFactor::generalTestBF(formula, data = dataset,
+ whichRandom = parts,
+ rscaleRandom = options$rscalePrior,
+ progress = FALSE))
+
+ if(isTryError(bfFit)) {
+ jaspResults[["modelComparison"]][["object"]] <- bfFit
+ return()
+ }
+
+ bfDf <- as.data.frame(bfFit)
+ full <- parts
+ bfFullNull <- bfDf$bf
+
+ } else {
+ formula <- as.formula(paste(measurements, "~", parts, "*", operators))
+
+ # run general comparison for all potential models
+ bfFit <- try(BayesFactor::generalTestBF(formula, data = dataset,
+ whichRandom = c(operators, parts),
+ rscaleRandom = options$rscalePrior,
+ progress = FALSE))
+ if(isTryError(bfFit)) {
+ jaspResults[["modelComparison"]][["object"]] <- bfFit
+ return()
+ }
+ bfDf <- as.data.frame(bfFit)
+
+ # extract full model and model with only main effects
+ main <- paste(parts, "+", operators)
+ full <- paste0(parts, " + ", operators, " + ", parts, ":", operators)
+ bfDf <- bfDf[c(main, full), ]
+
+ bfFullNull <- bfDf[full, ]$bf
+ }
+
+ # dropping unnecessary columns
+ bfDf <- bfDf[, !colnames(bfDf) %in% c("time", "code")]
+
+ # obtain BF comparing full model to other models
+ bfDf$bf <- bfFullNull / bfDf$bf
+
+ # add null model
+ bfDf["Null model", ] <- c(bfFullNull,
+ bfDf[full, ]$error)
+
+ bfDf[full, ]$error <- ""
+
+ # add model names & change colnames
+ colnames(bfDf) <- c("comparisonBF", "error")
+ bfDf$modelName <- rownames(bfDf)
+ if(!options$type3) {
+ bfDf$modelName <- jaspBase::gsubInteractionSymbol(bfDf$modelName)
+ }
+
+ bfDf <- bfDf[order(-bfDf$comparisonBF), ]
+
+ jaspResults[["modelComparison"]][["object"]] <- bfDf
+
+ return()
+}
+
+#### Plots
+.createContourPlot <- function(jaspResults, parts, operators, measurements, dataset, options, ready) {
+ if(!is.null(jaspResults[["contourPlot"]])) {
+ return()
+ }
+
+ contourPlot <- createJaspContainer(title = gettext("Contour Plot"))
+ contourPlot$position <- 6
+ contourPlot$dependOn(c(.varCompTableDependencies(),
+ "studyVarianceMultiplierType", "studyVarianceMultiplierValue",
+ "contourPlot", "contourUSL", "contourLSL"))
+
+ jaspResults[["contourPlot"]] <- contourPlot
+
+ tempPlot <- createJaspPlot(width = 600, height = 600)
+ tempPlot$position <- 2
+
+ # table with the posterior means and CrIs for the risks
+ risksTable <- createJaspTable(title = gettext("Producer's (\u03b4) and Consumer's (\u03b2) Risk"))
+ risksTable$position <- 1
+
+ risksTable$addColumnInfo(name = "risks", title = gettext("Risk"), type = "string")
+ risksTable$addColumnInfo(name = "means", title = gettext("Mean"), type = "number")
+ risksTable$addColumnInfo(name = "lower", title = gettext("Lower"), type = "number", overtitle = gettextf("95%% Credible Interval"))
+ risksTable$addColumnInfo(name = "upper", title = gettext("Upper"), type = "number", overtitle = gettextf("95%% Credible Interval"))
+
+ if(!ready) {
+ contourPlot[["plot"]] <- tempPlot
+ contourPlot[["table"]] <- risksTable
+ return()
+ }
+
+ samplesMat <- .arrayToMat(jaspResults[["MCMCsamples"]][["object"]])
+ excludeInter <- .evalInter(jaspResults, parts, operators, options)
+ compDf <-.getComponentsFromSamples(jaspResults, parts, operators, options, excludeInter)
+
+ # obtain necessary data
+ contourDf <- compDf[, c("total", "part")]
+ mu <- mean(dataset[[measurements]])
+
+ # data frame for plotting
+ meanEllipse <- TRUE
+ plotDf <- .getEllipses(contourDf, mu, meanEllipse = meanEllipse, options = options)
+
+ if(isTryError(plotDf)) {
+ errorMsg <- gettextf("Failed to calculate contour: %s", .rmNewLine(plotDf))
+ tempPlot$setError(errorMsg)
+ contourPlot[["plot"]] <- tempPlot
+ return()
+ }
+
+ if(meanEllipse) {
+ p <- ggplot2::ggplot(plotDf, ggplot2::aes(x = x, y = y))
+ } else {
+ p <- ggplot2::ggplot(plotDf, ggplot2::aes(x = x, y = y, group = iter))
+ }
+
+ p <- p +
+ ggplot2::geom_vline(xintercept = c(options$contourLSL, options$contourUSL), linetype = "dashed", color = "black", linewidth = 1) +
+ ggplot2::geom_hline(yintercept = c(options$contourLSL, options$contourUSL), linetype = "dashed", color = "black", linewidth = 1) +
+ ggplot2::geom_path(alpha = 0.5, colour = "steelblue", linewidth = 1)
+
+ # axes
+ xLower <- min(options$contourLSL, plotDf$x)
+ xUpper <- max(options$contourUSL, plotDf$x)
+ xLims <- c(xLower, xUpper)
+ xBreaks <- jaspGraphs::getPrettyAxisBreaks(xLims)
+ xLims <- c(xBreaks[1], xBreaks[length(xBreaks)])
+
+ yLower <- min(options$contourLSL, plotDf$y)
+ yUpper <- max(options$contourUSL, plotDf$y)
+ yLims <- c(yLower, yUpper)
+ yBreaks <- jaspGraphs::getPrettyAxisBreaks(yLims)
+ yLims <- c(yBreaks[1], yBreaks[length(yBreaks)])
+
+ p <- p +
+ ggplot2::scale_x_continuous(name = gettext("True Value"), breaks = xBreaks,
+ limits = xLims, labels = xBreaks) +
+ ggplot2::scale_y_continuous(name = gettext("Measurement"), breaks = yBreaks,
+ limits = yLims, labels = yBreaks) +
+ ggplot2::coord_equal()
+
+ # theme
+ p <- p +
+ jaspGraphs::themeJaspRaw() +
+ jaspGraphs::geom_rangeframe(sides = "bl")
+
+ tempPlot$plotObject <- p
+
+ contourPlot[["plot"]] <- tempPlot
+
+ # fill risk table
+ fillDat <- .getRisks(contourDf, mu, options)
+
+ if(isTryError(fillDat)) {
+ errorMsg <- gettextf("Risks could not be computed: %s
Try adjusting the specification limits.", fillDat)
+ risksTable$setError(errorMsg)
+ } else {
+ risksTable$setData(fillDat)
+ }
+ contourPlot[["table"]] <- risksTable
+
+ return()
+}
+
+.plotPrior <- function(jaspResults, options) {
+ if(!is.null(jaspResults[["priorPlot"]])) {
+ return()
+ }
+ priorPlot <- createJaspContainer(title = gettext("Prior Distribution"))
+ priorPlot$position <- 5
+ priorPlot$dependOn(c("rscalePrior", "report", "priorPlot"))
+ jaspResults[["priorPlot"]] <- priorPlot
+
+ gPrior <- createJaspPlot(title = gettext("g-prior"), width = 600, height = 320)
+
+ # axis limit
+ xUpper <- extraDistr::qinvchisq(0.75, nu = 1, tau = options$rscalePrior^2)
+ xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, xUpper))
+
+ p <- ggplot2::ggplot() +
+ ggplot2::stat_function(fun = extraDistr::dinvchisq,
+ args = list(nu = 1, tau = options$rscalePrior^2),
+ linewidth = 1)
+
+ # axes
+ p <- p + ggplot2::scale_y_continuous("Density") +
+ ggplot2::scale_x_continuous("g", breaks = xBreaks, limits = c(0, xUpper))
+
+ # JASP theme
+ p <- p + jaspGraphs::themeJaspRaw() + jaspGraphs::geom_rangeframe()
+ gPrior$plotObject <- p
+
+ priorPlot[["plot"]] <- gPrior
+
+ return()
+}
+
+### posterior plots
+.plotVariancePosteriors <- function(jaspResults, options, parts, operators){
+ dat <- jaspResults[["posteriorSummaries"]][["postSummary"]]
+ fits <- jaspResults[["distFit"]][["object"]]
+
+ samplesMat <- switch(options$posteriorPlotType,
+ "var" = .arrayToMat(jaspResults[["MCMCsamples"]][["object"]]),
+ "percContrib" = jaspResults[["percContribSamples"]][["object"]],
+ "percStudyVar" = jaspResults[["percStudySamples"]][["object"]],
+ "percTol" = jaspResults[["percTolSamples"]][["object"]])
+
+ if(options$posteriorPlotType == "var") {
+ titles <- .convertOutputNames(names(fits), parts, operators, includeSigma = FALSE)
+ } else {
+ titles <- names(fits)
+ }
+ postSummary <- jaspResults[["postSummaryStats"]][["object"]]
+
+ for(i in seq_along(titles)) {
+ tempPlot <- createJaspPlot(title = gettext(titles[i]), width = 600, height = 320)
+
+ p <- ggplot2::ggplot()
+
+ # add histogram outlines
+ if(options$posteriorHistogram) {
+ p <- p + ggplot2::geom_step(data = data.frame(x = samplesMat[, i]),
+ ggplot2::aes(x = x, y = ggplot2::after_stat(density)),
+ stat = "bin", direction = "mid", linewidth = 1)
+ pBuild <- ggplot2::ggplot_build(p)
+ maxHistDens <- max(pBuild$data[[1]][, "density"])
+ }
+
+ # credible interval
+ if(options$posteriorCi) {
+ if(options$posteriorCiType != "custom" || (options$posteriorCiType == "custom" && options$customCiType != "customCiCutOff")) {
+ ciUpper <- postSummary[i, "ciUpper"]
+ ciLower <- postSummary[i, "ciLower"]
+
+ p <- p +
+ if(options$distType == "metalog") {
+ ggplot2::stat_function(fun = rmetalog::dmetalog, args = list(m = fits[[i]], term = fits[[i]]$params$term_limit),
+ geom = "area", xlim = c(ciLower, ciUpper), fill = "grey")
+ # note: it might make sense to just pass some approximation of the density to the plotting function in case of the metalog
+ # so it only has to evaluate the density function once
+ } else { # note: this would be nicer with a list of functions again, but the functions take different arguments
+ ggplot2::stat_function(fun = GeneralizedHyperbolic::dgig, args = list(param = fits[[i]]$param),
+ geom = "area", xlim = c(ciLower, ciUpper), fill = "grey")
+ }
+ } else {
+
+ # do not plot if p(x < cut-off | data) was not computed correctly
+ est <- .checkProbabilityEstimates(jaspResults[["postSummaryStats"]][["object"]]$belowCutOff)[["estimates"]]
+
+ if(!i %in% which(is.na(est))) {
+ p <- p +
+ if(options$distType == "metalog") {
+ ggplot2::stat_function(fun = rmetalog::dmetalog, args = list(m = fits[[i]], term = fits[[i]]$params$term_limit),
+ geom = "area", xlim = c(0, options$posteriorCiCutOff), fill = "grey")
+ # note: it might make sense to just pass some approximation of the density to the plotting function in case of the metalog
+ # so it only has to evaluate the density function once
+ } else { # note: this would be nicer with a list of functions again, but the functions take different arguments
+ ggplot2::stat_function(fun = GeneralizedHyperbolic::dgig, args = list(param = fits[[i]]$param),
+ geom = "area", xlim = c(0, options$posteriorCiCutOff), fill = "grey")
+ }
+ }
+ }
+ }
+
+ p <- p +
+ if(options$distType == "metalog") {
+ ggplot2::stat_function(fun = rmetalog::dmetalog, args = list(m = fits[[i]], term = fits[[i]]$params$term_limit),
+ linewidth = 1)
+ } else { # note: see above
+ ggplot2::stat_function(fun = GeneralizedHyperbolic::dgig, args = list(param = fits[[i]]$param),
+ linewidth = 1)
+ }
+
+ # point estimate
+ if(options$posteriorPointEstimate) {
+ xPoint <- postSummary[i, "pointEstimate"]
+ yPoint <- ifelse(options$distType == "metalog",
+ rmetalog::dmetalog(m = fits[[i]], q = xPoint, term = fits[[i]]$params$term_limit),
+ GeneralizedHyperbolic::dgig(x = xPoint, param = fits[[i]]$param))
+ pointDf <- data.frame(xPoint, yPoint)
+
+ p <- p + ggplot2::geom_point(data = pointDf, mapping = ggplot2::aes(x = xPoint, y = yPoint),
+ shape = 21, size = 4, fill = "grey", stroke = 1)
+ }
+
+ # axes
+ # select function for axis limits based on distribution
+ axisFun <- .axisLimFuns()[[options$distType]]
+
+ lims <- axisFun(fits[[i]], postSummary, options, iter = i,
+ histDens = ifelse(options$posteriorHistogram, maxHistDens, 0))
+
+ xLab <- switch(options$posteriorPlotType,
+ "var" = titles[i],
+ "percContrib" = "% Contribution",
+ "percStudyVar" = "% Study Variation",
+ "percTol" = "% Tolerance")
+ if(options$posteriorPlotType == "var"){
+ xLab <- bquote(sigma[.(xLab)]^2)
+ }
+
+ p <- p +
+ ggplot2::scale_x_continuous(name = xLab,
+ breaks = lims$x$breaks,
+ limits = lims$x$limits, labels = lims$x$breaks) +
+ ggplot2::scale_y_continuous(name = "Density", breaks = lims$y$breaks,
+ limits = lims$y$limits, labels = lims$y$breaks)
+
+ # theme
+ p <- p + jaspGraphs::themeJaspRaw() + jaspGraphs::geom_rangeframe(sides = "bl")
+
+ tempPlot$plotObject <- p
+ jaspResults[["posteriorSummaries"]][[titles[i]]] <- tempPlot
+ }
+ return()
+}
+
+.createRChart <- function(jaspResults, dataset, measurements, operators, parts, options, ready) {
+ if(!is.null(jaspResults[["rChart"]])) {
+ return()
+ }
+
+ jaspResults[["rChart"]] <- createJaspContainer(gettext("Range chart by operator"))
+ jaspResults[["rChart"]]$position <- 7
+ jaspResults[["rChart"]]$dependOn(c("rChart", "measurementLongFormat",
+ "measurementsWideFormat", "report",
+ "operatorWideFormat", "operatorLongFormat",
+ "partWideFormat", "partLongFormat"))
+ jaspResults[["rChart"]][["plot"]] <- createJaspPlot(width = 1200, height = 500)
+
+ if (ready) {
+ ruleList <- .getRuleListSubgroupCharts(options, type = "R")
+ rChart <- .controlChart(dataset = dataset[c(measurements, operators)], plotType = "R", ruleList = ruleList,
+ stages = operators, xAxisLabels = dataset[[parts]][order(dataset[[operators]])],
+ stagesSeparateCalculation = FALSE)
+
+ jaspResults[["rChart"]][["plot"]]$plotObject <- rChart$plotObject
+ jaspResults[["rChart"]][["table"]] <- rChart$table
+ }
+
+ return()
+}
+
+.createXbarChart <- function(jaspResults, dataset, measurements, operators, parts, options, ready) {
+ if(!is.null(jaspResults[["xBarChart"]])) {
+ return()
+ }
+
+ jaspResults[["xBarChart"]] <- createJaspContainer(gettext("Average chart by operator"))
+ jaspResults[["xBarChart"]]$position <- 8
+ jaspResults[["xBarChart"]]$dependOn(c("xBarChart", "measurementLongFormat",
+ "measurementsWideFormat", "report",
+ "operatorWideFormat", "operatorLongFormat",
+ "partWideFormat", "partLongFormat"))
+ jaspResults[["xBarChart"]][["plot"]] <- createJaspPlot(width = 1200, height = 500)
+
+ if (ready) {
+ ruleList <- .getRuleListSubgroupCharts(options, type = "xBar")
+ xBarChart <- .controlChart(dataset = dataset[c(measurements, operators)],
+ plotType = "xBar", ruleList = ruleList, xBarSdType = "r", stages = operators,
+ xAxisLabels = dataset[[parts]][order(dataset[[operators]])],
+ stagesSeparateCalculation = FALSE)
+
+ jaspResults[["xBarChart"]][["plot"]]$plotObject <- xBarChart$plotObject
+ jaspResults[["xBarChart"]][["table"]] <- xBarChart$table
+ }
+
+ return()
+}
+
+
+.createScatterPlotOperators <- function(jaspResults, dataset, measurements, operators, parts, options, ready) {
+ if(!is.null(jaspResults[["gaugeScatterOperators"]])) {
+ return()
+ }
+
+ jaspResults[["gaugeScatterOperators"]] <- createJaspPlot(title = gettext("Matrix plot for operators"),
+ width = 700, height = 700)
+ jaspResults[["gaugeScatterOperators"]]$position <- 9
+ jaspResults[["gaugeScatterOperators"]]$dependOn(c("scatterPlot", "scatterPlotFitLine", "scatterPlotOriginLine",
+ "operatorWideFormat", "operatorLongFormat",
+ "partWideFormat", "partLongFormat",
+ "measurementsWideFormat", "measurementLongFormat", "report"))
+
+ if(!ready) {
+ return()
+ }
+
+ jaspResults[["gaugeScatterOperators"]]$plotObject <- .gaugeScatterPlotOperators(jaspResults, dataset, measurements,
+ parts, operators, options, ready)$plotObject
+
+ return()
+}
+
+.createMeasureByPartPlot <- function(jaspResults, dataset, measurements, operators, parts, options, ready) {
+ if (!is.null(jaspResults[["gaugeByPart"]])) {
+ return()
+ }
+
+ jaspResults[["gaugeByPart"]] <- createJaspPlot(title = gettext("Measurements by part"),
+ width = 700, height = 300)
+ jaspResults[["gaugeByPart"]]$position <- 10
+ jaspResults[["gaugeByPart"]]$dependOn(c("partMeasurementPlot", "partMeasurementPlotAllValues", "operatorWideFormat",
+ "operatorLongFormat", "partWideFormat", "partLongFormat",
+ "measurementsWideFormat", "measurementLongFormat", "report"))
+
+ if(!ready) {
+ return()
+ }
+
+ jaspResults[["gaugeByPart"]]$plotObject <- .gaugeByPartGraphPlotObject(dataset, measurements, parts, operators,
+ displayAll = options$partMeasurementPlotAllValues)
+
+ return()
+}
+
+.createMeasureByOperatorPlot <- function(jaspResults, dataset, measurements, operators, parts, options, ready, Type3) {
+ if(!is.null(jaspResults[["gaugeByOperator"]])) {
+ return()
+ }
+
+ jaspResults[["gaugeByOperator"]] <- createJaspPlot(title = gettext("Measurements by operator"),
+ width = 600, height = 600)
+ jaspResults[["gaugeByOperator"]]$position <- 11
+ jaspResults[["gaugeByOperator"]]$dependOn(c("operatorMeasurementPlot", "operatorWideFormat", "operatorLongFormat",
+ "partWideFormat", "partLongFormat", "measurementsWideFormat",
+ "measurementLongFormat", "report"))
+
+ if(!ready) {
+ return()
+ }
+
+ jaspResults[["gaugeByOperator"]]$plotObject <- .gaugeByOperatorGraphPlotObject(dataset, measurements, parts, operators, options, Type3)
+
+ return()
+}
+
+.createPartByOperatorInterPlot <- function(jaspResults, dataset, measurements, operators, parts, options, ready, Type3) {
+ if(!is.null(jaspResults[["gaugeByInteraction"]])) {
+ return()
+ }
+
+ jaspResults[["gaugeByInteraction"]] <- createJaspPlot(title = gettext("Part by operator interaction"),
+ width = 700, height = 400)
+ jaspResults[["gaugeByInteraction"]]$position <- 12
+ jaspResults[["gaugeByInteraction"]]$dependOn(c("partByOperatorMeasurementPlot", "operatorWideFormat", "operatorLongFormat",
+ "partWideFormat", "partLongFormat", "measurementsWideFormat",
+ "measurementLongFormat", "report"))
+
+ if(!ready) {
+ return()
+ }
+
+ jaspResults[["gaugeByInteraction"]]$plotObject <- .gaugeByInteractionGraphPlotFunction(dataset, measurements, parts, operators, options, Type3 = Type3, ggPlot = TRUE)
+
+ return()
+}
+
+.createVarCompPlot <- function(jaspResults, options, ready, plotOnly = FALSE) {
+ if(!plotOnly) {
+ if(!is.null(jaspResults[["varCompPlot"]])) {
+ return()
+ }
+ varCompPlot <- createJaspPlot(title = gettext("Components of variation"), width = 850, height = 500)
+ varCompPlot$position <- 6
+ varCompPlot$dependOn(c(.varCompTableDependencies(), "varianceComponentsGraph",
+ "tolerance", "toleranceValue",
+ "studyVarianceMultiplierType", "studyVarianceMultiplierValue"))
+ jaspResults[["varCompPlot"]] <- varCompPlot
+
+ if(!ready) {
+ return()
+ }
+ }
+ # obtain summaries
+ percContrib <- .percentSampleSummaries(jaspResults[["percContribSamples"]][["object"]], options)
+ percStudyVar <- .percentSampleSummaries(jaspResults[["percStudySamples"]][["object"]], options)
+
+ # remove unnecessary rows
+ percContrib <- percContrib[!percContrib$sourceName %in% c("Operator", "Total variation"), ]
+ percStudyVar <- percStudyVar[!percStudyVar$sourceName %in% c("Operator", "Total variation"), ]
+
+ # values for credible intervals
+ errorbarDf <- rbind(percContrib[, c("lower", "upper")], percStudyVar[, c("lower", "upper")])
+
+ # adding NAs for the reproducibility row because the plotting function expects the row to be present
+ if(options$type3) {
+ percContrib <- rbind(percContrib[1:2, ], NA, percContrib[3, ])
+ percStudyVar <- rbind(percStudyVar[1:2, ], NA, percStudyVar[3, ])
+ }
+
+ if(options$tolerance) {
+ percTol <- .percentSampleSummaries(jaspResults[["percTolSamples"]][["object"]], options)
+
+ # remove unnecessary rows
+ percTol <- percTol[!percTol$sourceName %in% c("Operator", "Total variation"), ]
+
+ errorbarDf <- rbind(errorbarDf, percTol[, c("lower", "upper")])
+
+ if(options$type3) {
+ percTol <- rbind(percTol[1:2, ], NA, percTol[3, ])
+ }
+
+ p <- .gaugeVarCompGraph(percContrib$means, percStudyVar$means, percTol$means,
+ errorbarDf = errorbarDf, Type3 = options$type3)
+ } else {
+ p <- .gaugeVarCompGraph(percContrib$means, percStudyVar$means, NA,
+ errorbarDf = errorbarDf, Type3 = options$type3)
+ }
+
+ if(plotOnly) {
+ return(p)
+ } else {
+ varCompPlot$plotObject <- p
+ }
+
+ return()
+}
+
+.createTrafficLightPlot <- function(jaspResults, options, ready, plotOnly = FALSE) {
+ if(!plotOnly) {
+ if(!is.null(jaspResults[["trafficPlot"]])) {
+ return()
+ }
+
+ trafficPlot <- createJaspContainer(title = gettext("Traffic light chart"))
+ trafficPlot$position <- 12
+ trafficPlot$dependOn(c(.varCompTableDependencies(), "trafficLightChart",
+ "tolerance", "toleranceValue",
+ "studyVarianceMultiplierType", "studyVarianceMultiplierValue"))
+ jaspResults[["trafficPlot"]] <- trafficPlot
+
+ if(!ready) {
+ jaspResults[["trafficPlot"]][["plot"]] <- createJaspPlot(width = 1000)
+ return()
+ }
+ }
+
+ # % Study var
+ percStudyVar <- .percentSampleSummaries(jaspResults[["percStudySamples"]][["object"]], options)
+ percStudyVar <- percStudyVar[percStudyVar$sourceName == "Total gauge r&R", ]
+ percStudyVarMean <- percStudyVar$means
+ percStudyVarCrI <- data.frame(lower = as.numeric(percStudyVar["lower"]),
+ upper = as.numeric(percStudyVar["upper"]))
+
+ if(!options$tolerance) {
+ p <- .trafficplot(StudyVar = percStudyVarMean, ToleranceUsed = FALSE,
+ ToleranceVar = 0,
+ options = options, ready = TRUE, StudyVarCi = percStudyVarCrI)
+ } else {
+ # % Tolerance
+ trafficPlotTol <- createJaspPlot(width = 1000)
+ trafficPlotTol$position <- 2
+ percTol <- .percentSampleSummaries(jaspResults[["percTolSamples"]][["object"]], options)
+ percTol <- percTol[percTol$sourceName == "Total gauge r&R", ]
+ percTolMean <- percTol$means
+ percTolCrI <- data.frame(lower = as.numeric(percTol["lower"]),
+ upper = as.numeric(percTol["upper"]))
+
+ p <- .trafficplot(StudyVar = percStudyVarMean, ToleranceUsed = TRUE,
+ ToleranceVar = percTolMean,
+ options = options, ready = TRUE,
+ StudyVarCi = percStudyVarCrI,
+ TolCi = percTolCrI,
+ ggPlot = plotOnly)
+ }
+
+ if(plotOnly) {
+ return(p)
+ } else {
+ trafficPlot[["trafficPlot"]] <- p
+ }
+ return()
+}
+
+#### Models & statistical computations
+.runMCMC <- function(jaspResults, dataset, measurements, parts, operators, options, ready){
+ if(is.null(jaspResults[["MCMCsamples"]]) && ready){
+ MCMCsamples <- createJaspState()
+ MCMCsamples$dependOn(.mcmcDependencies())
+ jaspResults[["MCMCsamples"]] <- MCMCsamples
+ } else {
+ return()
+ }
+
+ if(!options$type3){
+ # obtain BF in favor of full over main effects model
+ excludeInter <- .evalInter(jaspResults, parts, operators, options)
+ if(excludeInter){
+ formula <- as.formula(paste(measurements, "~", parts, "+", operators))
+ } else {
+ formula <- as.formula(paste(measurements, "~", parts, "*", operators))
+ }
+ # fit the model with BayesFactor
+ fit <- try(BayesFactor::lmBF(formula, whichRandom = c(parts, operators),
+ data = dataset, rscaleRandom = options$rscalePrior))
+ } else {
+ formula <- as.formula(paste(measurements, "~", parts))
+ fit <- try(BayesFactor::lmBF(formula, whichRandom = parts,
+ data = dataset, rscaleRandom = options$rscalePrior))
+ }
+
+ if(isTryError(fit)) {
+ .quitAnalysis(gettextf("The BayesFactor model could not be fit: %s", .rmNewLine(fit)))
+ }
+
+ nchains <- options$mcmcChains
+ burnin <- options$mcmcBurnin
+ iter <- options$mcmcIterations
+
+ # get relevant parameters
+ paramNames <- .bfParameterNames(parts, operators, excludeInter, options)
+ paramNames <- c(paramNames, "sig2")
+
+ # initiate array
+ mcmcArray <- array(dim = c(iter - burnin, nchains, length(paramNames)))
+
+ if(options$setSeed) {
+ set.seed(options$seed)
+ }
+
+ for(i in 1:nchains) {
+ # run chain
+ mcmcChain <- BayesFactor::posterior(fit, iterations = iter)
+
+ # select subset
+ mcmcChain <- as.matrix(mcmcChain)
+ mcmcChain <- mcmcChain[, paramNames]
+
+ # discard burnin
+ mcmcChain <- mcmcChain[-(1:burnin), ]
+
+ # revert standardization
+ for(j in paramNames[paramNames != "sig2"]) {
+ mcmcChain[, j] <- mcmcChain[, j] * mcmcChain[, "sig2"]
+ }
+
+ mcmcArray[, i, ] <- mcmcChain
+ }
+
+ dimnames(mcmcArray) <- list(NULL, NULL, paramNames)
+ MCMCsamples[["object"]] <- mcmcArray
+
+ return()
+}
+
+.getVarianceComponents <- function(jaspResults, parts, operators, options) {
+ excludeInter <- .evalInter(jaspResults, parts, operators, options)
+
+ # get components from MCMC samples
+ internalDF <- .getComponentsFromSamples(jaspResults, parts, operators, options, excludeInter)
+
+ # calculate summary stats
+ postMeans <- colMeans(internalDF)
+ postSds <- apply(internalDF, 2, sd)
+ postCrIlower <- apply(internalDF, 2, quantile, probs = 0.025)
+ postCrIupper <- apply(internalDF, 2, quantile, probs = 0.975)
+
+ # remove some stats when historicalSd is specified
+ if(options$processVariationReference == "historicalSd"){
+ postSds["part"] <- ""
+ postSds["total"] <- ""
+ postCrIlower["part"] <- ""
+ postCrIlower["total"] <- ""
+ postCrIupper["part"] <- ""
+ postCrIupper["total"] <- ""
+ }
+ sourceName <- .sourceNames(options)
+
+ return(data.frame(sourceName,
+ postMeans,
+ postSds,
+ postCrIlower,
+ postCrIupper)
+ )
+}
+
+.getComponentsFromSamples <- function(jaspResults, parts, operators, options, excludeInter){
+ # note this could be written into a helper function
+ sigmaPart <- paste0("g_", parts)
+ sigmaOperator <- paste0("g_", operators)
+ sigmaInter <- paste0("g_", parts, ":", operators)
+
+ samplesMat <- .arrayToMat(jaspResults[["MCMCsamples"]][["object"]])
+ samplesMat <- as.matrix(samplesMat)
+
+ repeatability <- samplesMat[, "sig2"]
+ part <- samplesMat[, sigmaPart]
+ if(!options$type3) {
+ # obtain relevant components
+ if(excludeInter){
+ reprod <- samplesMat[, sigmaOperator]
+ } else {
+ reprod <- samplesMat[, sigmaOperator] + samplesMat[, sigmaInter]
+ }
+ gauge <- reprod + repeatability
+ operator <- samplesMat[, sigmaOperator]
+ } else {
+ gauge <- repeatability
+ }
+ total <- gauge + part
+
+ # replace total variation with historical variance and adjust
+ # part variation accordingly
+ if(options$processVariationReference == "historicalSd"){
+ totalOld <- mean(total)
+ total <- rep(options$historicalSdValue^2, length(repeatability))
+ diffTotals <- total - totalOld
+ part <- mean(part) + diffTotals
+ }
+
+ if(!options$type3) {
+ internalDF <- data.frame(gauge,
+ repeatability,
+ reprod,
+ operator,
+ part,
+ total
+ )
+ } else {
+ internalDF <- data.frame(gauge,
+ repeatability,
+ part,
+ total)
+ }
+ return(internalDF)
+}
+
+.getDistinctCategories <- function(jaspResults, parts, operators, options) {
+ excludeInter <- .evalInter(jaspResults, parts, operators, options)
+ internalDf <- .getComponentsFromSamples(jaspResults, parts, operators, options, excludeInter)
+
+ # subset with relevant variables
+ internalDf <- internalDf[, colnames(internalDf) %in% c("gauge", "part")]
+ sdDf <- sqrt(internalDf)
+
+ # number distinct categories
+ nCat <- (sdDf$part / sdDf$gauge) * 1.41
+ mean <- mean(nCat)
+ lower <- quantile(nCat, probs = 0.025)
+ upper <- quantile(nCat, probs = 0.975)
+
+ # for footnote and report
+ res <- paste0(round(mean, 2), " (", round(lower, 2), ", ", round(upper, 2), ")")
+
+ return(res)
+}
+
+.getEllipses <- function(contourDf, mu, options, numberEllipses = 20, meanEllipse = FALSE) {
+
+ if(options$setSeed) {
+ set.seed(options$seed)
+ }
+ if(meanEllipse) {
+ sigmaP <- mean(contourDf$part)
+ sigmaTotal <- mean(contourDf$total)
+
+ covMat <- matrix(c(sigmaTotal, sigmaP,
+ sigmaP, sigmaP),
+ nrow = 2, ncol = 2)
+ res <- as.data.frame(try(ellipse::ellipse(covMat, centre = c(mu, mu), level = 0.95)))
+
+ if(isTryError(res)) {
+ return(res)
+ }
+ } else { # note: this part is currently not used
+ ind <- sample(1:nrow(contourDf), numberEllipses)
+ ellipseList <- lapply(ind, function(i) {
+ sigmaP <- contourDf[i, ]$part # part
+ sigmaTotal <- contourDf[i, ]$total # total
+
+ covMat <- matrix(c(sigmaTotal, sigmaP,
+ sigmaP, sigmaP),
+ nrow = 2, ncol = 2)
+
+ # ellipse
+ ellipseDf <- as.data.frame(try(ellipse::ellipse(covMat, centre = c(mu, mu), level = 0.95)))
+ ellipseDf$iter <- i
+
+ return(ellipseDf)
+ })
+ res <- do.call(rbind.data.frame, ellipseList)
+ }
+
+ return(res)
+}
+
+.getRisks <- function(contourDf, mu, options) {
+
+ USL <- options$contourUSL
+ LSL <- options$contourLSL
+ producers <- consumers <- c()
+
+ for (i in 1:nrow(contourDf)) {
+ sigmaP <- contourDf[i, ]$part # part
+ sigmaTotal <- contourDf[i, ]$total # total
+
+ covMat <- matrix(c(sigmaTotal, sigmaP,
+ sigmaP, sigmaP),
+ nrow = 2, ncol = 2)
+
+ # producer's risk (delta)
+ # probability that y falls outside although x is inside
+ numerator <- try(mvtnorm::pmvnorm(lower = c(-Inf, LSL), upper = c(LSL, USL), mean = c(mu, mu),
+ sigma = covMat) +
+ mvtnorm::pmvnorm(lower = c(USL, LSL), upper = c(Inf, USL), mean = c(mu, mu), sigma = covMat))
+
+ # the error likely occurs somewhere else
+ if(isTryError(numerator) || is.nan(numerator)) {
+ class(numerator) <- "try-error"
+ return(numerator)
+ }
+
+ denom <- pnorm(USL, mean = mu, sd = sqrt(sigmaP)) - pnorm(LSL, mean = mu, sd = sqrt(sigmaP))
+
+ if(isTryError(denom) || is.nan(denom)) {
+ class(denom) <- "try-error"
+ return(denom)
+ }
+
+ producers[i] <- numerator / denom
+
+ # consumers risk
+ # probability that y is inside although x falls outside
+ numerator <- try(mvtnorm::pmvnorm(lower = c(LSL, -Inf), upper = c(USL, LSL), mean = c(mu, mu),
+ sigma = covMat) +
+ mvtnorm::pmvnorm(lower = c(LSL, USL), upper = c(USL, Inf), mean = c(mu, mu), sigma = covMat))
+
+ if(isTryError(numerator) || is.nan(numerator)) {
+ class(numerator) <- "try-error"
+ return(numerator)
+ }
+
+ denom <- 1 - denom
+
+ consumers[i] <- numerator / denom
+ }
+ # this is the issue here
+ if(any(is.na(consumers)) || any(is.na(producers))) {
+ consumers <- "NA's introduced during calculation."
+ class(consumers) <- "try-error"
+ return(consumers)
+ }
+
+ df <- data.frame(delta = producers,
+ beta = consumers)
+ # means
+ means <- apply(df, 2, mean)
+
+ # CrIs
+ lower <- apply(df, 2, quantile, probs = 0.025)
+ upper <- apply(df, 2, quantile, probs = 0.975)
+
+ # unicodes
+ risks <- c("\u03b4", "\u03b2")
+
+ return(data.frame(risks,
+ means,
+ lower,
+ upper))
+
+}
+
+.getPercContrib <- function(jaspResults, parts, operators, options, ready) {
+ if(is.null(jaspResults[["percContribSamples"]]) && ready) {
+ percContribSamples <- createJaspState()
+ percContribSamples$dependOn(.varCompTableDependencies())
+ jaspResults[["percContribSamples"]] <- percContribSamples
+ } else {
+ return()
+ }
+
+ excludeInter <- .evalInter(jaspResults, parts, operators, options)
+
+ # get components from MCMC samples
+ internalDF <- .getComponentsFromSamples(jaspResults, parts, operators, options, excludeInter)
+
+ # %Contribution to total variance
+ contribution <- matrix(ncol = ncol(internalDF), nrow = nrow(internalDF))
+ for(i in 1:ncol(internalDF)){
+ contribution[, i] <- internalDF[[i]] / internalDF$total * 100
+ }
+
+ percContribSamples[["object"]] <- contribution
+
+ return()
+}
+
+.getPercStudy <- function(jaspResults, ready, studyVar = jaspResults[["studyVariation"]][["object"]][[1]]) {
+ if(is.null(jaspResults[["percStudySamples"]]) && ready) {
+ percStudySamples <- createJaspState()
+ percStudySamples$dependOn(c(.varCompTableDependencies(),
+ "studyVarianceMultiplierType", "studyVarianceMultiplierValue"))
+ jaspResults[["percStudySamples"]] <- percStudySamples
+ } else {
+ return()
+ }
+
+ percStudy <- matrix(ncol = ncol(studyVar), nrow = nrow(studyVar))
+ for(i in 1:ncol(studyVar)){
+ percStudy[, i] <- studyVar[[i]] / studyVar$total * 100
+ }
+
+ percStudySamples[["object"]] <- percStudy
+
+ return()
+}
+
+.getPercTol <- function(jaspResults, options, ready, studyVar = jaspResults[["studyVariation"]][["object"]][[1]]) {
+ if(is.null(jaspResults[["percTolSamples"]]) && ready) {
+ percTolSamples <- createJaspState()
+ percTolSamples$dependOn(c(.varCompTableDependencies(),
+ "studyVarianceMultiplierType", "studyVarianceMultiplierValue", "tolerance", "toleranceValue"))
+ jaspResults[["percTolSamples"]] <- percTolSamples
+ } else {
+ return()
+ }
+
+ percTol <- matrix(ncol = ncol(studyVar), nrow = nrow(studyVar))
+ for(i in 1:ncol(studyVar)){
+ percTol[, i] <- studyVar[[i]] / options$toleranceValue * 100
+ }
+
+ percTolSamples[["object"]] <- percTol
+
+ return()
+}
+
+.getStudyVariation <- function(jaspResults, parts, operators, options, ready) {
+ if(is.null(jaspResults[["studyVariation"]]) && ready) {
+ studyVariation <- createJaspState()
+ studyVariation$dependOn(c(.varCompTableDependencies(),
+ "studyVarianceMultiplierType", "studyVarianceMultiplierValue"))
+ jaspResults[["studyVariation"]] <- studyVariation
+ } else {
+ return()
+ }
+
+ excludeInter <- .evalInter(jaspResults, parts, operators, options)
+
+ # get components from MCMC samples
+ internalDF <- .getComponentsFromSamples(jaspResults, parts, operators, options, excludeInter)
+
+ sdDf <- sqrt(internalDF)
+
+ # get factor for multiplication
+ if(options$studyVarianceMultiplierType == "sd") {
+ factorSd <- options$studyVarianceMultiplierValue
+ } else {
+ val <- options$studyVarianceMultiplierValue / 100
+ q <- (1 - val) / 2
+ factorSd <- abs(2 * qnorm(q))
+ }
+ studyVar <- sdDf * factorSd
+
+ studyVariation[["object"]] <- list(studyVar, factorSd)
+
+ return()
+}
+
+#### helper functions
+.checkProbabilityEstimates <- function(estimates) {
+ l <- list()
+ # check for too large cut-off
+ l[["large"]] <- ifelse(anyNA(estimates), TRUE, FALSE)
+
+ # check for negative estimates
+ if(any(estimates[!is.na(estimates)] < 0)) {
+ estimates[!is.na(estimates) & estimates < 0] <- NA
+ l[["negative"]] <- TRUE
+ } else {
+ l[["negative"]] <- FALSE
+ }
+
+ l[["estimates"]] <- estimates
+
+ return(l)
+}
+
+.hasExtremeValues <- function(df) {
+ nums <- unlist(df, use.names = FALSE)
+ nums <- suppressWarnings(as.numeric(nums))
+ nums <- nums[!is.na(nums)]
+
+ res <- list(large = FALSE, small = FALSE)
+ if(sum(nums > 1e50) != 0) {
+ res$large <- TRUE
+ }
+
+ if(sum(nums < 1e-50) != 0) {
+ res$small <- TRUE
+ }
+
+ return(res)
+}
+
+.rmNewLine <- function(msg) {
+ msg <- gsub("\\n ", "", msg)
+ msg <- gsub("\\n", "", msg)
+
+ return(msg)
+}
+
+.getDistNames <- function(distType) {
+ switch(distType,
+ "gig" = "generalized inverse Gaussian",
+ "metalog" = "Metalog")
+}
+
+.bfParameterNames <- function(parts, operators, excludeInter, options) {
+ sigmaPart <- paste0("g_", parts)
+ sigmaOperator <- paste0("g_", operators)
+ sigmaInter <- paste0("g_", parts, ":", operators)
+
+ if(!options$type3) {
+ if(excludeInter) {
+ res <- c(sigmaPart, sigmaOperator)
+ } else {
+ res <- c(sigmaPart, sigmaOperator, sigmaInter)
+ }
+ } else {
+ res <- sigmaPart
+ }
+ return(res)
+}
+
+.evalInter <- function(jaspResults, parts, operators, options) {
+ if(options$estimationType == "automatic") {
+ bfDf <- jaspResults[["modelComparison"]][["object"]]
+ main <- paste(parts, "+", operators)
+
+ excludeInter <- bfDf[main, ]$comparisonBF <= options$bfFavorFull
+ }
+
+ if(options$estimationType == "manual"){
+ if(options$modelType == "fullModel"){
+ excludeInter <- FALSE
+ }
+
+ if(options$modelType == "mainEffectsOnly"){
+ excludeInter <- TRUE
+ }
+ }
+
+ return(excludeInter)
+}
+
+.sourceNames <- function(options) {
+ if(options$type3) {
+ res <- c("Total gauge r&R",
+ "Repeatability",
+ "Part-to-part",
+ "Total variation")
+ } else {
+ res <- c("Total gauge r&R",
+ "Repeatability",
+ "Reproducibility",
+ "Operator",
+ "Part-to-part",
+ "Total variation")
+ }
+
+ return(res)
+}
+
+.bfTableDependencies <- function() {
+ return(c("operatorWideFormat", "operatorLongFormat", "partWideFormat", "partLongFormat", "measurementsWideFormat",
+ "measurementLongFormat", "seed", "setSeed", "rscalePrior", "RRTable", "bfFavorFull", "report", "type3"))
+}
+
+.varCompTableDependencies <- function() {
+ return(c("operatorWideFormat", "operatorLongFormat", "partWideFormat", "partLongFormat", "measurementsWideFormat",
+ "measurementLongFormat", "seed", "setSeed", "rscalePrior", "bfFavorFull",
+ "mcmcChains", "mcmcBurnin", "mcmcIterations", "historicalSdValue", "processVariationReference",
+ "estimationType", "modelType", "report", "type3", "RRTable"))
+}
+
+.mcmcDependencies <- function() {
+ return(c("operatorWideFormat", "operatorLongFormat", "partWideFormat", "partLongFormat", "measurementsWideFormat",
+ "measurementLongFormat", "seed", "setSeed", "rscalePrior", "bfFavorFull",
+ "mcmcChains", "mcmcBurnin", "mcmcIterations",
+ "estimationType", "modelType", "report", "type3"))
+}
+
+.postPlotDependencies <- function() {
+ return(c("posteriorCi", "posteriorCiLower", "posteriorCiMass", "posteriorCiType", "posteriorCiUpper",
+ "posteriorPointEstimate", "posteriorPointEstimateType", "posteriorPlot",
+ "distType", "posteriorPlotType", "tolerance", "toleranceValue", "posteriorHistogram", "report", "type3",
+ "processVariationReference", "historicalSdValue", "customCiType",
+ "posteriorCiCutOff"))
+}
+
+.convertOutputNames <- function(name, parts, operators, includeSigma = TRUE) {
+ sigmaPart <- paste0("g_", parts)
+ sigmaOperator <- paste0("g_", operators)
+ sigmaInter <- paste0("g_", parts, ":", operators)
+ if(includeSigma) {
+ replPart <- "\u03C32Part"
+ replOperator <- "\u03C32Operator"
+ replInter <- "\u03C32Part\u2009\u273B\u2009Operator"
+ replError <- "\u03C32Error"
+ } else {
+ replPart <- "Part"
+ replOperator <- "Operator"
+ replInter <- "Part\u2009\u273B\u2009Operator"
+ replError <- "Error"
+ }
+
+ name <- sub(sigmaInter, replInter, name)
+ name <- sub(sigmaPart, replPart, name)
+ name <- sub(sigmaOperator, replOperator, name)
+ name <- sub("sig2", replError, name)
+
+ return(name)
+}
+
+.percentSampleSummaries <- function(samples, options) {
+ sourceName <- .sourceNames(options)
+ means <- colMeans(samples)
+ lower <- apply(samples, 2, quantile, probs = 0.025)
+ upper <- apply(samples, 2, quantile, probs = 0.975)
+
+ df <- data.frame(sourceName,
+ means,
+ lower,
+ upper)
+
+ # remove upper and lower CrI for total variation
+ df[df$sourceName == "Total variation", c("lower", "upper")] <- "" # note: this coerces the whole columns to be of type chr
+
+ # remove upper and lower CrI for part variation if historicalSd is specified
+ if(options$processVariationReference == "historicalSd") {
+ df[df$sourceName == "Part-to-part", c("lower", "upper")] <- ""
+ }
+ return(df)
+}
+
+.fillTablesGaugeEval <- function(jaspResults, parts, operators, options, whichTable = "sd", gaugeReport = FALSE) {
+ excludeInter <- .evalInter(jaspResults, parts, operators, options)
+
+ # get components from MCMC samples
+ internalDF <- .getComponentsFromSamples(jaspResults, parts, operators, options, excludeInter)
+
+ sourceName <- .sourceNames(options)
+
+ sdDf <- sqrt(internalDF)
+
+ # Study variation
+ studyVar <- jaspResults[["studyVariation"]][["object"]][[1]]
+
+ # % Study Variation
+ percStudy <- jaspResults[["percStudySamples"]][["object"]]
+
+ # % Tolerance
+ if(options$tolerance) {
+ percTol <- jaspResults[["percTolSamples"]][["object"]]
+ }
+
+ # output dependent on table
+ if(whichTable == "sd") {
+ # summaries
+ # note: here I could use the .percentSampleSummaries function
+ means <- colMeans(sdDf)
+ lower <- apply(sdDf, 2, quantile, probs = 0.025)
+ upper <- apply(sdDf, 2, quantile, probs = 0.975)
+ }
+
+ if(whichTable == "studyVar") {
+ if(!gaugeReport) {
+ # add footnote
+ factorSd <- jaspResults[["studyVariation"]][["object"]][[2]]
+
+ if(factorSd == as.integer(factorSd)) {
+ jaspResults[["gaugeEvaluation"]][["stdTable"]]$addFootnote(gettextf("Study variation is calculated as std. dev. × %d", factorSd))
+ } else {
+ jaspResults[["gaugeEvaluation"]][["stdTable"]]$addFootnote(gettextf("Study variation is calculated as std. dev. × %.2f", factorSd))
+ }
+ }
+
+ # summaries
+ means <- colMeans(studyVar)
+ lower <- apply(studyVar, 2, quantile, probs = 0.025)
+ upper <- apply(studyVar, 2, quantile, probs = 0.975)
+ }
+
+ if(whichTable == "percStudyVar") {
+ # summaries
+ means <- colMeans(percStudy)
+ lower <- apply(percStudy, 2, quantile, probs = 0.025)
+ upper <- apply(percStudy, 2, quantile, probs = 0.975)
+ }
+
+ if(whichTable == "percTol") {
+ # summaries
+ means <- colMeans(percTol)
+ lower <- apply(percTol, 2, quantile, probs = 0.025)
+ upper <- apply(percTol, 2, quantile, probs = 0.975)
+ }
+
+ df <- data.frame(sourceName,
+ means,
+ lower,
+ upper)
+
+ if(whichTable == "percStudyVar") {
+ # remove upper and lower CrI for total variation
+ df[df$sourceName == "Total variation", c("lower", "upper")] <- ""
+ }
+
+
+ if(options$processVariationReference == "historicalSd") {
+ # remove upper and lower CrI for part variation if historicalSd is specified
+ df[df$sourceName == "Part-to-part", c("lower", "upper")] <- ""
+
+ # remove upper and lower CrI for total variation
+ df[df$sourceName == "Total variation", c("lower", "upper")] <- ""
+ }
+
+ colnames(df) <- switch(whichTable,
+ "sd" = c("sourceName", "meansStd", "lowerStd", "upperStd"),
+ "studyVar" = c("sourceName", "meansStudyVar", "lowerStudyVar", "upperStudyVar"),
+ "percStudyVar" = c("sourceName", "meansPercStudy", "lowerPercStudy", "upperPercStudy"),
+ "percTol" = c("sourceName", "meansPercTol", "lowerPercTol", "upperPercTol"))
+
+ return(df)
+}
+
+.convertToWide <- function(dataset, measurements, parts, operators) {
+ dataset <- dplyr::ungroup(
+ dplyr::mutate(
+ dplyr::group_by(dataset, dplyr::across(dplyr::all_of(c(parts, operators)))),
+ trial = dplyr::row_number()
+ )
+ )
+
+ dataWide <- tidyr::pivot_wider(dataset, id_cols = c(parts, operators), values_from = measurements,
+ names_from = trial, names_prefix = "V")
+ dataWide <- as.data.frame(dataWide)
+ dataWide <- dataWide[order(dataWide[, parts]), ]
+
+ return(dataWide)
+}
+
+.convertToLong <- function(dataset, measurements) {
+ dataset <- tidyr::pivot_longer(dataset, cols = tidyr::all_of(measurements),
+ values_to = "Measurements", names_to = NULL)
+ return(dataset)
+}
+
+#### Distribution fitting
+
+### fit functions
+.fitDistToSamples <- function(jaspResults, options, ready) {
+ if(is.null(jaspResults[["distFit"]]) && ready){
+ distFit <- createJaspState()
+ distFit$dependOn(c(.mcmcDependencies(), "distType", "posteriorPlotType",
+ "processVariationReference", "historicalSdValue",
+ "tolerance", "toleranceValue"))
+ jaspResults[["distFit"]] <- distFit
+ } else {
+ return()
+ }
+
+ samplesMat <- switch(options$posteriorPlotType,
+ "var" = .arrayToMat(jaspResults[["MCMCsamples"]][["object"]]),
+ "percContrib" = jaspResults[["percContribSamples"]][["object"]],
+ "percStudyVar" = jaspResults[["percStudySamples"]][["object"]],
+ "percTol" = jaspResults[["percTolSamples"]][["object"]])
+
+ if(options$posteriorPlotType != "var") {
+ colnames(samplesMat) <- .sourceNames(options)
+
+ # filter out columns that only have the same value
+ samplesMat <- samplesMat[, apply(samplesMat, 2, function(col) length(unique(col)) > 1)]
+
+ # remove part-to-part variation if historical sd is specified
+ if(options$processVariationReference == "historicalSd"){
+ samplesMat <- samplesMat[, !colnames(samplesMat) %in% "Part-to-part"]
+ }
+ }
+
+ # note: I could also pass a list with distribution names and fitting functions here
+ distType <- options$distType
+
+ if(options$setSeed) {
+ set.seed(options$seed)
+ }
+ fit <- try(
+ switch(distType,
+ "metalog" =
+ if(options$posteriorPlotType == "var" || options$posteriorPlotType == "percTol" ||
+ options$processVariationReference == "historicalSd") {
+ .fitMetaLog(samplesMat, bounds = 0, boundedness = "sl",
+ term_lower_bound = 5, term_limit = 5) # 5 terms
+ } else {
+ .fitMetaLog(samplesMat, bounds = c(0, 100), boundedness = "b",
+ term_lower_bound = 5, term_limit = 5) # 5 terms
+ },
+ "gig" = .fitGIG(samplesMat))
+ )
+
+ distFit[["object"]] <- fit
+
+ return()
+}
+
+## MetaLog
+.fitMetaLog <- function(samplesMat, ...) {
+ # fit metalog to each parameter
+ metaLogList <- apply(samplesMat, 2,
+ function(x) rmetalog::metalog(x, ...))
+ return(metaLogList)
+}
+
+## Generalized Inverse Gaussian
+.fitGIG <- function(samplesMat) {
+ gigFitList <- apply(samplesMat, 2,
+ function(x) GeneralizedHyperbolic::gigFit(x))
+
+ # add random samples
+ gigFitList <- lapply(gigFitList,
+ function(x) {
+ x$randData <- GeneralizedHyperbolic::rgig(1e5, param = x$param)
+ return(x)
+ })
+ return(gigFitList)
+}
+
+
+#### posterior summary
+.fillPostSummaryTable <- function(jaspResults, options, parts, operators, ready) {
+ if(is.null(jaspResults[["postSummaryStats"]]) && (options$posteriorCi || options$posteriorPointEstimate) && ready){
+ postSummaryStats <- createJaspState()
+ postSummaryStats$dependOn(c(.varCompTableDependencies(),
+ .postPlotDependencies()))
+ jaspResults[["postSummaryStats"]] <- postSummaryStats
+ } else {
+ return()
+ }
+
+ fits <- jaspResults[["distFit"]][["object"]]
+
+ if(isTryError(fits)) {
+ jaspResults[["postSummaryStats"]][["object"]] <- fits
+ return()
+ }
+
+ if(options$posteriorPlotType == "var") {
+ parameter <- .convertOutputNames(names(fits), parts, operators)
+ } else {
+ parameter <- names(fits)
+ }
+
+ # point estimates
+ if(options$posteriorPointEstimate) {
+ # list with functions for different distributions
+ pointEstimateFunctions <- .pointEstimateFunctions()
+
+ # select the right function
+ pointFun <- pointEstimateFunctions[[options$distType]][[options$posteriorPointEstimateType]]
+
+ pointEstimate <- switch(options$posteriorPointEstimateType,
+ "mean" = unlist(lapply(fits, pointFun)),
+ "median" = unlist(lapply(fits, pointFun)),
+ "mode" = unlist(lapply(fits, pointFun)))
+ }
+
+ # intervals
+ if(options$posteriorCi) {
+ # list with functions for different distributions
+ intervalFunctions <- .intervalFunctions()
+
+ # select the right function
+ interFun <- intervalFunctions[[options$distType]][[options$posteriorCiType]]
+
+ if(options$setSeed) {
+ set.seed(options$seed)
+ }
+
+ intervals <- switch(options$posteriorCiType,
+ "central" = Map(interFun, fits, mass = options$posteriorCiMass),
+ "HPD" = Map(interFun, fits, mass = options$posteriorCiMass),
+ "custom" = Map(interFun, fits,
+ lower = options$posteriorCiLower,
+ upper = options$posteriorCiUpper,
+ cutoff = options$posteriorCiCutOff,
+ options = rep(list(options), length(fits)))
+ )
+
+ if(options$posteriorCiType != "custom" || (options$posteriorCiType == "custom" && options$customCiType != "customCiCutOff")) {
+ # lower and upper bounds separately
+ lower <- sapply(intervals, function(x) x[1])
+ upper <- sapply(intervals, function(x) x[2])
+ }
+ }
+
+ if(options$posteriorPointEstimate && options$posteriorCi == FALSE) {
+ df <- data.frame(parameter,
+ pointEstimate)
+ } else if(options$posteriorPointEstimate == FALSE && options$posteriorCi) {
+ if(options$posteriorCiType != "custom" || (options$posteriorCiType == "custom" && options$customCiType != "customCiCutOff")) {
+ df <- data.frame(parameter,
+ ciLower = lower,
+ ciUpper = upper)
+ } else {
+ df <- data.frame(parameter,
+ belowCutOff = unlist(intervals))
+ }
+ } else {
+ if(options$posteriorCiType != "custom" || (options$posteriorCiType == "custom" && options$customCiType != "customCiCutOff")) {
+ df <- data.frame(parameter,
+ pointEstimate,
+ ciLower = lower,
+ ciUpper = upper)
+ } else {
+ df <- data.frame(parameter,
+ pointEstimate,
+ belowCutOff = unlist(intervals))
+ }
+ }
+ postSummaryStats[["object"]] <- df
+
+ return()
+}
+
+### functions point estimates
+.pointEstimateFunctions <- function() {
+ l <- list(
+ metalog = list(
+ mean = .meanMetaLog,
+ median = .medianMetaLog,
+ mode = .modeMetaLog
+ ),
+ gig = list(
+ mean = .meanGIG,
+ median = .medianGIG,
+ mode = .modeGIG
+ )
+ )
+ return(l)
+}
+
+## MetaLog
+.meanMetaLog <- function(fit) {
+ m <- integrate(rmetalog::qmetalog, m = fit, term = fit$params$term_limit,
+ lower = 0, upper = 1)$value
+}
+
+.medianMetaLog <- function(fit) {
+ m <- rmetalog::qmetalog(m = fit, y = 0.5, term = fit$params$term_limit)
+}
+
+.modeMetaLog <- function(fit) {
+ m <- optimize(rmetalog::dmetalog, interval = c(0, max(fit$dataValues[1])),
+ m = fit, term = fit$params$term_limit, maximum = TRUE)$maximum
+}
+
+## Generalized Inverse Gaussian
+.meanGIG <- function(fit) {
+ m <- GeneralizedHyperbolic::gigMean(param = fit$param)
+}
+
+.medianGIG <- function(fit) {
+ m <- quantile(fit$randData, probs = 0.5)
+}
+
+.modeGIG <- function(fit) {
+ m <- GeneralizedHyperbolic::gigMode(param = fit$param)
+}
+
+### functions interval estimates
+.intervalFunctions <- function() {
+ l <- list(
+ metalog = list(
+ central = .centralInterMetaLog,
+ HPD = .hdiMetaLog,
+ custom = .customInterMetaLog
+ ),
+ gig = list(
+ central = .centralInterGIG,
+ HPD = .hdiGIG,
+ custom = .customInterGIG
+ )
+ )
+}
+
+## MetaLog
+.centralInterMetaLog <- function(fit, mass) {
+ lower <- (1 - mass) / 2
+ upper <- 1 - lower
+ int <- rmetalog::qmetalog(m = fit, y = c(lower, upper), term = fit$params$term_limit)
+}
+
+.hdiMetaLog <- function(fit, mass) {
+ samples <- rmetalog::rmetalog(m = fit, n = 1e5, term = fit$params$term_limit)
+ int <- HDInterval::hdi(samples, credMass = mass)
+}
+
+.customInterMetaLog <- function(fit, lower, upper, cutoff, options) {
+ if(options$customCiType == "customCiQuantiles") {
+ int <- rmetalog::qmetalog(m = fit, y = c(lower, upper), term = fit$params$term_limit)
+ return(int)
+ } else {
+ res <- try(rmetalog::pmetalog(m = fit, q = cutoff, term = fit$params$term_limit),
+ silent = TRUE)
+
+ if(isTryError(res))
+ return(NA)
+
+ return(res)
+ }
+}
+
+## Generalized inverse Gaussian
+.centralInterGIG <- function(fit, mass) {
+ lower <- (1 - mass) / 2
+ upper <- 1 - lower
+ int <- quantile(fit$randData, probs = c(lower, upper))
+}
+
+.hdiGIG <- function(fit, mass) {
+ int <- HDInterval::hdi(fit$randData, credMass = mass)
+}
+
+.customInterGIG <- function(fit, lower, upper, cutoff, options) {
+ if(options$customCiType == "customCiQuantiles") {
+ int <- quantile(fit$randData, probs = c(lower, upper))
+ return(int)
+ } else {
+ res <- tryCatch(
+ {
+ GeneralizedHyperbolic::pgig(q = cutoff, param = fit$param)
+ },
+ warning = function(w) {
+ return(NA)
+ },
+ error = function(e) {
+ return(NA)
+ }
+ )
+
+ return(res)
+ }
+}
+
+## axis limits
+.axisLimFuns <- function() {
+ l <- list(
+ metalog = .axisLimsMetaLog,
+ gig = .axisLimsGIG
+ )
+ return(l)
+}
+
+# Metalog
+.axisLimsMetaLog <- function(fit, postSummary, options, iter, histDens = 0) {
+
+ dfTemp <- fit$dataValues
+ m <- .modeMetaLog(fit)
+
+ if(options$posteriorCi) {
+ xUpper <- max(dfTemp[dfTemp$probs >= 0.99, ]$x_new[1], postSummary[iter, "ciUpper"])
+ } else {
+ xUpper <- dfTemp[dfTemp$probs >= 0.99, ]$x_new[1]
+ }
+
+ if(options$posteriorPlotType != "var" && options$posteriorPlotType != "percTol" &&
+ options$processVariationReference != "historicalSd") {
+ xUpper <- 100
+ }
+
+ xLower <- 0
+ xLims <- c(xLower, xUpper)
+ xBreaks <- jaspGraphs::getPrettyAxisBreaks(xLims)
+ xLims <- c(xBreaks[1], xBreaks[length(xBreaks)])
+
+ yUpper <- max(rmetalog::dmetalog(m = fit, q = m, term = fit$params$term_limit),
+ histDens)
+ yLower <- 0
+ yLims <- c(yLower, yUpper)
+ yBreaks <- jaspGraphs::getPrettyAxisBreaks(yLims)
+ yLims <- c(yBreaks[1], yBreaks[length(yBreaks)])
+
+ l <- list(
+ x = list(limits = xLims,
+ breaks = xBreaks),
+ y = list(limits = yLims,
+ breaks = yBreaks)
+ )
+ return(l)
+}
+
+# Generalized inverse Gaussian
+.axisLimsGIG <- function(fit, postSummary, options, iter, histDens = 0) {
+
+ quant <- quantile(fit$randData, 0.99) # for upper xLim
+ m <- .modeGIG(fit)
+
+ if(options$posteriorCi) {
+ xUpper <- max(quant, postSummary[iter, "ciUpper"])
+ } else {
+ xUpper <- quant
+ }
+
+ if(options$posteriorPlotType != "var" && options$posteriorPlotType != "percTol") {
+ xUpper <- 100
+ }
+
+ xLower <- 0
+ xLims <- c(xLower, xUpper)
+ xBreaks <- jaspGraphs::getPrettyAxisBreaks(xLims)
+ xLims <- c(xBreaks[1], xBreaks[length(xBreaks)])
+
+ yUpper <- max(GeneralizedHyperbolic::dgig(x = m, param = fit$param),
+ histDens)
+ yLower <- 0
+ yLims <- c(yLower, yUpper)
+ yBreaks <- jaspGraphs::getPrettyAxisBreaks(yLims)
+ yLims <- c(yBreaks[1], yBreaks[length(yBreaks)])
+
+ l <- list(
+ x = list(limits = xLims,
+ breaks = xBreaks),
+ y = list(limits = yLims,
+ breaks = yBreaks)
+ )
+ return(l)
+}
+
+### MCMC diagnostics
+
+## main function
+.mcmcDiagnostics <- function(jaspResults, parts, operators, options, ready) {
+ if(!is.null(jaspResults[["mcmcDiagnostics"]])) {
+ return()
+ }
+ mcmcDiagnostics <- createJaspContainer(title = gettext("MCMC diagnostics"))
+ mcmcDiagnostics$position <- 5
+ mcmcDiagnostics$dependOn(c(.mcmcDependencies(),
+ "diagnosticsPlots", "diagnosticsPlotType",
+ "diagnosticsTable"))
+ jaspResults[["mcmcDiagnostics"]] <- mcmcDiagnostics
+
+ # initialize plot if data is not ready
+ if(options$diagnosticsPlots && !ready) {
+ jaspResults[["mcmcDiagnostics"]][["plot"]] <- createJaspPlot(width = 600, height = 320)
+ }
+
+ if(options$diagnosticsTable) {
+ diagnosticsTable <- createJaspTable()
+ diagnosticsTable$position <- 1
+ mcmcDiagnostics[["table"]] <- diagnosticsTable
+
+ diagnosticsTable$addColumnInfo(name = "parameter", title = gettext("Parameter"), type = "string")
+ diagnosticsTable$addColumnInfo(name = "essBulk", title = gettext("ESS (Bulk)"), type = "number")
+ diagnosticsTable$addColumnInfo(name = "essTail", title = gettext("ESS (Tail)"), type = "number")
+ diagnosticsTable$addColumnInfo(name = "rhat", title = gettext("Rhat"), type = "number")
+ diagnosticsTable$addColumnInfo(name = "mcseMean", title = gettext("MCSE (Mean)"), type = "number")
+ diagnosticsTable$addColumnInfo(name = "mcseQuantileLower", title = gettext("0.025"), type = "number", overtitle = gettext("MCSE (Quantiles)"))
+ diagnosticsTable$addColumnInfo(name = "mcseQuantileUpper", title = gettext("0.975"), type = "number", overtitle = gettext("MCSE (Quantiles)"))
+
+ if(!ready) {
+ return()
+ }
+
+ # general input needed for the sub-functions
+ chains <- jaspResults[["MCMCsamples"]][["object"]]
+ excludeInter <- .evalInter(jaspResults, parts, operators, options)
+
+ paramNames <- .bfParameterNames(parts, operators, excludeInter, options)
+ paramNames <- c(paramNames, "sig2")
+
+ fillDat <- .fillDiagnosticsTable(chains = posterior::as_draws_array(chains),
+ paramNames = .convertOutputNames(paramNames, parts, operators, includeSigma = TRUE))
+
+ if(.hasExtremeValues(fillDat)$large) {
+ diagnosticsTable$addFootnote(gettext("Estimates are very large potentially making results unreliable. Consider transfroming the data."),
+ symbol = gettext("Warning:"))
+ }
+
+ if(.hasExtremeValues(fillDat)$small) {
+ diagnosticsTable$addFootnote(gettext("Estimates are very small potentially making results unreliable. Consider transfroming the data."),
+ symbol = gettext("Warning:"))
+ }
+
+ if(any(is.na(fillDat))) {
+ diagnosticsTable$addFootnote(gettext("Some diagnostics could not be calculated. Results might be unreliable."),
+ symbol = gettext("Warning:"))
+ }
+
+ diagnosticsTable$setData(fillDat)
+ }
+
+ if(options$diagnosticsPlots) {
+ switch(options$diagnosticsPlotType,
+ "trace" = .tracePlot(jaspResults, chains = posterior::as_draws_array(chains), paramNames,
+ xLabs = .convertOutputNames(paramNames, parts, operators, includeSigma = FALSE)),
+ "autocor" = .autocorPlot(jaspResults, chains = chains, paramNames,
+ titles = .convertOutputNames(paramNames, parts, operators, includeSigma = FALSE)),
+ "density" = .densityDiagnosticsPlot(jaspResults, chains = posterior::as_draws_array(chains), paramNames,
+ xLabs = .convertOutputNames(paramNames, parts, operators, includeSigma = FALSE)))
+ }
+
+ return()
+}
+
+# function MCMC diagnostics table
+.fillDiagnosticsTable <- function(chains, paramNames) {
+ # note: posterior::ess_bulk(posteriorChains[,, "sig2"]) # this gives a different result compared to using apply??
+ essBulk <- apply(chains, 3, posterior::ess_bulk)
+ essTail <- apply(chains, 3, posterior::ess_tail)
+ rhat <- apply(chains, 3, posterior::rhat)
+ mcseMean <- apply(chains, 3, posterior::mcse_mean)
+ mcseQuantileLower <- apply(chains, 3, posterior::mcse_quantile, probs = c(0.025, 0.975))[1, ] # 0.025
+ mcseQuantileUpper <- apply(chains, 3, posterior::mcse_quantile, probs = c(0.025, 0.975))[2, ] # 0.975
+
+ return(data.frame(parameter = paramNames,
+ essBulk,
+ essTail,
+ rhat,
+ mcseMean,
+ mcseQuantileLower,
+ mcseQuantileUpper
+ ))
+}
+
+# plotting functions for diagnostics
+.tracePlot <- function(jaspResults, chains, paramNames, xLabs) {
+ colors <- rep_len(rstan:::rstanvis_aes_ops("chain_colors"), dim(chains)[2])
+
+ for(i in seq_along(paramNames)) {
+ tempPlot <- createJaspPlot(width = 600, height = 320)
+
+ # obtain y lims
+ dat <- chains[, , paramNames[i]]
+ yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(min(dat), max(dat)))
+ yLims <- c(yBreaks[1], yBreaks[length(yBreaks)])
+
+ p <- bayesplot::mcmc_trace(chains, pars = paramNames[i]) +
+ ggplot2::scale_color_manual(values = colors) +
+ jaspGraphs::themeJaspRaw() +
+ jaspGraphs::geom_rangeframe() +
+ ggplot2::scale_y_continuous(bquote(sigma[.(xLabs[i])]^2),
+ breaks = yBreaks,
+ limits = yLims)
+
+ tempPlot$plotObject <- p
+ jaspResults[["mcmcDiagnostics"]][[paramNames[i]]] <- tempPlot
+ }
+ return()
+}
+
+.autocorPlot <- function(jaspResults, chains, paramNames, titles) {
+ colors <- rep_len(rstan:::rstanvis_aes_ops("chain_colors"), dim(chains)[2])
+
+ for(i in seq_along(paramNames)) {
+ tempPlot <- createJaspPlot(width = 500, height = 320)
+
+ # obtain data for plotting
+ dat <- chains[, , paramNames[i]]
+ l <- apply(dat, 2, acf, lag.max = 20, plot = FALSE)
+ l <- lapply(l, function(x) list(acf = x$acf, lag = x$lag))
+ df <- do.call(rbind.data.frame, l)
+ df$chain <- factor(rep(1:dim(dat)[2], each = length(l[[1]]$lag)))
+
+ p <- ggplot2::ggplot(df, ggplot2::aes(x = lag, y = acf, color = chain)) +
+ ggplot2::geom_line() +
+ ggplot2::geom_hline(yintercept = 0, alpha = 0.5) +
+ ggplot2::scale_color_manual(values = colors) +
+ jaspGraphs::themeJaspRaw() +
+ jaspGraphs::geom_rangeframe() +
+ ggplot2::labs(x = "Lag", y = "Autocorrelation") +
+ ggplot2::labs(title = bquote(sigma[.(titles[i])]^2))
+
+ tempPlot$plotObject <- p
+ jaspResults[["mcmcDiagnostics"]][[paramNames[i]]] <- tempPlot
+ }
+ return()
+}
+
+.densityDiagnosticsPlot <- function(jaspResults, chains, paramNames, xLabs) {
+ colors <- rep_len(rstan:::rstanvis_aes_ops("chain_colors"), dim(chains)[2])
+
+ for(i in seq_along(paramNames)) {
+ tempPlot <- createJaspPlot(width = 600, height = 320)
+
+ # initilize plot
+ p <- bayesplot::mcmc_dens_overlay(chains, pars = paramNames[i])
+
+ d <- density(chains[, , paramNames[i]], n = 64000)
+
+ # x-lims
+ m <- quantile(chains[, , paramNames[i]], 0.5)
+ xUpper <- d$x[d$y < 1e-3 & d$x > m][1]
+ xLower <- quantile(chains[, , paramNames[i]], 0.001)
+ xLower <- ifelse(xLower < 1, 0, xLower)
+ xLims <- c(xLower, xUpper)
+
+ manualScaleX <- FALSE
+ if(!anyNA(xLims)) {
+ manualScaleX <- TRUE
+ axisBreaksX <- jaspGraphs::getPrettyAxisBreaks(xLims)
+ xLims <- c(axisBreaksX[1], axisBreaksX[length(axisBreaksX)])
+ }
+
+ # y-lims
+ yValues <- d$y
+ padding <- 0.05 * diff(range(yValues))
+ yLims <- c(0, max(yValues) + padding)
+ axisBreaksY <- jaspGraphs::getPrettyAxisBreaks(yLims)
+ yLims <- c(axisBreaksY[1], axisBreaksY[length(axisBreaksY)])
+
+ # aesthetics
+ p <- p +
+ ggplot2::scale_color_manual(values = colors) +
+ ggplot2::xlab(bquote(sigma[.(xLabs[i])]^2)) +
+ ggplot2::xlim(xLims)
+
+ if(manualScaleX) {
+ p <- p + ggplot2::scale_x_continuous(limits = xLims,
+ breaks = axisBreaksX)
+ }
+
+ p <- p + jaspGraphs::themeJaspRaw() +
+ jaspGraphs::geom_rangeframe() +
+ ggplot2::scale_y_continuous("Density", limits = yLims,
+ breaks = axisBreaksY) +
+ ggplot2::theme(axis.ticks.y = ggplot2::element_line())
+
+ tempPlot$plotObject <- p
+ jaspResults[["mcmcDiagnostics"]][[paramNames[i]]] <- tempPlot
+ }
+ return()
+}
+
+
+.arrayToMat <- function(array) {
+ mat <- matrix(array, nrow = prod(dim(array)[1:2]), ncol = dim(array)[3])
+ colnames(mat) <- dimnames(array)[[3]]
+ return(mat)
+}
+
+
+### Report
+.reportDependencies <- function() {
+ return(c("report", "reportMetaData", "reportTitle",
+ "reportTitleText", "reportPartName", "reportPartNameText", "reportGaugeName",
+ "reportGaugeNameText", "reportCharacteristic", "reportCharacteristicText",
+ "reportGaugeNumber", "reportGaugeNumberText", "reportTolerance", "reportToleranceText",
+ "reportLocation", "reportLocationText", "reportPerformedBy", "reportPerformedByText",
+ "reportDate", "reportDateText", "reportVariationComponents", "reportMeasurementsByPartPlot",
+ "reportRChartByOperator", "reportMeasurementsByOperatorPlot", "reportAverageChartByOperator",
+ "reportPartByOperatorPlot", "reportTrafficLightChart", "reportMetaData"))
+}
+
+.getReportTitle <- function(options) {
+ if (options[["reportTitle"]] ) {
+ title <- if (options[["reportTitleText"]] == "") gettext("Gauge r&R report") else options[["reportTitleText"]]
+ } else {
+ title <- ""
+ }
+ return(title)
+}
+
+.getReportMetaData <- function(options) {
+ if (options[["reportMetaData"]]) {
+ text <- c()
+ text <- if (options[["reportPartName"]]) c(text, gettextf("Part name: %s", options[["reportPartNameText"]])) else text
+ text <- if (options[["reportGaugeName"]]) c(text, gettextf("Gauge name: %s", options[["reportGaugeNameText"]])) else text
+ text <- if (options[["reportCharacteristic"]]) c(text, gettextf("Characteristic: %s", options[["reportCharacteristicText"]])) else text
+ text <- if (options[["reportGaugeNumber"]]) c(text, gettextf("Gauge number: %s", options[["reportGaugeNumberText"]])) else text
+ text <- if (options[["reportTolerance"]]) c(text, gettextf("Tolerance: %s", options[["reportToleranceText"]])) else text
+ text <- if (options[["reportLocation"]]) c(text, gettextf("Location: %s", options[["reportLocationText"]])) else text
+ text <- if (options[["reportPerformedBy"]]) c(text, gettextf("Performed by: %s", options[["reportPerformedByText"]])) else text
+ text <- if (options[["reportDate"]]) c(text, gettextf("Date: %s", options[["reportDateText"]])) else text
+ } else {
+ text <- NULL
+ }
+
+ return(text)
+}
+
+.getReportPlots <- function(jaspResults, dataset, measurements, parts, operators, options) {
+
+ plots <- list()
+ plotIndexCounter <- 1
+ if (options[["reportVariationComponents"]]) {
+ plots[[plotIndexCounter]] <- .createVarCompPlot(jaspResults, options, plotOnly = TRUE)
+ plotIndexCounter <- plotIndexCounter + 1
+ }
+ if (options[["reportMeasurementsByPartPlot"]]) {
+ plots[[plotIndexCounter]] <- .gaugeByPartGraphPlotObject(dataset, measurements, parts, operators, displayAll = FALSE) #measurement by part plot
+ plotIndexCounter <- plotIndexCounter + 1
+ }
+ if (options[["reportRChartByOperator"]]) {
+ ruleList1 <- .getRuleListSubgroupCharts(options, "R")
+ plots[[plotIndexCounter]] <- .controlChart(dataset = dataset[c(measurements, operators)],
+ plotType = "R", ruleList = ruleList1, stages = operators,
+ xAxisLabels = dataset[[parts]][order(dataset[[operators]])],
+ stagesSeparateCalculation = FALSE)$plotObject
+ plotIndexCounter <- plotIndexCounter + 1
+ }
+ if (options[["reportMeasurementsByOperatorPlot"]]) {
+ plots[[plotIndexCounter]] <- .gaugeByOperatorGraphPlotObject(dataset, measurements, parts, operators, options, Type3 = options$type3) #Measurements by operator plot
+ plotIndexCounter <- plotIndexCounter + 1
+ }
+ if (options[["reportAverageChartByOperator"]]) {
+ ruleList2 <- .getRuleListSubgroupCharts(options, "xBar")
+ plots[[plotIndexCounter]] <- .controlChart(dataset = dataset[c(measurements, operators)],
+ plotType = "xBar", ruleList = ruleList2, xBarSdType = "r", stages = operators,
+ xAxisLabels = dataset[[parts]][order(dataset[[operators]])],
+ stagesSeparateCalculation = FALSE)$plotObject
+ plotIndexCounter <- plotIndexCounter + 1
+ }
+ if (options[["reportPartByOperatorPlot"]]) {
+ plots[[plotIndexCounter]] <- .gaugeByInteractionGraphPlotFunction(dataset, measurements, parts, operators, options,
+ Type3 = options$type3, ggPlot = TRUE) # Part x Operator interaction plot
+ plotIndexCounter <- plotIndexCounter + 1
+ }
+
+ if (options[["reportTrafficLightChart"]]) {
+ trafficPlots <- .createTrafficLightPlot(jaspResults, options, plotOnly = TRUE)
+ if (options[["tolerance"]]) {
+ plots[[plotIndexCounter]] <- trafficPlots$p1
+ plotIndexCounter <- plotIndexCounter + 1
+ plots[[plotIndexCounter]] <- trafficPlots$p2
+ } else {
+ plots[[plotIndexCounter]] <- trafficPlots$plotObject
+ }
+ }
+
+ return(plots)
+}
+
+.getReportTable <- function(jaspResults, parts, operators, options) {
+ dfs <- list()
+ tables <- c("sd", "studyVar", "percStudyVar")
+ colNames <- c("Source", "Std. dev.", "Study variation", "%Study variation")
+ if(options$tolerance) {
+ tables <- c(tables, "percTol")
+ colNames <- c(colNames, "%Tolerance")
+ }
+
+ for(i in seq_along(tables)) {
+ dfs[[i]] <- .fillTablesGaugeEval(jaspResults, parts, operators, options, whichTable = tables[i],
+ gaugeReport = TRUE)
+ }
+
+ out <- lapply(dfs, .extractCiAndPaste)
+ out <- lapply(out, function(x) sub(" \\(NA, NA\\)", "", x)) # remove empty CrIs
+ out <- do.call(cbind.data.frame, out)
+ out <- cbind.data.frame(dfs[[1]]$sourceName, out)
+ colnames(out) <- colNames
+
+ # number of distinct categories
+ nDistinctDf <- data.frame("Number of distinct categories",
+ .getDistinctCategories(jaspResults, parts, operators, options))
+ colnames(nDistinctDf) <- NULL
+
+ # split data frame as it would otherwise be cut off in the report
+ if(options$tolerance) {
+ tolOut <- out[, c("Source", "%Tolerance")]
+ out <- out[, colnames(out) != "%Tolerance"]
+ return(list(list(out, nDistinctDf), tolOut))
+ }
+
+ return(list(list(out, nDistinctDf)))
+}
+
+.extractCiAndPaste <- function(df) {
+ means <- as.numeric(df$means)
+ lower <- as.numeric(df$lower)
+ upper <- as.numeric(df$upper)
+ res <- paste0(round(means, 2), " (", round(lower, 2), ", ", round(upper, 2), ")")
+
+ return(res)
+}
+
+.createGaugeReport <- function(jaspResults, dataset, measurements, parts, operators, options, ready) {
+ nElements <- sum(options[["reportVariationComponents"]], options[["reportMeasurementsByPartPlot"]], options[["reportRChartByOperator"]],
+ options[["reportMeasurementsByOperatorPlot"]], options[["reportAverageChartByOperator"]],
+ options[["reportPartByOperatorPlot"]], options[["reportTrafficLightChart"]], options[["reportMetaData"]])
+ plotHeight <- ceiling(nElements/2) * 500
+ reportPlot <- createJaspPlot(title = gettext("Gauge r&R report"), width = 1250, height = plotHeight)
+ jaspResults[["report"]] <- reportPlot
+ jaspResults[["report"]]$dependOn(c("type3", "tolerance", "toleranceValue", "studyVarianceMultiplierType",
+ "studyVarianceMultiplierValue", "scatterPlotFitLine", "scatterPlotOriginLine",
+ "partMeasurementPlotAllValues", .varCompTableDependencies(), .reportDependencies()))
+
+ if (nElements == 0) {
+ reportPlot$setError(gettext("No report components selected."))
+ return()
+ }
+
+ if(!ready) {
+ return()
+ }
+
+ # title
+ title <- .getReportTitle(options)
+
+ # meta data
+ text <- .getReportMetaData(options)
+
+ # plots
+ plots <- .getReportPlots(jaspResults, dataset, measurements, parts, operators, options)
+
+ # table
+ tables <- .getReportTable(jaspResults, parts, operators, options)
+ if(options$tolerance) {
+ tableTitles <- list(list("Gauge evaluation", ""), "")
+ } else {
+ tableTitles <- list(list("Gauge evaluation", ""))
+ }
+
+ reportPlotObject <- .qcReport(text = text, plots = plots, tables = tables, textMaxRows = 8,
+ tableTitles = tableTitles, reportTitle = title, tableSize = 6)
+ reportPlot$plotObject <- reportPlotObject
+
+ return()
+}
+
+### Data reading & error checks
+.msabComputeDerivedOptions <- function(options) {
+ wideFormat <- options[["dataFormat"]] == "wideFormat"
+ if (wideFormat) {
+ options$measurements <- unlist(options[["measurementsWideFormat"]])
+ options$parts <- unlist(options[["partWideFormat"]])
+ options$operators <- unlist(options[["operatorWideFormat"]])
+ } else {
+ options$measurements <- unlist(options[["measurementLongFormat"]])
+ options$parts <- unlist(options[["partLongFormat"]])
+ options$operators <- unlist(options[["operatorLongFormat"]])
+ }
+
+ if(options$type3) {
+ options$operators <- "operators"
+ }
+
+ options$wideFormat <- wideFormat
+
+ # rule set for xBar and R charts
+ options$testSet <- "jaspDefault"
+
+ return(options)
+}
+
+.msabIsReady <- function(options) {
+ wideFormat <- options$wideFormat
+ if (wideFormat && !options[["type3"]]) {
+ ready <- (length(options$measurements) > 1 && !identical(options$operators, "") && !identical(options$parts, ""))
+ } else if (wideFormat && options[["type3"]]) {
+ ready <- (length(options$measurements) > 1 && !identical(options$parts, ""))
+ } else if (!wideFormat && !options[["type3"]]) {
+ ready <- (options$measurements != "" && !identical(options$operators, "") && !identical(options$parts, ""))
+ } else if (!wideFormat && options[["type3"]]) {
+ ready <- (!identical(options$measurements, "") && !identical(options$parts, ""))
+ }
+
+ if(options$estimationType == "manual"){
+ if(options$modelType == "fullModel" || options$modelType == "mainEffectsOnly") {
+ ready <- ready
+ } else {
+ ready <- FALSE
+ }
+ }
+
+ return(ready)
+}
+
+.msabReadDataset <- function(dataset, options, ready) {
+ wideFormat <- options$wideFormat
+ numericVars <- options$measurements
+ numericVars <- numericVars[numericVars != ""]
+ factorVars <- c(options$parts, options$operators)
+ factorVars <- factorVars[factorVars != "" & factorVars != "operators"]
+
+ if (is.null(dataset)) {
+ dataset <- .readDataSetToEnd(columns.as.numeric = numericVars, columns.as.factor = factorVars)
+ if (options$type3){
+ dataset$operators <- rep(1, nrow(dataset))
+ }
+ }
+
+ datasets <- list()
+ # Converting wide to long format
+ if(wideFormat && ready) {
+ datasets[["dataWide"]] <- dataset # wide data for plotting functions
+ datasets[["dataLong"]] <- .convertToLong(dataset, options$measurements)
+ }
+
+ if(!wideFormat && ready) {
+ datasets[["dataLong"]] <- dataset
+ datasets[["dataWide"]] <- .convertToWide(dataset, options$measurements, options$parts, options$operators)
+ }
+
+ return(datasets)
+}
+
+.msabAdjustVarNames <- function(options, dataWide, ready) {
+ if(options$wideFormat && ready) {
+ options$measurements <- "Measurements" # name assigned to the column inside the conversion function
+ }
+
+ if(!is.null(dataWide)) {
+ # names of measurement columns in wide format
+ options$measurementsWide <- colnames(dataWide)[!colnames(dataWide) %in% c(options$parts, options$operators)]
+ }
+
+ return(options)
+}
+
+.msabCheckErrors <- function(jaspResults, options, ready, dataset, dataWide) {
+ measurements <- options[["measurements"]]
+ parts <- options[["parts"]]
+ operators <- options[["operators"]]
+
+ # check for equal amount of replicates
+ if(anyNA(dataWide)) {
+ errorMsg <- gettext("Number of replicates differ per operator/part. Make sure that each operator measures each part equally often.")
+ .quitAnalysis(errorMsg)
+ }
+
+ # Checking for infinity and missingValues
+ .hasErrors(dataset, type = c('infinity', 'missingValues'),
+ infinity.target = measurements,
+ missingValues.target = c(measurements, parts, operators),
+ exitAnalysisIfErrors = TRUE)
+
+ if(ready && !options[["type3"]]){
+ crossed <- .checkIfCrossed(dataset, operators, parts, measurements)
+ if(!crossed){
+ plot <- createJaspPlot(title = gettext("Gauge r&R"), width = 700, height = 400)
+ jaspResults[["plot"]] <- plot
+ plot$setError(gettext("Design is not balanced: not every operator measured every part. Use non-replicable gauge r&R."))
+ return()
+ }
+ }
+
+ # Checking whether type3 is used correctly
+ Type3 <- c(length(unique(dataset[[operators]])) == 1 || options$type3)
+ .hasErrors(dataset,
+ target = measurements,
+ custom = function() {
+ if (Type3 && !options$type3)
+ return("This dataset seems to have only a single unique operator. Please use the Type 3 study by checking the box below.")},
+ exitAnalysisIfErrors = TRUE)
+
+ # Checking whether the format wide is used correctly
+ if (ready)
+ .hasErrors(dataWide,
+ target = measurements,
+ custom = function() {
+ dataToBeChecked <- dataWide[dataWide[[operators]] == dataWide[[operators]][1],]
+ partsLevels <- length(levels(dataToBeChecked[[parts]]))
+ partsLength <- length(dataToBeChecked[[parts]])
+ if (options$wideFormat && partsLevels != partsLength && !Type3)
+ return(gettextf("The measurements selected seem to be in a 'Single Column' format as every operator's part is measured %d times.", partsLength/partsLevels))},
+ exitAnalysisIfErrors = FALSE)
+}
diff --git a/R/msaGaugeRR.R b/R/msaGaugeRR.R
index f6d0cacd..188af74a 100644
--- a/R/msaGaugeRR.R
+++ b/R/msaGaugeRR.R
@@ -902,7 +902,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
return(p)
}
-.gaugeVarCompGraph <- function(percentContributionValues, studyVariationValues, percentToleranceValues, Type3 = FALSE) {
+.gaugeVarCompGraph <- function(percentContributionValues, studyVariationValues, percentToleranceValues, Type3 = FALSE, errorbarDf = NULL) {
sources <- gettext(c('Gauge r&R', 'Repeat', 'Reprod', 'Part-to-part'))
if (!all(is.na(percentToleranceValues))) {
references <- gettextf(c('%% Contribution', '%% Study variation', '%% Tolerance'))
@@ -923,7 +923,26 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
p <- ggplot2::ggplot() +
ggplot2::geom_bar(data = plotframe, mapping = ggplot2::aes(fill = reference, y = value, x = source),
- position="dodge", stat = "identity") +
+ position="dodge", stat = "identity")
+
+ # add errorbars
+ if(!is.null(errorbarDf)) {
+ errorbarDf$source <- plotframe$source
+ errorbarDf$reference <- plotframe$reference
+ errorbarDf$lower <- as.numeric(errorbarDf$lower)
+ errorbarDf$upper <- as.numeric(errorbarDf$upper)
+
+ p <- p + ggplot2::geom_errorbar(data = errorbarDf,
+ ggplot2::aes(x = plotframe$source,
+ ymax = upper, ymin = lower,
+ fill = plotframe$reference),
+ position = ggplot2::position_dodge(0.9),
+ size = 0.5, width = 0.5)
+ yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, plotframe$value,
+ errorbarDf$lower,
+ errorbarDf$upper))
+ }
+ p <- p +
jaspGraphs::themeJaspRaw() +
jaspGraphs::geom_rangeframe() +
ggplot2::theme(legend.position = 'right', legend.title = ggplot2::element_blank()) +
@@ -1061,7 +1080,7 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
}
return(TRUE)
}
-.trafficplot <- function(StudyVar = "", ToleranceUsed = FALSE, ToleranceVar = "", options, ready, Xlab.StudySD = "", Xlab.Tol = "", ggPlot = FALSE) {
+.trafficplot <- function(StudyVar = "", ToleranceUsed = FALSE, ToleranceVar = "", options, ready, Xlab.StudySD = "", Xlab.Tol = "", ggPlot = FALSE, StudyVarCi = NULL, TolCi = NULL) {
if (!ready)
return()
@@ -1100,6 +1119,11 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
if (Xlab.StudySD != "")
p1 <- p1 + ggplot2::scale_x_continuous(breaks = c(0,10,30,100), labels = c("0%","10%","30%","100%"), name = gettext(Xlab.StudySD))
+ if(!is.null(StudyVarCi)) {
+ StudyVarCi$upper <- ifelse(StudyVarCi$upper > 100, 100, StudyVarCi$upper)
+ p1 <- p1 + ggplot2::geom_errorbarh(data = StudyVarCi, ggplot2::aes(xmin = lower, xmax = upper, y = 1),
+ inherit.aes = FALSE, linewidth = 0.5, height = 0.5)
+ }
if (ToleranceUsed){
p2 <- ggplot2::ggplot(mat[c(4:6),], ggplot2::aes(x = x, y = Yes, fill = fill)) +
@@ -1118,6 +1142,12 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
if (Xlab.Tol != "")
p2 <- p2 + ggplot2::scale_x_continuous(breaks = c(0,10,30,100), labels = c("0%","10%","30%","100%"), name = gettext(Xlab.Tol))
+ if(!is.null(TolCi)) {
+ TolCi$upper <- ifelse(TolCi$upper > 100, 100, TolCi$upper)
+ p2 <- p2 + ggplot2::geom_errorbarh(data = TolCi, ggplot2::aes(xmin = lower, xmax = upper, y = 1),
+ inherit.aes = FALSE, linewidth = 0.5, height = 0.5)
+ }
+
p3 <- jaspGraphs::ggMatrixPlot(plotList = list(p2, p1), layout = matrix(2:1, 2))
Plot$plotObject <- p3
diff --git a/inst/Description.qml b/inst/Description.qml
index 446bcff9..f2f04bfa 100644
--- a/inst/Description.qml
+++ b/inst/Description.qml
@@ -29,6 +29,13 @@ Description
title: qsTr("Type 2 and 3 Gauge r&R Study")
func: "msaGaugeRR"
}
+
+ Analysis
+ {
+ title: qsTr("Type 2 and 3 Bayesian Gauge r&R Study")
+ func: "msaBayesianGaugeRR"
+ }
+
Analysis
{
title: qsTr("Gauge r&R Study (Non-replicable Measurements)")
diff --git a/inst/help/msaBayesianGaugeRR.md b/inst/help/msaBayesianGaugeRR.md
new file mode 100644
index 00000000..dece2d34
--- /dev/null
+++ b/inst/help/msaBayesianGaugeRR.md
@@ -0,0 +1,119 @@
+Bayesian Gauge r&R
+==========================
+Gauge Repeatability and Reproducibility (Gauge R & R) is an analysis aimed at defining the amount of variation in measurements given a measurement system.
+The variation detected in the measurement is sourced in two factors, repeatability (equipment variation) and reproducibility (operator variation).
+This analysis offers a Bayesian implementation of Gauge R & R.
+
+## Input
+### Data Format
+-------
+Data can be in the form of all observations in one column ("Single column") or across rows with a subgroup index ("Across rows").
+
+### Assignment Box
+- Operators: the operators in the measurement system.
+- Parts: the parts of the measurement system.
+- Measurements: the observations/data collected from a process.
+
+### Gauge r&R Method
+The method used in the analysis.
+- Linear random effects model: The analysis is based on a linear random effects model, also called random effects ANOVA (for more information about the model, see Rouder et al., 2012).
+
+### Options
+#### Analysis options
+- Estimation: either automatic based on a cut-off Bayes factor (BF) or a manual choice between main effects only or full model.
+- Cut-off BF: cut-off for the BF in favor of the full model that needs to be reached for the full model to be chosen over the model only including main effects in automatic estimation.
+- Process variation reference: either a historically known standard deviation (Historical standard deviation) or estimated from the data (Study variation).
+- Tolerance: include a value for tolerance.
+- r&R table options:
+ - Study Var. multiplier type: multiplier based on either Std. Deviation or Percent.
+ - Study Var. multiplier value: value for the multiplier.
+
+#### Plots
+- Prior: g-prior used in the analysis.
+- Posterior: posterior distribution on variances, %Contribution, %Study variation or %Tolerance
+ - Display histogram: plot histogram of Markov Chain Monte Carlo (MCMC) samples.
+ - Point estimate: display posterior mean, median or mode.
+ - CI: display central, highest posterior density or custom credible interval.
+ - Mass: percentage of posterior mass that the credible interval covers. For custom intervals, bounds can be specified.
+- Contour plot: 95% contour of a multivariate normal distribution based on sample measurement mean and average posterior part and total variation (Mader et al., 1999).
+- Components of variation: bar chart for components of variation with 95% credible intervals.
+- Range charts by operator: control chart on the range.
+- Average chart by operator: control chart on the mean.
+- Scatter plots by operators: scatterplot matrix for operators.
+- Measurements by part plot: average measurement for each part.
+ - Display all measurements: individual measurements are shown.
+- Measurements by operator plot: boxplots of measurements by operator.
+- Part x operator interaction plot: average measurement for each part with separate lines for operators.
+- Traffic light chart: traffic light plots for %Study variation and %Tolerance with 95% credible intervals.
+
+#### MCMC diagnostics
+- Diagnostics table: table with statistics.
+- Plots: diagnostic plots.
+ - Traceplot
+ - Autocorrelation
+ - Density
+
+#### Advanced options
+- Priors
+ - r scale prior: square root of the scale for the inverse chi-square g-prior.
+- MCMC options
+ - Chains: number of MCMC chains to run.
+ - Iterations per chain: iterations for each chain.
+ - Burn-in per chain: number of initial samples discarded from each chain.
+- Repeatability
+ - Set seed: specify seed to keep results constant.
+- Distribution fit to MCMC samples: distritbution that is fit to the MCMC samples for the posterior plots.
+ - For variance posteriors, either a generalized inverse Gaussian or a metalog distribution.
+ - For all other posteriors, the metalog is used.
+
+#### Report options
+- Create a gauge R & R report.
+
+## Output
+-------
+- Model Comparison:
+ - BF10: shows the Bayes factor in favor of the full model compared to the model in each row.
+ - error %: percent error in BF estimation.
+- Variance Components:
+ - Mean: posterior mean
+ - Std. Deviation: standard deviation of the posterior distribution.
+- % Contribution to Total Variation: posterior summaries for percent contribution of each component to the total variation.
+- Standard Deviation & Study Variation: posterior summaries for standard deviations and study variation.
+- % Study variation & % Tolerance: posterior summaries for percent of study variation and tolerance.
+- MCMC diagnostics:
+ - ESS (Bulk): effective sample size in the bulk of the distribution.
+ - ESS (Tail): effective sample size in the tails of the distribution.
+ - Rhat: convergence diagnostic that compares between- to within-chain variance. Values larger than 1.01 indicate potential problems (Vehtari et al., 2021).
+ - MCSE: markov chain standard error for the estimator indicated in parentheses.
+- Posterior distributions
+ - Posterior Summary: posterior summaries based on the distribution fit to the MCMC samples.
+- Contour plot: posterior summaries for producer's and consumer's risk.
+
+## References
+-------
+- Duncan, A.J. (1986), Quality control and industrial statistics, Richard D. Irwin, Inc., and Automotive Industry Action Group (July 2005), Statistical process control (SPC) – Reference manual, AIAG.
+- Dodson, B., Lynch, D., Weidenbacher, M., & Klerx, R. (2009). *Statistical process control handbook*. SKF group.
+- Mader, D. P., Prins, J., & Lampe, R. E. (1999). THE ECONOMIC EVIPACT OF MEASUREMENT ERROR. *Quality Engineering, 11*(4), 563–574. https://doi.org/10.1080/08982119908919276
+- Montgomery, D. C. (2013). *Introduction to statistical quality control* (7th ed.). John Wiley
+& Sons.
+- Rouder, J. N., Morey, R. D., Speckman, P. L., & Province, J. M. (2012). Default Bayes factors for ANOVA designs. *Journal of Mathematical Psychology, 56*(5), 356–374. https://doi.org/10.1016/j.jmp.2012.08.001
+- Stan Development Team. 2024. Stan Reference Manual, 2.36. https://mc-stan.org
+- Vehtari, A., Gelman, A., Simpson, D., Carpenter, B., & Bürkner, P.-C. (2021). Rank-normalization, folding, and localization: An improved $\widehat{R}$ for assessing convergence of MCMC. *Bayesian Analysis, 16*(2). https://doi.org/10.1214/20-BA1221
+
+## R Packages
+-------
+- jaspGraphs
+- jaspBase
+- ggplot2
+- tidyr
+- dplyr
+- BayesFactor
+- ellipse
+- mvtnorm
+- rmetalog
+- GeneralizedHyperbolic
+- HDInterval
+- extraDistr
+- posterior
+- rstan
+- bayesplot
\ No newline at end of file
diff --git a/inst/qml/msaBayesianGaugeRR.qml b/inst/qml/msaBayesianGaugeRR.qml
new file mode 100644
index 00000000..510ab3d5
--- /dev/null
+++ b/inst/qml/msaBayesianGaugeRR.qml
@@ -0,0 +1,894 @@
+// 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
+
+Form
+{
+ columns: 1
+
+ DropDown
+ {
+ name: "dataFormat"
+ label: qsTr("Data format")
+ id: dataFormat
+ indexDefaultValue: 0
+ values:
+ [
+ { label: qsTr("Single column"), value: "longFormat"},
+ { label: qsTr("Across rows"), value: "wideFormat"},
+ ]
+ onValueChanged:
+ {
+ measurementsWideFormat.itemDoubleClicked(0)
+ measurementLongFormat.itemDoubleClicked(0)
+ }
+ }
+
+ VariablesForm
+ {
+ id: variablesFormLongFormat
+ visible: dataFormat.currentValue === "longFormat"
+
+ AvailableVariablesList
+ {
+ name: "variablesFormLongFormat"
+ }
+
+ AssignedVariablesList
+ {
+ name: "measurementLongFormat"
+ title: qsTr("Measurement")
+ id: measurementLongFormat
+ singleVariable: true
+ allowedColumns: ["scale"]
+ }
+
+ AssignedVariablesList
+ {
+ name: "operatorLongFormat"
+ title: qsTr("Operator")
+ id: operatorLongFormat
+ singleVariable: true
+ allowedColumns: ["nominal"]
+ enabled: !type3.checked
+ }
+
+ AssignedVariablesList
+ {
+ name: "partLongFormat"
+ title: qsTr("Part")
+ singleVariable: true
+ allowedColumns: ["nominal"]
+ }
+ }
+
+ VariablesForm
+ {
+ id: variablesFormWideFormat
+ visible: dataFormat.currentValue === "wideFormat"
+
+ AvailableVariablesList
+ {
+ name: "variablesFormWideFormat"
+ }
+
+ AssignedVariablesList
+ {
+ name: "measurementsWideFormat"
+ title: qsTr("Measurements")
+ id: measurementsWideFormat
+ singleVariable: false
+ allowedColumns: ["scale"]
+ }
+
+ AssignedVariablesList
+ {
+ name: "operatorWideFormat"
+ title: qsTr("Operator")
+ id: operatorWideFormat
+ singleVariable: true
+ allowedColumns: ["nominal"]
+ enabled: !type3.checked
+ }
+
+ AssignedVariablesList
+ {
+ name: "partWideFormat"
+ title: qsTr("Part")
+ singleVariable: true
+ allowedColumns: ["nominal"]
+ }
+ }
+
+ CheckBox
+ {
+ name: "type3"
+ id: type3
+ label: qsTr("Type 3 study (automatic equipment)")
+ onCheckedChanged:
+ {
+ rChart.checked = false
+ xBarChart.checked = false
+ scatterPlot.checked = false
+ operatorMeasurementPlot.checked = false
+ partByOperatorMeasurementPlot.checked = false
+ }
+ }
+
+ Group
+ {
+ title: qsTr("Analysis options")
+
+ DropDown
+ {
+ name: "estimationType"
+ label: qsTr("Estimation")
+ id: estimationType
+ indexDefaultValue: 0
+ visible: !type3.checked
+ values:
+ [
+ { label: qsTr("Automatic"), value: "automatic" },
+ { label: qsTr("Manual"), value: "manual" },
+ ]
+ }
+
+ DoubleField
+ {
+ name: "bfFavorFull"
+ label: qsTr("Cut-off BF in favor of full model")
+ id: bfFavorFull
+ defaultValue: 1
+ min: 0
+ inclusive: JASP.None
+ decimals: 3
+ visible: !type3.checked && estimationType.currentValue === "automatic"
+ }
+
+ RadioButtonGroup
+ {
+ name: "modelType"
+ visible: !type3.checked
+
+ RadioButton
+ {
+ name: "fullModel"
+ label: qsTr("Full model")
+ id: fullModel
+ checked: true
+ visible: estimationType.currentValue === "manual"
+ }
+
+ RadioButton
+ {
+ name: "mainEffectsOnly"
+ label: qsTr("Main effects only")
+ id: mainEffectsOnly
+ checked: false
+ visible: estimationType.currentValue === "manual"
+ }
+ }
+
+
+
+ DropDown
+ {
+ name: "processVariationReference"
+ label: qsTr("Process variation based on")
+ id: variationReference
+ indexDefaultValue: 0
+ values:
+ [
+ { label: qsTr("Study variation"), value: "studySd" },
+ { label: qsTr("Historical standard deviation"), value: "historicalSd" }
+ ]
+ }
+
+ DoubleField
+ {
+ name: "historicalSdValue"
+ label: qsTr("Historical standard deviation:")
+ defaultValue: 3
+ min: 0
+ inclusive: JASP.None
+ decimals: 9
+ enabled: variationReference.currentValue === "historicalSd"
+ }
+
+ CheckBox
+ {
+ name: "tolerance"
+ label: qsTr("Tolerance width")
+ id: tolerance
+ childrenOnSameRow: true
+
+ DoubleField
+ {
+ name: "toleranceValue"
+ id: toleranceValue
+ defaultValue: 10
+ min: 0
+ inclusive: JASP.None
+ decimals: 9
+ }
+ }
+
+ CheckBox
+ {
+ name: "RRTable"
+ label: qsTr("r&R table")
+ checked: true
+
+ DropDown
+ {
+ name: "studyVarianceMultiplierType"
+ label: qsTr("Study var. multiplier type")
+ id: studyVarianceMultiplierType
+ indexDefaultValue: 0
+ values:
+ [
+ { label: qsTr("Std. Deviation"), value: "sd" },
+ { label: qsTr("Percent"), value: "percent" }
+ ]
+ }
+
+ DoubleField
+ {
+ name: "studyVarianceMultiplierValue"
+ label: qsTr("Study var. multiplier value")
+ fieldWidth: 60
+ defaultValue: 6
+ min: 0
+ max: 100
+ inclusive: JASP.None
+ decimals: 3
+ }
+ }
+
+ }
+
+ Section
+ {
+ title: qsTr("Plots")
+ columns: 2
+
+ Group
+ {
+ CheckBox
+ {
+ name: "priorPlot"
+ label: qsTr("Prior")
+ checked: false
+ }
+
+ CheckBox
+ {
+ name: "posteriorPlot"
+ label: qsTr("Posterior")
+ checked: false
+
+ DropDown
+ {
+ name: "posteriorPlotType"
+ label: ""
+ id: posteriorPlotType
+ values: tolerance.checked ? [
+ { label: qsTr("Variances"), value: "var" },
+ { label: qsTr("%Contribution"), value: "percContrib"},
+ { label: qsTr("%Study variation"), value: "percStudyVar"},
+ { label: qsTr("%Tolerance"), value: "percTol"}
+ ] : [
+ { label: qsTr("Variances"), value: "var" },
+ { label: qsTr("%Contribution"), value: "percContrib"},
+ { label: qsTr("%Study variation"), value: "percStudyVar"}
+ ]
+ }
+
+ CheckBox
+ {
+ label: qsTr("Display histogram")
+ name: "posteriorHistogram"
+ }
+
+ CheckBox
+ {
+ label: qsTr("Point estimate")
+ name: "posteriorPointEstimate"
+ childrenOnSameRow: true
+ checked: true
+
+ DropDown
+ {
+ name: "posteriorPointEstimateType"
+ label: ""
+ values:
+ [
+ { label: qsTr("mean"), value: "mean" },
+ { label: qsTr("median"), value: "median" },
+ { label: qsTr("mode"), value: "mode" }
+ ]
+ }
+ }
+
+ CheckBox
+ {
+ name: "posteriorCi"
+ label: qsTr("CI")
+ id: posteriorCi
+ childrenOnSameRow: true
+ checked: false
+
+ DropDown
+ {
+ name: "posteriorCiType"
+ label: ""
+ values:
+ [
+ { label: qsTr("central"), value: "central" },
+ { label: qsTr("HPD"), value: "HPD" },
+ { label: qsTr("custom"), value: "custom" }
+ ]
+ id: posteriorCiType
+ }
+ }
+
+ Group
+ {
+ columns: 2
+
+ CIField
+ {
+ visible: posteriorCiType.currentText === "central" || posteriorCiType.currentText === "HPD"
+ enabled: posteriorCi.checked
+ name: "posteriorCiMass"
+ label: qsTr("Mass")
+ fieldWidth: 50
+ defaultValue: 95
+ min: 1
+ max: 100
+ inclusive: JASP.MinOnly
+ }
+
+ RadioButtonGroup
+ {
+ name: "customCiType"
+ visible: posteriorCiType.currentText === "custom"
+ enabled: posteriorCi.checked
+
+ RadioButton
+ {
+ name: "customCiQuantiles"
+ visible: posteriorCiType.currentText === "custom"
+ label: qsTr("Quantiles")
+ enabled: posteriorCi.checked
+ checked: true
+
+ Group
+ {
+ columns: 2
+ DoubleField
+ {
+ visible: posteriorCiType.currentText === "custom"
+ enabled: posteriorCi.checked
+ name: "posteriorCiLower"
+ label: qsTr("Lower")
+ id: posteriorCiLower
+ fieldWidth: 50
+ defaultValue: 0.25
+ min: 0
+ max: posteriorCiUpper.value
+ inclusive: JASP.None
+ }
+
+ DoubleField
+ {
+ visible: posteriorCiType.currentText === "custom"
+ enabled: posteriorCi.checked
+ name: "posteriorCiUpper"
+ label: qsTr("Upper")
+ id: posteriorCiUpper
+ fieldWidth: 50
+ defaultValue: 0.75
+ min: posteriorCiLower.value
+ max: 1
+ inclusive: JASP.None
+ }
+ }
+
+ }
+
+ RadioButton
+ {
+ name: "customCiCutOff"
+ visible: posteriorCiType.currentText === "custom"
+ label: qsTr("Cut-off")
+ enabled: posteriorCi.checked
+
+ DoubleField
+ {
+ name: "posteriorCiCutOff"
+ visible: posteriorCiType.currentText === "custom"
+ enabled: posteriorCi.checked
+ fieldWidth: 50
+ defaultValue: 10
+ decimals: 3
+ min: 0
+ inclusive: JASP.None
+ }
+ }
+ }
+ }
+ }
+
+ CheckBox
+ {
+ name: "contourPlot"
+ label: qsTr("Contour plot")
+
+ DoubleField
+ {
+ name: "contourLSL"
+ label: qsTr("Lower specification limit")
+ id: contourLSL
+ fieldWidth: 60
+ negativeValues: true
+ defaultValue: -1
+ max: contourUSL.value
+ inclusive: JASP.None
+ }
+
+ DoubleField
+ {
+ name: "contourUSL"
+ label: qsTr("Upper specification limit")
+ id: contourUSL
+ fieldWidth: 60
+ defaultValue: 1
+ negativeValues: true
+ min: contourLSL.value
+ inclusive: JASP.None
+ }
+ }
+ }
+
+ Group
+ {
+ CheckBox
+ {
+ name: "varianceComponentsGraph"
+ label: qsTr("Components of variation")
+ checked: true
+ }
+
+ CheckBox
+ {
+ name: "rChart"
+ id: rChart
+ label: qsTr("Range charts by operator")
+ enabled: !type3.checked
+ }
+
+ CheckBox
+ {
+ name: "xBarChart"
+ id: xBarChart
+ label: qsTr("Average chart by operator")
+ enabled: !type3.checked
+ }
+
+ CheckBox
+ {
+ name: "scatterPlot"
+ label: qsTr("Scatter plots operators")
+ id: scatterPlot
+ enabled: !type3.checked
+
+ CheckBox
+ {
+ name: "scatterPlotFitLine"
+ label: qsTr("Fit line")
+ }
+
+ CheckBox
+ {
+ name: "scatterPlotOriginLine"
+ label: qsTr("Show origin line")
+ }
+ }
+
+ CheckBox
+ {
+ name: "partMeasurementPlot"
+ label: qsTr("Measurements by part plot")
+
+ CheckBox
+ {
+ name: "partMeasurementPlotAllValues"
+ label: qsTr("Display all measurements")
+ }
+ }
+
+ CheckBox
+ {
+ name: "operatorMeasurementPlot"
+ id: operatorMeasurementPlot
+ label: qsTr("Measurements by operator plot")
+ enabled: !type3.checked
+ }
+
+ CheckBox
+ {
+ name: "partByOperatorMeasurementPlot"
+ id: partByOperatorMeasurementPlot
+ label: qsTr("Part × operator interaction plot")
+ enabled: !type3.checked
+ }
+
+ CheckBox
+ {
+ name: "trafficLightChart"
+ label: qsTr("Traffic light chart")
+ }
+ }
+ }
+
+ Section
+ {
+ title: qsTr("MCMC diagnostics")
+ columns: 1
+
+ CheckBox
+ {
+ label: qsTr("Diagnostics table")
+ name: "diagnosticsTable"
+ checked: true
+ }
+
+ CheckBox
+ {
+ label: qsTr("Plots")
+ name: "diagnosticsPlots"
+ checked: false
+ childrenOnSameRow: true
+
+ DropDown
+ {
+ name: "diagnosticsPlotType"
+ values:
+ [
+ { label: qsTr("Traceplot"), value: "trace" },
+ { label: qsTr("Autocorrelation"), value: "autocor" },
+ { label: qsTr("Density"), value: "density"}
+ ]
+ indexDefaultValue: 0
+ }
+ }
+
+ }
+
+ Section
+ {
+ title: qsTr("Advanced options")
+
+ Group
+ {
+ title: qsTr("Priors")
+
+ DoubleField
+ {
+ name: "rscalePrior"
+ label: qsTr("r scale prior")
+ defaultValue: 1
+ min: 0
+ max: 10
+ inclusive: JASP.MaxOnly
+ decimals: 3
+ }
+ }
+
+ Group
+ {
+ SetSeed{}
+ }
+
+ Group
+ {
+ title: qsTr("MCMC options")
+
+ IntegerField
+ {
+ name: "mcmcChains"
+ label: qsTr("Chains")
+ defaultValue: 4
+ min: 1
+ max: 10
+ }
+
+ IntegerField
+ {
+ name: "mcmcIterations"
+ label: qsTr("Iterations per chain")
+ id: mcmcIterations
+ defaultValue: 10000
+ min: Math.max(mcmcBurnin.value * 2, 100)
+ max: 100000
+ fieldWidth: 60
+ }
+
+ IntegerField
+ {
+ name: "mcmcBurnin"
+ label: qsTr("Burn-in per chain")
+ defaultValue: 2000
+ id: mcmcBurnin
+ min: 1
+ max: mcmcIterations.value / 2
+ fieldWidth: 60
+ }
+ }
+
+ Group
+ {
+ title: qsTr("Distribution fit to MCMC samples")
+
+ DropDown
+ {
+ name: "distType"
+ label: qsTr("Distribution")
+ values: posteriorPlotType.currentValue === "var" ? [
+ { label: qsTr("Generalized inverse Gaussian"), value: "gig" },
+ { label: qsTr("Metalog"), value: "metalog" }
+ ] : [
+ { label: qsTr("Metalog"), value: "metalog" }
+ ]
+ indexDefaultValue: 0
+ }
+ }
+ }
+
+ Section
+ {
+ title: qsTr("Report options")
+
+ CheckBox
+ {
+ name: "report"
+ label: qsTr("Show Report")
+ id: anovaGaugeReport
+ columns: 1
+
+ CheckBox
+ {
+ name: "reportMetaData"
+ label: qsTr("Show report metadata")
+ checked: true
+ columns: 2
+
+ CheckBox
+ {
+ name: "reportTitle"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportTitleText"
+ label: qsTr("Title")
+ id: reportTitleText
+ placeholderText: qsTr("Gauge r&R Report")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportPartName"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportPartNameText"
+ label: qsTr("Part name")
+ id: reportPartNameText
+ placeholderText: qsTr("Name")
+ fieldWidth: 100
+ }
+ }
+
+
+ CheckBox
+ {
+ name: "reportGaugeName"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportGaugeNameText"
+ label: qsTr("Gauge name")
+ id: reportGaugeNameText
+ placeholderText: qsTr("Name")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportCharacteristic"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportCharacteristicText"
+ label: qsTr("Characteristic")
+ id: reportCharacteristicText
+ placeholderText: qsTr("Characteristic")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportGaugeNumber"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportGaugeNumberText"
+ label: qsTr("Gauge number")
+ id: reportGaugeNumberText
+ placeholderText: qsTr("Number")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportTolerance"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportToleranceText"
+ label: qsTr("Tolerance")
+ id: reportToleranceText
+ placeholderText: qsTr("Tolerance")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportLocation"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportLocationText"
+ label: qsTr("Location")
+ id: reportLocationText
+ placeholderText: qsTr("Location")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportPerformedBy"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportPerformedByText"
+ label: qsTr("Performed by")
+ id: reportPerformedByText
+ placeholderText: qsTr("Analyst")
+ fieldWidth: 100
+ }
+ }
+
+ CheckBox
+ {
+ name: "reportDate"
+ checked: true
+ childrenOnSameRow: true
+
+ TextField
+ {
+ name: "reportDateText"
+ label: qsTr("Date")
+ id: reportDate
+ placeholderText: qsTr("Date")
+ fieldWidth: 100
+ }
+ }
+ }
+
+ Group
+ {
+ title: qsTr("Select Report Components")
+
+ CheckBox
+ {
+ name: "reportGaugeTable"
+ label: qsTr("Show gauge evaluation table")
+ checked: true
+ }
+
+ CheckBox
+ {
+ name: "reportVariationComponents"
+ label: qsTr("Show components of variation")
+ checked: true
+ }
+
+ CheckBox
+ {
+ name: "reportMeasurementsByPartPlot"
+ label: qsTr("Show measurements by part")
+ checked: true
+ }
+
+ CheckBox
+ {
+ name: "reportRChartByOperator"
+ label: qsTr("Show range charts by operator")
+ checked: !type3.checked
+ enabled: !type3.checked
+ }
+
+ CheckBox
+ {
+ name: "reportMeasurementsByOperatorPlot"
+ label: qsTr("Show measurements by operator")
+ checked: !type3.checked
+ enabled: !type3.checked
+ }
+
+ CheckBox
+ {
+ name: "reportAverageChartByOperator"
+ label: qsTr("Show average charts by operator")
+ checked: !type3.checked
+ enabled: !type3.checked
+ }
+
+ CheckBox
+ {
+ name: "reportPartByOperatorPlot"
+ label: qsTr("Show part × operator interaction")
+ checked: !type3.checked
+ enabled: !type3.checked
+ }
+
+ CheckBox
+ {
+ name: "reportTrafficLightChart"
+ label: qsTr("Show traffic light chart")
+ checked: true
+ }
+ }
+ }
+ }
+}
\ No newline at end of file
diff --git a/man/dot-PRESS.Rd b/man/dot-PRESS.Rd
new file mode 100644
index 00000000..4d5e7692
--- /dev/null
+++ b/man/dot-PRESS.Rd
@@ -0,0 +1,13 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/doeAnalysis.R
+\name{.PRESS}
+\alias{.PRESS}
+\title{calculate the predictive residuals
+calculate the PRESS}
+\usage{
+.PRESS(linear.model)
+}
+\description{
+calculate the predictive residuals
+calculate the PRESS
+}
diff --git a/man/dot-pred_r_squared.Rd b/man/dot-pred_r_squared.Rd
new file mode 100644
index 00000000..4446c563
--- /dev/null
+++ b/man/dot-pred_r_squared.Rd
@@ -0,0 +1,13 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/doeAnalysis.R
+\name{.pred_r_squared}
+\alias{.pred_r_squared}
+\title{Use anova() to get the sum of squares for the linear model
+Calculate the total sum of squares}
+\usage{
+.pred_r_squared(linear.model)
+}
+\description{
+Use anova() to get the sum of squares for the linear model
+Calculate the total sum of squares
+}
diff --git a/renv.lock b/renv.lock
index 5a2ec8fe..890e6f6c 100644
--- a/renv.lock
+++ b/renv.lock
@@ -109,6 +109,12 @@
"utils"
]
},
+ "GeneralizedHyperbolic": {
+ "Package": "GeneralizedHyperbolic",
+ "Version": "0.8-7",
+ "Source": "Repository",
+ "Repository": "CRAN"
+ },
"GPArotation": {
"Package": "GPArotation",
"Version": "2025.3-1",
@@ -118,6 +124,12 @@
"stats"
]
},
+ "HDInterval": {
+ "Package": "HDInterval",
+ "Version": "0.2.4",
+ "Source": "Repository",
+ "Repository": "CRAN"
+ },
"Hmisc": {
"Package": "Hmisc",
"Version": "5.2-3",
@@ -317,6 +329,12 @@
"R"
]
},
+ "bayesplot": {
+ "Package": "bayesplot",
+ "Version": "1.13.0",
+ "Source": "Repository",
+ "Repository": "CRAN"
+ },
"beeswarm": {
"Package": "beeswarm",
"Version": "0.4.0",
@@ -583,12 +601,9 @@
},
"data.table": {
"Package": "data.table",
- "Version": "1.17.4",
+ "Version": "1.17.8",
"Source": "Repository",
- "Requirements": [
- "methods",
- "R"
- ]
+ "Repository": "CRAN"
},
"deSolve": {
"Package": "deSolve",
@@ -675,6 +690,12 @@
"vctrs"
]
},
+ "ellipse": {
+ "Package": "ellipse",
+ "Version": "0.5.0",
+ "Source": "Repository",
+ "Repository": "CRAN"
+ },
"elliptic": {
"Package": "elliptic",
"Version": "1.4-0",
@@ -1870,6 +1891,12 @@
"stats"
]
},
+ "posterior": {
+ "Package": "posterior",
+ "Version": "1.6.1",
+ "Source": "Repository",
+ "Repository": "CRAN"
+ },
"processx": {
"Package": "processx",
"Version": "3.8.6",
@@ -2037,6 +2064,12 @@
"yaml"
]
},
+ "rmetalog": {
+ "Package": "rmetalog",
+ "Version": "1.0.3",
+ "Source": "Repository",
+ "Repository": "CRAN"
+ },
"rpart": {
"Package": "rpart",
"Version": "4.1.24",
@@ -2056,6 +2089,12 @@
"estimability"
]
},
+ "rstan": {
+ "Package": "rstan",
+ "Version": "2.32.7",
+ "Source": "Repository",
+ "Repository": "CRAN"
+ },
"rstatix": {
"Package": "rstatix",
"Version": "0.7.2",
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-1.svg
new file mode 100644
index 00000000..8edc1c35
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-1.svg
@@ -0,0 +1,33 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-10.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-10.svg
new file mode 100644
index 00000000..506179a8
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-10.svg
@@ -0,0 +1,122 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-11.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-11.svg
new file mode 100644
index 00000000..bf8be36c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-11.svg
@@ -0,0 +1,122 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-12.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-12.svg
new file mode 100644
index 00000000..73ae3b09
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-12.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-13.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-13.svg
new file mode 100644
index 00000000..89a753b2
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-13.svg
@@ -0,0 +1,483 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-14.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-14.svg
new file mode 100644
index 00000000..d64076b5
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-14.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-2.svg
new file mode 100644
index 00000000..8f76d8f1
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-2.svg
@@ -0,0 +1,123 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-3.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-3.svg
new file mode 100644
index 00000000..75d2f889
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-3.svg
@@ -0,0 +1,85 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-4.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-4.svg
new file mode 100644
index 00000000..c1c04319
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-4.svg
@@ -0,0 +1,67 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-5.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-5.svg
new file mode 100644
index 00000000..8395f3d2
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-5.svg
@@ -0,0 +1,123 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-6.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-6.svg
new file mode 100644
index 00000000..4f76a86e
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-6.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-7.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-7.svg
new file mode 100644
index 00000000..0b1f97c6
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-7.svg
@@ -0,0 +1,242 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-8.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-8.svg
new file mode 100644
index 00000000..49af4b08
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-8.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-9.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-9.svg
new file mode 100644
index 00000000..1eeca8ac
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l-gauge-r-r-report-subplot-9.svg
@@ -0,0 +1,41 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-components-of-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-components-of-variation.svg
new file mode 100644
index 00000000..93430bb6
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-components-of-variation.svg
@@ -0,0 +1,123 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-contour-plot.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-contour-plot.svg
new file mode 100644
index 00000000..9ae124ea
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-contour-plot.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-error.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-error.svg
new file mode 100644
index 00000000..9fcfa346
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-error.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-g-prior.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-g-prior.svg
new file mode 100644
index 00000000..40329a91
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-g-prior.svg
@@ -0,0 +1,64 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-1.svg
new file mode 100644
index 00000000..ac266abf
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-1.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-10.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-10.svg
new file mode 100644
index 00000000..15fd0d06
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-10.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-11.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-11.svg
new file mode 100644
index 00000000..e9a70cad
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-11.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-12.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-12.svg
new file mode 100644
index 00000000..57489fa7
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-12.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-13.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-13.svg
new file mode 100644
index 00000000..78e5eae5
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-13.svg
@@ -0,0 +1,79 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-14.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-14.svg
new file mode 100644
index 00000000..0746d540
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-14.svg
@@ -0,0 +1,79 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-15.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-15.svg
new file mode 100644
index 00000000..f72a3b60
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-15.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-2.svg
new file mode 100644
index 00000000..bd04833e
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-2.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-3.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-3.svg
new file mode 100644
index 00000000..ca62640d
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-3.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-4.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-4.svg
new file mode 100644
index 00000000..b6b68b0f
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-4.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-5.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-5.svg
new file mode 100644
index 00000000..5ff97564
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-5.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-6.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-6.svg
new file mode 100644
index 00000000..2402713e
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-6.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-7.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-7.svg
new file mode 100644
index 00000000..c7627d0e
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-7.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-8.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-8.svg
new file mode 100644
index 00000000..246537d3
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-8.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-9.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-9.svg
new file mode 100644
index 00000000..40e7be24
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-matrix-plot-for-operators-subplot-9.svg
@@ -0,0 +1,79 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-measurements-by-operator.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-measurements-by-operator.svg
new file mode 100644
index 00000000..688cb46b
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-measurements-by-operator.svg
@@ -0,0 +1,67 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-measurements-by-part.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-measurements-by-part.svg
new file mode 100644
index 00000000..83630dfe
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-measurements-by-part.svg
@@ -0,0 +1,175 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-operator.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-operator.svg
new file mode 100644
index 00000000..0dce3ab2
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-operator.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-part-by-operator-interaction.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-part-by-operator-interaction.svg
new file mode 100644
index 00000000..53729796
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-part-by-operator-interaction.svg
@@ -0,0 +1,123 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-part.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-part.svg
new file mode 100644
index 00000000..06187628
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-part.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-rchart.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-rchart.svg
new file mode 100644
index 00000000..4ba7cb4b
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-rchart.svg
@@ -0,0 +1,122 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-error.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-error.svg
new file mode 100644
index 00000000..7707b93c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-error.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-operators.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-operators.svg
new file mode 100644
index 00000000..c54bfd1e
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-operators.svg
@@ -0,0 +1,68 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-parts.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-parts.svg
new file mode 100644
index 00000000..e53f1635
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-trace-plot-parts.svg
@@ -0,0 +1,64 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-traffic-light-chart-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-traffic-light-chart-subplot-1.svg
new file mode 100644
index 00000000..559a9ef7
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-traffic-light-chart-subplot-1.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-traffic-light-chart-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-traffic-light-chart-subplot-2.svg
new file mode 100644
index 00000000..712a2562
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-traffic-light-chart-subplot-2.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l1-xbar-chart.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-xbar-chart.svg
new file mode 100644
index 00000000..5bd02478
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l1-xbar-chart.svg
@@ -0,0 +1,122 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-error.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-error.svg
new file mode 100644
index 00000000..af2b5853
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-error.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-inter.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-inter.svg
new file mode 100644
index 00000000..4d0ec566
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-inter.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-operators.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-operators.svg
new file mode 100644
index 00000000..69bf7100
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-operators.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-parts.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-parts.svg
new file mode 100644
index 00000000..cdfe8427
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-autocor-plot-parts.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-components-of-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-components-of-variation.svg
new file mode 100644
index 00000000..17dc1d60
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-components-of-variation.svg
@@ -0,0 +1,123 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-operator.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-operator.svg
new file mode 100644
index 00000000..f5e61d3c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-operator.svg
@@ -0,0 +1,73 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-part-to-part.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-part-to-part.svg
new file mode 100644
index 00000000..d41ec1c3
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-part-to-part.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-repeatability.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-repeatability.svg
new file mode 100644
index 00000000..24465f7c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-repeatability.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-reproducibility.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-reproducibility.svg
new file mode 100644
index 00000000..a5154011
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-reproducibility.svg
@@ -0,0 +1,73 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-total-gauge-r-r.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-total-gauge-r-r.svg
new file mode 100644
index 00000000..e3b6b595
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-total-gauge-r-r.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-traffic-light-chart-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-traffic-light-chart-subplot-1.svg
new file mode 100644
index 00000000..a78344da
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-traffic-light-chart-subplot-1.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l2-traffic-light-chart-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-traffic-light-chart-subplot-2.svg
new file mode 100644
index 00000000..4f02d329
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l2-traffic-light-chart-subplot-2.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-components-of-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-components-of-variation.svg
new file mode 100644
index 00000000..5bc894e3
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-components-of-variation.svg
@@ -0,0 +1,109 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-density-plot-type-3-error.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-density-plot-type-3-error.svg
new file mode 100644
index 00000000..6ec896df
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-density-plot-type-3-error.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-density-plot-type3-parts.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-density-plot-type3-parts.svg
new file mode 100644
index 00000000..f84bc583
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-density-plot-type3-parts.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-part-to-part.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-part-to-part.svg
new file mode 100644
index 00000000..5bd69509
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-part-to-part.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-repeatability.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-repeatability.svg
new file mode 100644
index 00000000..485df23d
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-repeatability.svg
@@ -0,0 +1,73 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-total-gauge-r-r.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-total-gauge-r-r.svg
new file mode 100644
index 00000000..bdbe19c1
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-total-gauge-r-r.svg
@@ -0,0 +1,73 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-total-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-total-variation.svg
new file mode 100644
index 00000000..5acb166f
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-total-variation.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-traffic-light-chart-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-traffic-light-chart-subplot-1.svg
new file mode 100644
index 00000000..c892f756
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-traffic-light-chart-subplot-1.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l3-traffic-light-chart-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-traffic-light-chart-subplot-2.svg
new file mode 100644
index 00000000..273eea5a
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l3-traffic-light-chart-subplot-2.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-components-of-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-components-of-variation.svg
new file mode 100644
index 00000000..f975bffc
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-components-of-variation.svg
@@ -0,0 +1,110 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-error.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-error.svg
new file mode 100644
index 00000000..0e572b3c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-error.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-operators.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-operators.svg
new file mode 100644
index 00000000..fd42dd98
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-operators.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-parts.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-parts.svg
new file mode 100644
index 00000000..959deef0
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-density-plot-histsd-parts.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-operator.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-operator.svg
new file mode 100644
index 00000000..6ced1432
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-operator.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-repeatability.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-repeatability.svg
new file mode 100644
index 00000000..e2f59abb
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-repeatability.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-reproducibility.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-reproducibility.svg
new file mode 100644
index 00000000..0c30c4f0
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-reproducibility.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-total-gauge-r-r.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-total-gauge-r-r.svg
new file mode 100644
index 00000000..2491a04a
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-total-gauge-r-r.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-traffic-light-chart-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-traffic-light-chart-subplot-1.svg
new file mode 100644
index 00000000..a1fa2b83
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-traffic-light-chart-subplot-1.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/l4-traffic-light-chart-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-traffic-light-chart-subplot-2.svg
new file mode 100644
index 00000000..2772a9c0
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/l4-traffic-light-chart-subplot-2.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-1.svg
new file mode 100644
index 00000000..d0950727
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-1.svg
@@ -0,0 +1,33 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-10.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-10.svg
new file mode 100644
index 00000000..62c5331c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-10.svg
@@ -0,0 +1,120 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-11.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-11.svg
new file mode 100644
index 00000000..3d55cebe
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-11.svg
@@ -0,0 +1,124 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-12.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-12.svg
new file mode 100644
index 00000000..ae9d855a
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-12.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-13.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-13.svg
new file mode 100644
index 00000000..0299779b
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-13.svg
@@ -0,0 +1,483 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-14.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-14.svg
new file mode 100644
index 00000000..21326ef5
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-14.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-2.svg
new file mode 100644
index 00000000..efb5d1c5
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-2.svg
@@ -0,0 +1,117 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-3.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-3.svg
new file mode 100644
index 00000000..c64b9657
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-3.svg
@@ -0,0 +1,85 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-4.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-4.svg
new file mode 100644
index 00000000..4d359742
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-4.svg
@@ -0,0 +1,67 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-5.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-5.svg
new file mode 100644
index 00000000..4a1a7940
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-5.svg
@@ -0,0 +1,125 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-6.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-6.svg
new file mode 100644
index 00000000..849bbddc
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-6.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-7.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-7.svg
new file mode 100644
index 00000000..00229886
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-7.svg
@@ -0,0 +1,242 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-8.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-8.svg
new file mode 100644
index 00000000..2d03f857
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-8.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-9.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-9.svg
new file mode 100644
index 00000000..671f20a4
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w-gauge-r-r-report-subplot-9.svg
@@ -0,0 +1,41 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-components-of-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-components-of-variation.svg
new file mode 100644
index 00000000..aaefd8b4
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-components-of-variation.svg
@@ -0,0 +1,117 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-contour-plot-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-contour-plot-wide.svg
new file mode 100644
index 00000000..45b54719
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-contour-plot-wide.svg
@@ -0,0 +1,83 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-error.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-error.svg
new file mode 100644
index 00000000..045d3be4
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-error.svg
@@ -0,0 +1,81 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-g-prior.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-g-prior.svg
new file mode 100644
index 00000000..a2441cda
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-g-prior.svg
@@ -0,0 +1,64 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-1.svg
new file mode 100644
index 00000000..d924d4a4
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-1.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-10.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-10.svg
new file mode 100644
index 00000000..0280e24f
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-10.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-11.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-11.svg
new file mode 100644
index 00000000..df8b0418
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-11.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-12.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-12.svg
new file mode 100644
index 00000000..3607c871
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-12.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-13.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-13.svg
new file mode 100644
index 00000000..d2a71f8a
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-13.svg
@@ -0,0 +1,81 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-14.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-14.svg
new file mode 100644
index 00000000..5f277597
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-14.svg
@@ -0,0 +1,79 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-15.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-15.svg
new file mode 100644
index 00000000..df4e3098
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-15.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-2.svg
new file mode 100644
index 00000000..abd09f68
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-2.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-3.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-3.svg
new file mode 100644
index 00000000..7c314e62
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-3.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-4.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-4.svg
new file mode 100644
index 00000000..6f2e7514
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-4.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-5.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-5.svg
new file mode 100644
index 00000000..5f8f2f81
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-5.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-6.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-6.svg
new file mode 100644
index 00000000..cfeb4f04
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-6.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-7.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-7.svg
new file mode 100644
index 00000000..fc2eaabf
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-7.svg
@@ -0,0 +1,32 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-8.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-8.svg
new file mode 100644
index 00000000..842ac9ea
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-8.svg
@@ -0,0 +1,34 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-9.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-9.svg
new file mode 100644
index 00000000..af33d4b1
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-matrix-plot-for-operators-subplot-9.svg
@@ -0,0 +1,81 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-measurements-by-operator.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-measurements-by-operator.svg
new file mode 100644
index 00000000..341abc07
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-measurements-by-operator.svg
@@ -0,0 +1,67 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-measurements-by-part.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-measurements-by-part.svg
new file mode 100644
index 00000000..a29ce614
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-measurements-by-part.svg
@@ -0,0 +1,173 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-operator.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-operator.svg
new file mode 100644
index 00000000..93a72b2c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-operator.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-part-by-operator-interaction.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-part-by-operator-interaction.svg
new file mode 100644
index 00000000..7c7593bc
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-part-by-operator-interaction.svg
@@ -0,0 +1,125 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-part.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-part.svg
new file mode 100644
index 00000000..f0c6458d
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-part.svg
@@ -0,0 +1,73 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-rchart-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-rchart-wide.svg
new file mode 100644
index 00000000..8d7e658a
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-rchart-wide.svg
@@ -0,0 +1,120 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-error-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-error-wide.svg
new file mode 100644
index 00000000..a4c29e23
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-error-wide.svg
@@ -0,0 +1,70 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-operators-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-operators-wide.svg
new file mode 100644
index 00000000..264cf4f0
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-operators-wide.svg
@@ -0,0 +1,64 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-parts-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-parts-wide.svg
new file mode 100644
index 00000000..a15901ae
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-trace-plot-parts-wide.svg
@@ -0,0 +1,68 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-traffic-light-chart-wide-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-traffic-light-chart-wide-subplot-1.svg
new file mode 100644
index 00000000..a328ff8e
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-traffic-light-chart-wide-subplot-1.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-traffic-light-chart-wide-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-traffic-light-chart-wide-subplot-2.svg
new file mode 100644
index 00000000..50db822c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-traffic-light-chart-wide-subplot-2.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w1-xbar-chart-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-xbar-chart-wide.svg
new file mode 100644
index 00000000..03c06b6c
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w1-xbar-chart-wide.svg
@@ -0,0 +1,124 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-error-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-error-wide.svg
new file mode 100644
index 00000000..836ce7a2
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-error-wide.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-inter-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-inter-wide.svg
new file mode 100644
index 00000000..0dd55b7a
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-inter-wide.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-operators-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-operators-wide.svg
new file mode 100644
index 00000000..f73c1383
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-operators-wide.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-parts-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-parts-wide.svg
new file mode 100644
index 00000000..1aa656aa
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-autocor-plot-parts-wide.svg
@@ -0,0 +1,66 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-components-of-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-components-of-variation.svg
new file mode 100644
index 00000000..ef629205
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-components-of-variation.svg
@@ -0,0 +1,117 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-operator.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-operator.svg
new file mode 100644
index 00000000..e1ed1ccd
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-operator.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-part-to-part.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-part-to-part.svg
new file mode 100644
index 00000000..a24c7c26
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-part-to-part.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-repeatability.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-repeatability.svg
new file mode 100644
index 00000000..67ba2c8a
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-repeatability.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-reproducibility.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-reproducibility.svg
new file mode 100644
index 00000000..b7239796
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-reproducibility.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-total-gauge-r-r.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-total-gauge-r-r.svg
new file mode 100644
index 00000000..1b4a391d
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-total-gauge-r-r.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-traffic-light-chart-wide-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-traffic-light-chart-wide-subplot-1.svg
new file mode 100644
index 00000000..011517c3
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-traffic-light-chart-wide-subplot-1.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w2-traffic-light-chart-wide-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-traffic-light-chart-wide-subplot-2.svg
new file mode 100644
index 00000000..be0e850d
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w2-traffic-light-chart-wide-subplot-2.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-components-of-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-components-of-variation.svg
new file mode 100644
index 00000000..a179c133
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-components-of-variation.svg
@@ -0,0 +1,103 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-density-plot-type-3-error-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-density-plot-type-3-error-wide.svg
new file mode 100644
index 00000000..49a8bff3
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-density-plot-type-3-error-wide.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-density-plot-type3-parts-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-density-plot-type3-parts-wide.svg
new file mode 100644
index 00000000..3953944a
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-density-plot-type3-parts-wide.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-part-to-part.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-part-to-part.svg
new file mode 100644
index 00000000..3036d2d0
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-part-to-part.svg
@@ -0,0 +1,67 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-repeatability.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-repeatability.svg
new file mode 100644
index 00000000..2ddcec71
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-repeatability.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-total-gauge-r-r.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-total-gauge-r-r.svg
new file mode 100644
index 00000000..54f86082
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-total-gauge-r-r.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-total-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-total-variation.svg
new file mode 100644
index 00000000..68cc7e35
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-total-variation.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-traffic-light-chart-wide-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-traffic-light-chart-wide-subplot-1.svg
new file mode 100644
index 00000000..f317d6d6
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-traffic-light-chart-wide-subplot-1.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w3-traffic-light-chart-wide-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-traffic-light-chart-wide-subplot-2.svg
new file mode 100644
index 00000000..bbe1300d
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w3-traffic-light-chart-wide-subplot-2.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-components-of-variation.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-components-of-variation.svg
new file mode 100644
index 00000000..62c4be7e
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-components-of-variation.svg
@@ -0,0 +1,110 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-error-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-error-wide.svg
new file mode 100644
index 00000000..892bc843
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-error-wide.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-operators-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-operators-wide.svg
new file mode 100644
index 00000000..3fb816ec
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-operators-wide.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-parts-wide.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-parts-wide.svg
new file mode 100644
index 00000000..63d860a9
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-density-plot-histsd-parts-wide.svg
@@ -0,0 +1,71 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-operator.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-operator.svg
new file mode 100644
index 00000000..688beded
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-operator.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-repeatability.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-repeatability.svg
new file mode 100644
index 00000000..8b5edd7b
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-repeatability.svg
@@ -0,0 +1,77 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-reproducibility.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-reproducibility.svg
new file mode 100644
index 00000000..a13b112f
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-reproducibility.svg
@@ -0,0 +1,69 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-total-gauge-r-r.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-total-gauge-r-r.svg
new file mode 100644
index 00000000..7ddefcff
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-total-gauge-r-r.svg
@@ -0,0 +1,73 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-traffic-light-chart-wide-subplot-1.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-traffic-light-chart-wide-subplot-1.svg
new file mode 100644
index 00000000..214cd6a0
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-traffic-light-chart-wide-subplot-1.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/_snaps/msaBayesianGaugeRR/w4-traffic-light-chart-wide-subplot-2.svg b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-traffic-light-chart-wide-subplot-2.svg
new file mode 100644
index 00000000..549f0f96
--- /dev/null
+++ b/tests/testthat/_snaps/msaBayesianGaugeRR/w4-traffic-light-chart-wide-subplot-2.svg
@@ -0,0 +1,56 @@
+
+
diff --git a/tests/testthat/test-msaBayesianGaugeRR.R b/tests/testthat/test-msaBayesianGaugeRR.R
new file mode 100644
index 00000000..4a1479eb
--- /dev/null
+++ b/tests/testthat/test-msaBayesianGaugeRR.R
@@ -0,0 +1,1477 @@
+context("[Quality Control] Bayesian Gauge r&R")
+.numDecimals <- 2
+## tests long-format
+### automatic model selection & posterior on variances (generalized inverse Gaussian)
+options <- analysisOptions("msaBayesianGaugeRR")
+options$measurementLongFormat <- "Dm"
+options$operatorLongFormat <- "Operators"
+options$partLongFormat <- "Parts"
+options$tolerance <- TRUE
+options$priorPlot <- TRUE
+options$posteriorPlot <- TRUE
+options$posteriorPlotType <- "var"
+options$posteriorHistogram <- TRUE
+options$posteriorCi <- TRUE
+options$contourPlot <- TRUE
+options$contourLSL <- -10
+options$contourUSL <- 0
+options$rChart <- TRUE
+options$xBarChart <- TRUE
+options$scatterPlot <- TRUE
+options$scatterPlotFitLine <- TRUE
+options$scatterPlotOriginLine <- TRUE
+options$partMeasurementPlot <- TRUE
+options$partMeasurementPlotAllValues <- TRUE
+options$operatorMeasurementPlot <- TRUE
+options$partByOperatorMeasurementPlot <- TRUE
+options$trafficLightChart <- TRUE
+options$distType <- "gig"
+options$mcmcChains <- 2
+options$customCiType <- "customCiQuantiles"
+set.seed(1)
+results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options)
+
+
+test_that("L1 Model Comparison table results match", {
+ table <- results[["results"]][["BFtable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(9.1287767597893e+66, 0.0077421542931849, "Null model", 1, "",
+ "Parts + Operators + PartsOperators",
+ 0.113212575159566, 0.00872259468666002, "Parts + Operators"
+ ))
+})
+
+test_that("L1 Contour plot matches", {
+ plotName <- results[["results"]][["contourPlot"]][["collection"]][["contourPlot_plot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 Contour plot")
+})
+
+test_that("L1 Producer's (δ) and Consumer's (β) Risk table results match", {
+ table <- results[["results"]][["contourPlot"]][["collection"]][["contourPlot_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.00738797550717418, 0.0217229988723209, "", 0.0504418242104906,
+ 0.0466531148350437, 0.108462891253646, "", 0.210628344001828
+ ))
+})
+
+test_that("L1 % Contribution to Total Variation table results match", {
+ table <- results[["results"]][["contribTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.672854564674615, 3.01603148541284, "Total gauge r&R", 10.6957816353577,
+ 0.428066317944134, 1.36262810109564, "Repeatability", 2.88196943211859,
+ 0.128937314959488, 1.65340338431719, "Reproducibility", 8.86803963413681,
+ 0.128937314959488, 1.65340338431719, "Operator", 8.86803963413681,
+ 89.3042183646423, 96.9839685145869, "Part-to-part", 99.3271454353254,
+ "", 100, "Total variation", ""))
+})
+
+test_that("L1 Part by operator interaction plot matches", {
+ plotName <- results[["results"]][["gaugeByInteraction"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 part-by-operator-interaction")
+})
+
+test_that("L1 Measurements by operator plot matches", {
+ plotName <- results[["results"]][["gaugeByOperator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 measurements-by-operator")
+})
+
+test_that("L1 Measurements by part plot matches", {
+ plotName <- results[["results"]][["gaugeByPart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 measurements-by-part")
+})
+
+test_that("L1 % Study Variation & % Tolerance table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_percStudyVarTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(8.20277120172739, 22.1408240975003, 16.0560064136487, 31.6484709916296,
+ "Total gauge r&R", 32.7044057966602, 62.4858618220583, 6.54267771618492,
+ 19.0232155665105, 11.3621810602882, 22.2068164968796, "Repeatability",
+ 16.9763642511899, 26.042334748647, 3.59078423443732, 8.35951370532176,
+ 10.6197907610815, 21.0549057299311, "Reproducibility", 29.7792514328602,
+ 58.2732584746615, 3.59078423443732, 8.35951370532176, 10.6197907610815,
+ 21.0549057299311, "Operator", 29.7792514328602, 58.2732584746615,
+ 94.5009091800832, 131.338182169877, 98.4586706459067, 203.15001505139,
+ "Part-to-part", 99.6630048891023, 325.127983561911, "", 134.972221466956,
+ 100, 206.127409873692, "Total variation", "", 327.452182037894
+ ))
+})
+
+test_that("L1 Standard Deviation & Study Variation table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_stdTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.369013734958338, 2.21408240975003, 0.527474516527165, 3.16484709916296,
+ "Total gauge r&R", 1.04143103036764, 6.24858618220583, 0.317053592775174,
+ 1.90232155665105, 0.370113608281325, 2.22068164968796, "Repeatability",
+ 0.434038912477449, 2.6042334748647, 0.139325228422029, 0.835951370532175,
+ 0.350915095498847, 2.10549057299309, "Reproducibility", 0.971220974577692,
+ 5.82732584746615, 0.139325228422029, 0.835951370532175, 0.350915095498847,
+ 2.10549057299309, "Operator", 0.971220974577692, 5.82732584746615,
+ 2.18896970283128, 13.1338182169877, 3.38583358418984, 20.3150015051389,
+ "Part-to-part", 5.41879972603185, 32.5127983561911, 2.24953702444927,
+ 13.4972221466956, 3.4354568312282, 20.6127409873691, "Total variation",
+ 5.45753636729823, 32.7452182037894))
+})
+
+test_that("L1 Matrix plot for operators matches", {
+ plotName <- results[["results"]][["gaugeScatterOperators"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 matrix-plot-for-operators")
+})
+
+test_that("L1 Trace plot operators matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Operators"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 Trace plot operators")
+})
+
+test_that("L1 Trace plot parts matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Parts"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 Trace plot parts")
+})
+
+test_that("L1 Trace plot error matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_sig2"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 Trace plot error")
+})
+
+test_that("L1 Diagnostics table results match", {
+ table <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(13156.2958719656, 14548.1788817734, 0.0643396308484891, 0.026604748502423,
+ 0.416661068666242, "2Part", 0.999980107827912,
+ 8826.27376375007, 8779.64520704258, 0.00739624941904107, 0.000226595508114019,
+ 0.0456256051161729, "2Operator",
+ 0.999989789442352, 9519.12272634791, 13138.4226911852, 0.000228956655794118,
+ 0.000320520616274043, 0.000765639483270394, "2Error",
+ 1.00096014378277))
+})
+
+test_that("L1 g-prior plot matches", {
+ plotName <- results[["results"]][["priorPlot"]][["collection"]][["priorPlot_plot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 g-prior")
+})
+
+test_that("L1 rChart matches", {
+ plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 rChart")
+})
+
+test_that("L1 Test results for range chart table results match", {
+ table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list("No test violations occurred."))
+})
+
+test_that("L1 Traffic light chart matches", {
+ plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_trafficPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 Traffic light chart")
+})
+
+test_that("L1 Components of variation plot matches", {
+ plotName <- results[["results"]][["varCompPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 components-of-variation")
+})
+
+test_that("L1 Variance Components table results match", {
+ table <- results[["results"]][["varCompTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.136171136634584, 1.08457861699851, 0.328512928494555, 0.64962130987885,
+ "Total gauge r&R", 0.100522980701193, 0.188389777677887,
+ 0.137871376665235, 0.0224366411670959, "Repeatability", 0.0194115194133937,
+ 0.943270181509932, 0.190641551829319, 0.648481519656201, "Reproducibility",
+ 0.0194115194133937, 0.943270181509932, 0.190641551829319, 0.648481519656201,
+ "Operator", 4.79158836022261, 29.3633907449221, 12.2100438401309,
+ 7.26694993903746, "Part-to-part", 5.06041682996016, 29.7847032117442,
+ 12.5385567686254, 7.30119170960903, "Total variation"))
+})
+
+test_that("L1 Error plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Error"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 error")
+})
+
+test_that("L1 Operator plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 operator")
+})
+
+test_that("L1 Part plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 part")
+})
+
+test_that("L1 Posterior Summary table results match", {
+ table <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_postSummary"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(4.78249678043341, 29.8522838983694, "2Part",
+ 12.2063561157816, 0.019717972167065, 0.963666980675533, "2Operator",
+ 0.190584413578255, 0.100232646227405, 0.187736626967306, "2Error",
+ 0.137874639867539))
+})
+
+test_that("L1 xBar chart matches", {
+ plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L1 xBar chart")
+})
+
+test_that("L1 Test results for x-bar chart table results match", {
+ table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list("Operator A", "Point 1", "", "Point 2", "", "Point 3", "", "Point 4",
+ "", "Point 5", "", "Point 6", "", "Point 7", "", "Point 8",
+ "", "Point 9", "", "Point 10", "Operator B", "Point 1", "",
+ "Point 2", "", "Point 3", "", "Point 4", "", "Point 5", "",
+ "Point 6", "", "Point 7", "", "Point 8", "", "Point 9", "",
+ "Point 10", "Operator C", "Point 1", "", "Point 2", "", "Point 3",
+ "", "Point 4", "", "Point 5", "", "Point 6", "", "Point 7",
+ "", "Point 8", "", "Point 9", "", "Point 10"))
+})
+
+
+### full model, autocorrelation plot & posterior on %study var (metalog fit)
+options <- analysisOptions("msaBayesianGaugeRR")
+options$measurementLongFormat <- "Dm"
+options$operatorLongFormat <- "Operators"
+options$partLongFormat <- "Parts"
+options$estimationType <- "manual"
+options$tolerance <- TRUE
+options$posteriorPlot <- TRUE
+options$posteriorPlotType <- "percStudyVar"
+options$posteriorHistogram <- TRUE
+options$posteriorCi <- TRUE
+options$trafficLightChart <- TRUE
+options$diagnosticsPlotType <- "autocor"
+options$distType <- "metalog"
+options$modelType <- "fullModel"
+options$mcmcChains <- 2
+options$customCiType <- "customCiQuantiles"
+set.seed(1)
+results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options)
+
+
+test_that("L2 Model Comparison table results match", {
+ table <- results[["results"]][["BFtable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(9.1287767597893e+66, 0.0077421542931849, "Null model", 1, "",
+ "Parts + Operators + PartsOperators",
+ 0.113212575159566, 0.00872259468666002, "Parts + Operators"
+ ))
+})
+
+test_that("L2 % Contribution to Total Variation table results match", {
+ table <- results[["results"]][["contribTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.69447557946222, 3.05404347725902, "Total gauge r&R", 9.81157819333386,
+ 0.365617611408123, 1.18254623665808, "Repeatability", 2.50534144416177,
+ 0.248512477297506, 1.87149724060094, "Reproducibility", 8.28077895940993,
+ 0.112863258114114, 1.48254203391395, "Operator", 7.79715004565745,
+ 90.1884218066661, 96.9459565227407, "Part-to-part", 99.3055244205378,
+ "", 100, "Total variation", ""))
+})
+
+test_that("L2 % Study Variation & % Tolerance table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_percStudyVarTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(8.33352010084559, 22.9786386424899, 16.3322195040502, 32.2484497939107,
+ "Total gauge r&R", 31.3234388066817, 59.6412966340563, 6.04663221290274,
+ 17.6288943903814, 10.5801416260002, 20.7059537295768, "Repeatability",
+ 15.8282704124082, 24.373940737509, 4.98510256793306, 12.3575654327892,
+ 12.0283968363823, 23.8525213529975, "Reproducibility", 28.7763423711902,
+ 55.6207429515081, 3.35951273364442, 7.8490424913573, 10.0901334559607,
+ 20.0717059566318, "Operator", 27.9233752657033, 54.2107521223829,
+ 94.9675848939788, 130.639342259913, 98.4410373260722, 203.511825478069,
+ "Part-to-part", 99.6521572373075, 333.768084944735, "", 134.396600839345,
+ 100, 206.549553474733, "Total variation", "", 335.858700611061
+ ))
+})
+
+test_that("L2 Standard Deviation & Study Variation table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_stdTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.382977310708165, 2.29786386424899, 0.537474163231843, 3.22484497939106,
+ "Total gauge r&R", 0.994021610567605, 5.96412966340563,
+ 0.293814906506357, 1.76288943903814, 0.34509922882628, 2.07059537295769,
+ "Repeatability", 0.406232345625149, 2.4373940737509, 0.20595942387982,
+ 1.23575654327892, 0.397542022549958, 2.38525213529974, "Reproducibility",
+ 0.927012382525134, 5.56207429515081, 0.130817374855955, 0.78490424913573,
+ 0.334528432610531, 2.00717059566317, "Operator", 0.903512535373049,
+ 5.42107521223829, 2.17732237099855, 13.0639342259913, 3.39186375796782,
+ 20.3511825478067, "Part-to-part", 5.56280141574558, 33.3768084944735,
+ 2.23994334732242, 13.4396600839345, 3.44249255791222, 20.6549553474733,
+ "Total variation", 5.59764501018435, 33.5858700611061))
+})
+
+test_that("L2 Autocor plot operators matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Operators"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 Autocor plot operators")
+})
+
+test_that("L2 Autocor plot parts matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Parts"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 Autocor plot parts")
+})
+
+test_that("L2 Autocor plot inter matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Parts:Operators"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 Autocor plot inter")
+})
+
+test_that("L2 Autocor plot error matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_sig2"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 Autocor plot error")
+})
+
+test_that("L2 Diagnostics table results match", {
+ table <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(12967.850228195, 14329.7160415497, 0.062732257546333, 0.0341846247500968,
+ 0.539677077803615, "2Part", 1.00002456233026,
+ 8500.80410601691, 9050.8556088105, 0.0148892656693548, 0.00016236059250508,
+ 0.0329594078357549, "2Operator",
+ 1.00012670868512, 2552.53155004218, 4983.42629160057, 0.00043254562416457,
+ 0.000245120601889498, 0.00221431079824162, "2PartOperator",
+ 1.00024837506665, 6397.65222878932, 10084.8788553676, 0.000251800876700841,
+ 0.000254706253452919, 0.000694930652478803, "2Error",
+ 1.00000831671343))
+})
+
+test_that("L2 Traffic light chart matches", {
+ plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_trafficPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 Traffic light chart")
+})
+
+test_that("L2 Components of variation plot matches", {
+ plotName <- results[["results"]][["varCompPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 components-of-variation")
+})
+
+test_that("L2 Variance Components table results match", {
+ table <- results[["results"]][["varCompTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.146671620526603, 0.988078962511109, 0.34370391186105, 1.58695054948859,
+ "Total gauge r&R", 0.0863271993104535, 0.165024718682726,
+ 0.11991388657612, 0.020108398519423, "Repeatability", 0.0424192843572241,
+ 0.859351985170204, 0.223790025284931, 1.58641961102281, "Reproducibility",
+ 0.0171131855642062, 0.816334902198017, 0.184248502487699, 1.58585651722007,
+ "Operator", 4.74073270725694, 30.944759618133, 12.2577502514977,
+ 7.07891510019515, "Part-to-part", 5.01734620004458, 31.3336296606438,
+ 12.6014541633589, 7.26094148376794, "Total variation"))
+})
+
+test_that("L2 Operator plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 operator")
+})
+
+test_that("L2 Part-to-part plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Part-to-part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 part-to-part")
+})
+
+test_that("L2 Repeatability plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Repeatability"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 repeatability")
+})
+
+test_that("L2 Reproducibility plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Reproducibility"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 reproducibility")
+})
+
+test_that("L2 Total gauge r&R plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Total gauge r&R"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L2 total-gauge-r-r")
+})
+
+test_that("L2 Posterior Summary table results match", {
+ table <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_postSummary"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(8.40483271767977, 33.0057533152063, "Total gauge r&R", 16.4140241975042,
+ 6.04889943061452, 15.7471976500399, "Repeatability", 10.5766752981399,
+ 5.07341929971864, 29.5462725588561, "Reproducibility", 12.0468877459586,
+ 3.38522425736962, 28.4919128501656, "Operator", 10.0912145081404,
+ 94.6627001896635, 99.6460991284399, "Part-to-part", 98.4312844657675
+ ))
+})
+
+### type 3, density diagnostics plot & posterior on %Tolerance (metalog fit)
+options <- analysisOptions("msaBayesianGaugeRR")
+options$measurementLongFormat <- "Dm"
+options$partLongFormat <- "Parts"
+options$type3 <- TRUE
+options$tolerance <- TRUE
+options$posteriorPlot <- TRUE
+options$posteriorPlotType <- "percTol"
+options$posteriorHistogram <- TRUE
+options$posteriorCi <- TRUE
+options$trafficLightChart <- TRUE
+options$diagnosticsPlotType <- "density"
+options$distType <- "metalog"
+options$mcmcChains <- 2
+options$customCiType <- "customCiQuantiles"
+set.seed(1)
+results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options)
+
+
+test_that("L3 Model Comparison table results match", {
+ table <- results[["results"]][["BFtable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(1.21824945358133e+67, 4.52862083972528e-07, "Null model", 1, "",
+ "Parts"))
+})
+
+test_that("L3 % Contribution to Total Variation table results match", {
+ table <- results[["results"]][["contribTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.486660998980681, 1.57812882489572, "Total gauge r&R", 3.31935853093398,
+ 0.486660998980681, 1.57812882489572, "Repeatability", 3.31935853093398,
+ 96.680641469066, 98.4218711751048, "Part-to-part", 99.5133390010193,
+ "", 100, "Total variation", ""))
+})
+
+test_that("L3 % Study Variation & % Tolerance table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_percStudyVarTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(6.97610906534103, 20.3690235963062, 12.2240799868402, 23.7480532160329,
+ "Total gauge r&R", 18.2191068137751, 27.8369834027837, 6.97610906534103,
+ 20.3690235963062, 12.2240799868402, 23.7480532160329, "Repeatability",
+ 18.2191068137751, 27.8369834027837, 98.3263146207898, 131.405161770283,
+ 99.2070911544104, 203.640368012146, "Part-to-part", 99.7563727292204,
+ 334.591586444325, "", 133.578417870203, 100, 205.107533242308,
+ "Total variation", "", 335.288690363822))
+})
+
+test_that("L3 Standard Deviation & Study Variation table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_stdTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.339483726605103, 2.03690235963062, 0.395800886933879, 2.37480532160328,
+ "Total gauge r&R", 0.463949723379728, 2.78369834027837,
+ 0.339483726605103, 2.03690235963062, 0.395800886933879, 2.37480532160328,
+ "Repeatability", 0.463949723379728, 2.78369834027837, 2.19008602950472,
+ 13.1405161770283, 3.39400613353577, 20.3640368012146, "Part-to-part",
+ 5.57652644073874, 33.4591586444325, 2.22630696450339, 13.3578417870203,
+ 3.41845888737181, 20.5107533242309, "Total variation", 5.58814483939704,
+ 33.5288690363822))
+})
+
+test_that("L3 Density plot type3 parts matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Parts"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L3 Density plot type3 parts")
+})
+
+test_that("L3 Density plot type 3 error matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_sig2"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L3 Density plot type 3 error")
+})
+
+test_that("L3 Diagnostics table results match", {
+ table <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(13013.8840798061, 13434.1168244218, 0.0641205840760188, 0.0456636982145211,
+ 0.4668331247511, "2Part", 0.999911614893083,
+ 10264.3177964902, 13098.7327637058, 0.000253246417063196, 0.000424909254537975,
+ 0.000947491447932325, "2Error",
+ 0.999947182865367))
+})
+
+test_that("L3 Traffic light chart matches", {
+ plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_trafficPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L3 Traffic light chart")
+})
+
+test_that("L3 Components of variation plot matches", {
+ plotName <- results[["results"]][["varCompPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L3 components-of-variation")
+})
+
+test_that("L3 Variance Components table results match", {
+ table <- results[["results"]][["varCompTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.115249200662058, 0.215249345973517, 0.157658926333129, 0.0254995397510453,
+ "Total gauge r&R", 0.115249200662058, 0.215249345973517,
+ 0.157658926333129, 0.0254995397510453, "Repeatability", 4.79647682219662,
+ 31.0976471553276, 12.2669633998433, 7.0481079233022, "Part-to-part",
+ 4.95644270972351, 31.2273628685899, 12.4246223261765, 7.04797820646694,
+ "Total variation"))
+})
+
+test_that("L3 Part-to-part plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Part-to-part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L3 part-to-part")
+})
+
+test_that("L3 Repeatability plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Repeatability"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L3 repeatability")
+})
+
+test_that("L3 Total gauge r&R plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Total gauge r&R"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L3 total-gauge-r-r")
+})
+
+test_that("L3 Total variation plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Total variation"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L3 total-variation")
+})
+
+test_that("L3 Posterior Summary table results match", {
+ table <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_postSummary"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(20.4255240578281, 27.7936833384094, "Total gauge r&R", 23.7462166121699,
+ 20.4255240578281, 27.7936833384094, "Repeatability", 23.7462166121699,
+ 132.494221789943, 328.60136274761, "Part-to-part", 203.470639651509,
+ 134.688309385618, 329.570001781427, "Total variation", 204.959377455086
+ ))
+})
+
+
+### historical SD & posterior on %Contribution (metalog)
+options <- analysisOptions("msaBayesianGaugeRR")
+options$measurementLongFormat <- "Dm"
+options$operatorLongFormat <- "Operators"
+options$partLongFormat <- "Parts"
+options$processVariationReference <- "historicalSd"
+options$historicalSdValue <- 1.5
+options$tolerance <- TRUE
+options$posteriorPlot <- TRUE
+options$posteriorPlotType <- "percContrib"
+options$posteriorHistogram <- TRUE
+options$posteriorCi <- TRUE
+options$trafficLightChart <- TRUE
+options$diagnosticsPlotType <- "density"
+options$distType <- "metalog"
+options$mcmcChains <- 2
+options$customCiType <- "customCiQuantiles"
+set.seed(1)
+results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options)
+
+
+test_that("L4 Model Comparison table results match", {
+ table <- results[["results"]][["BFtable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(9.1287767597893e+66, 0.0077421542931849, "Null model", 1, "",
+ "Parts + Operators + PartsOperators",
+ 0.113212575159566, 0.00872259468666002, "Parts + Operators"
+ ))
+})
+
+test_that("L4 % Contribution to Total Variation table results match", {
+ table <- results[["results"]][["contribTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(6.05205051709262, 14.6005745997579, "Total gauge r&R", 48.2034940888228,
+ 4.46768803116411, 6.12761674067714, "Repeatability", 8.37287900790609,
+ 0.862734196150831, 8.47295785908085, "Reproducibility", 41.9231191782192,
+ 0.862734196150831, 8.47295785908085, "Operator", 41.9231191782192,
+ "", 85.3994254002103, "Part-to-part", "", "", 100, "Total variation",
+ ""))
+})
+
+test_that("L4 % Study Variation & % Tolerance table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_percStudyVarTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(24.6009156638892, 22.1408240975003, 35.1649677684775, 31.6484709916296,
+ "Total gauge r&R", 69.4287353578425, 62.4858618220583, 21.1369061850116,
+ 19.0232155665105, 24.6742405520885, 22.2068164968796, "Repeatability",
+ 28.9359274984966, 26.042334748647, 9.28834856146862, 8.35951370532176,
+ 23.3943396999233, 21.0549057299311, "Reproducibility", 64.7480649718461,
+ 58.2732584746615, 9.28834856146862, 8.35951370532176, 23.3943396999233,
+ 21.0549057299311, "Operator", 64.7480649718461, 58.2732584746615,
+ "", "", 92.4118095268483, 83.1706285741424, "Part-to-part",
+ "", "", "", "", 100, 90, "Total variation", "", ""))
+})
+
+test_that("L4 Standard Deviation & Study Variation table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_stdTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.369013734958338, 2.21408240975003, 0.527474516527165, 3.16484709916296,
+ "Total gauge r&R", 1.04143103036764, 6.24858618220583, 0.317053592775174,
+ 1.90232155665105, 0.370113608281325, 2.22068164968796, "Repeatability",
+ 0.434038912477449, 2.6042334748647, 0.139325228422029, 0.835951370532175,
+ 0.350915095498847, 2.10549057299309, "Reproducibility", 0.971220974577692,
+ 5.82732584746615, 0.139325228422029, 0.835951370532175, 0.350915095498847,
+ 2.10549057299309, "Operator", 0.971220974577692, 5.82732584746615,
+ "", "", 1.38617714290269, 8.31706285741529, "Part-to-part",
+ "", "", "", "", 1.5, 9, "Total variation", "", ""))
+})
+
+test_that("L4 Density plot histSd operators matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Operators"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 Density plot histSd operators")
+})
+
+test_that("L4 Density plot histSd parts matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Parts"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 Density plot histSd parts")
+})
+
+test_that("L4 Density plot histSd error matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_sig2"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 Density plot histSd error")
+})
+
+test_that("L4 Diagnostics table results match", {
+ table <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(13156.2958719656, 14548.1788817734, 0.0643396308484891, 0.026604748502423,
+ 0.416661068666242, "2Part", 0.999980107827912,
+ 8826.27376375007, 8779.64520704258, 0.00739624941904107, 0.000226595508114019,
+ 0.0456256051161729, "2Operator",
+ 0.999989789442352, 9519.12272634791, 13138.4226911852, 0.000228956655794118,
+ 0.000320520616274043, 0.000765639483270394, "2Error",
+ 1.00096014378277))
+})
+
+test_that("L4 Traffic light chart matches", {
+ plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_trafficPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 Traffic light chart")
+})
+
+test_that("L4 Components of variation plot matches", {
+ plotName <- results[["results"]][["varCompPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 components-of-variation")
+})
+
+test_that("L4 Variance Components table results match", {
+ table <- results[["results"]][["varCompTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.136171136634584, 1.08457861699851, 0.328512928494555, 0.64962130987885,
+ "Total gauge r&R", 0.100522980701193, 0.188389777677887,
+ 0.137871376665235, 0.0224366411670959, "Repeatability", 0.0194115194133937,
+ 0.943270181509932, 0.190641551829319, 0.648481519656201, "Reproducibility",
+ 0.0194115194133937, 0.943270181509932, 0.190641551829319, 0.648481519656201,
+ "Operator", "", "", 1.92148707150488, "", "Part-to-part", "",
+ "", 2.25, "", "Total variation"))
+})
+
+test_that("L4 Operator plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 operator")
+})
+
+test_that("L4 Repeatability plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Repeatability"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 repeatability")
+})
+
+test_that("L4 Reproducibility plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Reproducibility"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 reproducibility")
+})
+
+test_that("L4 Total gauge r&R plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Total gauge r&R"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L4 total-gauge-r-r")
+})
+
+test_that("L4 Posterior Summary table results match", {
+ table <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_postSummary"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(6.08426523238411, 49.8077618247364, "Total gauge r&R", 15.0301360534277,
+ 4.50423780799053, 8.31507421356034, "Repeatability", 6.1266418829029,
+ 0.887272856100956, 41.8955809104603, "Reproducibility", 9.4272887180478,
+ 0.887272856100956, 41.8955809104603, "Operator", 9.4272887180478
+ ))
+})
+
+
+### report
+test_that("L Gauge r&R report plot matches", {
+ options <- analysisOptions("msaBayesianGaugeRR")
+ options$measurementLongFormat <- "Dm"
+ options$operatorLongFormat <- "Operators"
+ options$partLongFormat <- "Parts"
+ options$tolerance <- TRUE
+ options$posteriorPlotType <- "var"
+ options$report <- TRUE
+ options$reportRChartByOperator <- TRUE
+ options$reportMeasurementsByOperatorPlot <- TRUE
+ options$reportAverageChartByOperator <- TRUE
+ options$reportPartByOperatorPlot <- TRUE
+ options$mcmcChains <- 2
+ options$customCiType <- "customCiQuantiles"
+ set.seed(1)
+ results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_long.csv", options)
+ plotName <- results[["results"]][["report"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "L gauge-r-r-report")
+})
+
+
+
+## tests wide format
+#local_snapshotter(snap_dir = "_snaps/msaBayesianGaugeRR/wide format/")
+### automatic model selection & posterior on variances (generalized inverse Gaussian)
+options <- analysisOptions("msaBayesianGaugeRR")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3")
+options$operatorWideFormat <- "Operator"
+options$partWideFormat <- "Part"
+options$tolerance <- TRUE
+options$priorPlot <- TRUE
+options$posteriorPlot <- TRUE
+options$posteriorPlotType <- "var"
+options$posteriorHistogram <- TRUE
+options$posteriorCi <- TRUE
+options$contourPlot <- TRUE
+options$contourLSL <- 5
+options$contourUSL <- 12
+options$rChart <- TRUE
+options$xBarChart <- TRUE
+options$scatterPlot <- TRUE
+options$scatterPlotFitLine <- TRUE
+options$scatterPlotOriginLine <- TRUE
+options$partMeasurementPlot <- TRUE
+options$partMeasurementPlotAllValues <- TRUE
+options$operatorMeasurementPlot <- TRUE
+options$partByOperatorMeasurementPlot <- TRUE
+options$trafficLightChart <- TRUE
+options$distType <- "gig"
+options$mcmcChains <- 2
+options$customCiType <- "customCiQuantiles"
+set.seed(1)
+results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options)
+
+
+test_that("W1 Model Comparison table results match", {
+ table <- results[["results"]][["BFtable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(92702680603773728, 0.00765529237919074, "Null model", 1, "", "Part + Operator + PartOperator",
+ 0.0121495135306725, 0.00886204496168727, "Part + Operator"
+ ))
+})
+
+test_that("W1 Contour plot wide matches", {
+ plotName <- results[["results"]][["contourPlot"]][["collection"]][["contourPlot_plot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 Contour plot wide")
+})
+
+test_that("W1 Producer's (δ) and Consumer's (β) Risk table results match", {
+ table <- results[["results"]][["contourPlot"]][["collection"]][["contourPlot_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.0264927749011355, 0.0787475031694541, "", 0.213793581986107,
+ 0.190669690866134, 0.310594648025299, "", 0.411549984734059
+ ))
+})
+
+test_that("W1 % Contribution to Total Variation table results match", {
+ table <- results[["results"]][["contribTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(12.3269052367313, 33.9284976466776, "Total gauge r&R", 69.3587838257263,
+ 7.09756342908547, 19.8025194624623, "Repeatability", 35.5218633925746,
+ 1.91788890553919, 14.1259781842151, "Reproducibility", 56.2082001015145,
+ 1.91788890553919, 14.1259781842151, "Operator", 56.2082001015145,
+ 30.6412161742737, 66.0715023533227, "Part-to-part", 87.6730947632687,
+ "", 100, "Total variation", ""))
+})
+
+test_that("W1 Part by operator interaction plot matches", {
+ plotName <- results[["results"]][["gaugeByInteraction"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 part-by-operator-interaction")
+})
+
+test_that("W1 Measurements by operator plot matches", {
+ plotName <- results[["results"]][["gaugeByOperator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 measurements-by-operator")
+})
+
+test_that("W1 Measurements by part plot matches", {
+ plotName <- results[["results"]][["gaugeByPart"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 measurements-by-part")
+})
+
+test_that("W1 % Study Variation & % Tolerance table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_percStudyVarTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(35.1096922476569, 54.0297071548185, 57.0017393460991, 74.7495086161511,
+ "Total gauge r&R", 83.2819210724576, 140.230313974081, 26.6412521701421,
+ 47.452522327498, 43.6853564019964, 55.425842187894, "Repeatability",
+ 59.6002209628415, 64.9073776359718, 13.8487865812482, 18.6433631335287,
+ 34.2767972476711, 46.5139370842548, "Reproducibility", 74.9721282190718,
+ 128.70188362376, 13.8487865812482, 18.6433631335287, 34.2767972476711,
+ 46.5139370842548, "Operator", 74.9721282190718, 128.70188362376,
+ 55.3545084521765, 67.2003644717557, 80.6965158375164, 106.466816727854,
+ "Part-to-part", 93.6339119740239, 171.623834317457, "", 93.5117075742855,
+ 100, 132.14110254032, "Total variation", "", 203.977912189941
+ ))
+})
+
+test_that("W1 Standard Deviation & Study Variation table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_stdTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.900495119246975, 5.40297071548185, 1.24582514360251, 7.47495086161507,
+ "Total gauge r&R", 2.33717189956802, 14.0230313974081, 0.790875372124967,
+ 4.7452522327498, 0.923764036464903, 5.5425842187894, "Repeatability",
+ 1.0817896272662, 6.49073776359718, 0.310722718892144, 1.86433631335287,
+ 0.775232284737573, 4.65139370842548, "Reproducibility", 2.14503139372934,
+ 12.870188362376, 0.310722718892144, 1.86433631335287, 0.775232284737573,
+ 4.65139370842548, "Operator", 2.14503139372934, 12.870188362376,
+ 1.12000607452926, 6.72003644717558, 1.77444694546422, 10.6466816727853,
+ "Part-to-part", 2.86039723862429, 17.1623834317457, 1.55852845957142,
+ 9.35117075742855, 2.20235170900533, 13.214110254032, "Total variation",
+ 3.39963186983235, 20.3977912189941))
+})
+
+test_that("W1 Matrix plot for operators matches", {
+ plotName <- results[["results"]][["gaugeScatterOperators"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 matrix-plot-for-operators")
+})
+
+test_that("W1 Trace plot operators wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 Trace plot operators wide")
+})
+
+test_that("W1 Trace plot parts wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 Trace plot parts wide")
+})
+
+test_that("W1 Trace plot error wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_sig2"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 Trace plot error wide")
+})
+
+test_that("W1 Diagnostics table wide results match", {
+ table <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(11489.1632603585, 13677.1607176617, 0.0188803933569998, 0.0110455472900119,
+ 0.159912102522656, "2Part", 1.00004644044169,
+ 8946.79354696483, 9284.24667889662, 0.0525552167179807, 0.00142100662694245,
+ 0.197346171272066, "2Operator",
+ 0.999921535112366, 9627.27034873237, 12550.7045825935, 0.00141570326076179,
+ 0.00158112334408733, 0.00365958909245312, "2Error",
+ 1.00097355083603))
+})
+
+test_that("W1 g-prior plot matches", {
+ plotName <- results[["results"]][["priorPlot"]][["collection"]][["priorPlot_plot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 g-prior")
+})
+
+test_that("W1 rChart wide matches", {
+ plotName <- results[["results"]][["rChart"]][["collection"]][["rChart_plot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 rChart wide")
+})
+
+test_that("W1 Test results for range chart table results match", {
+ table <- results[["results"]][["rChart"]][["collection"]][["rChart_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list("C", "Point 10"))
+})
+
+test_that("W1 Traffic light chart wide matches", {
+ plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_trafficPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 Traffic light chart wide")
+})
+
+test_that("W1 Components of variation plot matches", {
+ plotName <- results[["results"]][["varCompPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 components-of-variation")
+})
+
+test_that("W1 Variance Components table results match", {
+ table <- results[["results"]][["varCompTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.810891459819477, 5.46237261253729, 1.78655246954848, 4.25598172544705,
+ "Total gauge r&R", 0.625483854562397, 1.17026879778004,
+ 0.858831277132578, 0.139329767865209, "Repeatability", 0.0965486080600336,
+ 4.6011597614014, 0.927721192415901, 4.24873211986627, "Reproducibility",
+ 0.0965486080600336, 4.6011597614014, 0.927721192415901, 4.24873211986627,
+ "Operator", 1.25441360896374, 8.18187264910991, 3.36535744263274,
+ 2.05016685602997, "Part-to-part", 2.42901096405622, 11.5574968504741,
+ 5.15190991218123, 4.71475336587418, "Total variation"))
+})
+
+test_that("W1 Error plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Error"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 error")
+})
+
+test_that("W1 Operator plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 operator")
+})
+
+test_that("W1 Part plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 part")
+})
+
+test_that("W1 Posterior Summary table results match", {
+ table <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_postSummary"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(1.27284283054443, 8.51804137015566, "2Part",
+ 3.3737108373, 0.098113661553187, 4.61971702790384, "2Operator",
+ 0.927748105326958, 0.623677008626749, 1.16560947901581, "2Error",
+ 0.858916283560981))
+})
+
+test_that("W1 xBar chart wide matches", {
+ plotName <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_plot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W1 xBar chart wide")
+})
+
+test_that("W1 Test results for x-bar chart table results match", {
+ table <- results[["results"]][["xBarChart"]][["collection"]][["xBarChart_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list("A", "Point 1", "", "Point 5", "", "Point 8", "", "Point 10",
+ "B", "Point 1", "", "Point 5", "", "Point 8", "", "Point 10",
+ "C", "Point 1", "", "Point 3", "", "Point 5", "", "Point 10"
+ ))
+})
+
+### full model, autocorrelation plot & posterior on %study var (metalog fit)
+options <- analysisOptions("msaBayesianGaugeRR")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3")
+options$operatorWideFormat <- "Operator"
+options$partWideFormat <- "Part"
+options$estimationType <- "manual"
+options$tolerance <- TRUE
+options$posteriorPlot <- TRUE
+options$posteriorPlotType <- "percStudyVar"
+options$posteriorHistogram <- TRUE
+options$posteriorCi <- TRUE
+options$trafficLightChart <- TRUE
+options$diagnosticsPlotType <- "autocor"
+options$distType <- "metalog"
+options$modelType <- "fullModel"
+options$mcmcChains <- 2
+options$customCiType <- "customCiQuantiles"
+set.seed(1)
+results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options)
+
+
+test_that("W2 Model Comparison table results match", {
+ table <- results[["results"]][["BFtable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(92702680603773728, 0.00765529237919074, "Null model", 1, "", "Part + Operator + PartOperator",
+ 0.0121495135306725, 0.00886204496168727, "Part + Operator"
+ ))
+})
+
+test_that("W2 % Contribution to Total Variation table results match", {
+ table <- results[["results"]][["contribTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(13.3778291589204, 36.1913295547785, "Total gauge r&R", 69.466346367937,
+ 6.54447642381507, 18.3197432349895, "Repeatability", 32.73935334103,
+ 4.02429567876643, 17.871586319789, "Reproducibility", 56.444856724105,
+ 1.82503213233058, 13.6051251659484, "Operator", 53.6866163018582,
+ 30.533653632063, 63.8086704452217, "Part-to-part", 86.6221708410796,
+ "", 100, "Total variation", ""))
+})
+
+test_that("W2 % Study Variation & % Tolerance table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_percStudyVarTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(36.5757146253627, 56.7656934104138, 58.9923979409587, 77.8390144712959,
+ "Total gauge r&R", 83.3464734120505, 138.841013897683, 25.582174090092,
+ 45.9144985156591, 42.0347378543699, 53.6837141943982, "Repeatability",
+ 57.218312728733, 62.9766489691705, 20.0606472250702, 27.8931683934347,
+ 39.9676499900152, 53.9870114150065, "Reproducibility", 75.1297913909348,
+ 126.892261568645, 13.5093748143594, 18.1862826792913, 33.6092783763241,
+ 46.0434055352073, "Operator", 73.2711510905113, 124.613898462338,
+ 55.2572651173971, 65.549306545672, 79.2720451566425, 105.353853521724,
+ "Part-to-part", 93.0710324521567, 175.700681171956, "", 94.5404823595808,
+ 100, 133.080812955375, "Total variation", "", 205.322828943223
+ ))
+})
+
+test_that("W2 Standard Deviation & Study Variation table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_stdTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.946094890173563, 5.67656934104138, 1.29731690785493, 7.78390144712956,
+ "Total gauge r&R", 2.31401689829472, 13.8841013897683, 0.765241641927652,
+ 4.59144985156591, 0.89472856990664, 5.36837141943982, "Repeatability",
+ 1.04961081615284, 6.29766489691705, 0.464886139890577, 2.78931683934346,
+ 0.899783523583441, 5.39870114150067, "Reproducibility", 2.11487102614409,
+ 12.6892261568645, 0.303104711321522, 1.81862826792913, 0.767390092253462,
+ 4.60434055352075, "Operator", 2.07689830770563, 12.4613898462338,
+ 1.09248844242787, 6.5549306545672, 1.7558975586954, 10.5353853521724,
+ "Part-to-part", 2.92834468619927, 17.5700681171956, 1.57567470599301,
+ 9.45404823595808, 2.21801354925625, 13.3080812955376, "Total variation",
+ 3.42204714905372, 20.5322828943223))
+})
+
+test_that("W2 Autocor plot operators wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 Autocor plot operators wide")
+})
+
+test_that("W2 Autocor plot parts wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 Autocor plot parts wide")
+})
+
+test_that("W2 Autocor plot inter wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Part:Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 Autocor plot inter wide")
+})
+
+test_that("W2 Autocor plot error wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_sig2"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 Autocor plot error wide")
+})
+
+test_that("W2 Diagnostics table wide results match", {
+ table <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(10713.5473264095, 13407.275608121, 0.0190269587098109, 0.0103036342722492,
+ 0.134655246165873, "2Part", 1.00019626284334,
+ 8693.66878281009, 9627.98196118723, 0.117006744102641, 0.00119814090722604,
+ 0.172676716849297, "2Operator",
+ 1.00027692390321, 2785.13714277183, 4772.44199873121, 0.00196487944719096,
+ 0.000824576247414721, 0.00886968674039701, "2PartOperator",
+ 1.00068074432022, 6957.81110299329, 10358.8045674784, 0.00158875487364865,
+ 0.00191146086502458, 0.00424397364874796, "2Error",
+ 1.00005531082368))
+})
+
+test_that("W2 Traffic light chart wide matches", {
+ plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_trafficPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 Traffic light chart wide")
+})
+
+test_that("W2 Components of variation plot matches", {
+ plotName <- results[["results"]][["varCompPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 components-of-variation")
+})
+
+test_that("W2 Variance Components table results match", {
+ table <- results[["results"]][["varCompTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.895095541218567, 5.35467421909935, 2.03563916421946, 13.36030351333,
+ "Total gauge r&R", 0.585594770562784, 1.1016828653987, 0.805784153180511,
+ 0.131825823292889, "Repeatability", 0.216119123075015, 4.47267980982418,
+ 1.22985501103896, 13.3556841019572, "Reproducibility", 0.0918724662796369,
+ 4.31350665542013, 1.04095448066503, 13.3531032948241, "Operator",
+ 1.1935309978082, 8.57520261358881, 3.30518987594095, 2.00879397541868,
+ "Part-to-part", 2.48275078237167, 11.7104066907196, 5.34082904016041,
+ 13.5126413089862, "Total variation"))
+})
+
+test_that("W2 Operator plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 operator")
+})
+
+test_that("W2 Part-to-part plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Part-to-part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 part-to-part")
+})
+
+test_that("W2 Repeatability plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Repeatability"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 repeatability")
+})
+
+test_that("W2 Reproducibility plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Reproducibility"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 reproducibility")
+})
+
+test_that("W2 Total gauge r&R plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Total gauge r&R"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W2 total-gauge-r-r")
+})
+
+test_that("W2 Posterior Summary table results match", {
+ table <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_postSummary"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(36.6908448164942, 84.640380749268, "Total gauge r&R", 59.0499639096235,
+ 25.5255275390376, 56.9200489576364, "Repeatability", 42.03575729992,
+ 20.0919962355863, 75.9155319105894, "Reproducibility", 39.996598338415,
+ 13.7729319889636, 73.7855331557218, "Operator", 33.6414451776228,
+ 53.9844930078528, 93.0486168370966, "Part-to-part", 79.2144723166527
+ ))
+})
+
+### type 3, density diagnostics plot & posterior on %Tolerance (metalog fit)
+options <- analysisOptions("msaBayesianGaugeRR")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3")
+options$partWideFormat <- "Part"
+options$type3 <- TRUE
+options$tolerance <- TRUE
+options$posteriorPlot <- TRUE
+options$posteriorPlotType <- "percTol"
+options$posteriorHistogram <- TRUE
+options$posteriorCi <- TRUE
+options$trafficLightChart <- TRUE
+options$diagnosticsPlotType <- "density"
+options$distType <- "metalog"
+options$mcmcChains <- 2
+options$customCiType <- "customCiQuantiles"
+set.seed(1)
+results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options)
+
+
+test_that("W3 Model Comparison table results match", {
+ table <- results[["results"]][["BFtable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(98096672972404490240, 3.49979418330506e-06, "Null model", 1, "",
+ "Part"))
+})
+
+test_that("W3 % Contribution to Total Variation table results match", {
+ table <- results[["results"]][["contribTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(8.83081567952286, 23.7598919702468, "Total gauge r&R", 41.8274496817367,
+ 8.83081567952286, 23.7598919702468, "Repeatability", 41.8274496817367,
+ 58.1725503182633, 76.2401080297539, "Part-to-part", 91.1691843204771,
+ "", 100, "Total variation", ""))
+})
+
+test_that("W3 % Study Variation & % Tolerance table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_percStudyVarTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(29.7166882611562, 48.0241014671239, 47.9003801961148, 55.9991052269221,
+ "Total gauge r&R", 64.6741445105543, 65.6920462384278, 29.7166882611562,
+ 48.0241014671239, 47.9003801961148, 55.9991052269221, "Repeatability",
+ 64.6741445105543, 65.6920462384278, 76.2709317618789, 67.5499445080692,
+ 87.1711025379854, 106.583932335271, "Part-to-part", 95.4825556392114,
+ 175.730879489471, "", 87.0869358486883, 100, 121.077346756447,
+ "Total variation", "", 184.656155967787))
+})
+
+test_that("W3 Standard Deviation & Study Variation table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_stdTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.800401691118732, 4.80241014671239, 0.933318420448701, 5.5999105226922,
+ "Total gauge r&R", 1.09486743730713, 6.56920462384278, 0.800401691118732,
+ 4.80241014671239, 0.933318420448701, 5.5999105226922, "Repeatability",
+ 1.09486743730713, 6.56920462384278, 1.12583240846782, 6.75499445080692,
+ 1.77639887225451, 10.6583932335271, "Part-to-part", 2.92884799149119,
+ 17.5730879489471, 1.45144893081147, 8.70869358486883, 2.01795577927412,
+ 12.1077346756448, "Total variation", 3.07760259946311, 18.4656155967787
+ ))
+})
+
+test_that("W3 Density plot type3 parts wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W3 Density plot type3 parts wide")
+})
+
+test_that("W3 Density plot type 3 error wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_sig2"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W3 Density plot type 3 error wide")
+})
+
+test_that("W3 Diagnostics table wide results match", {
+ table <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(11707.3772753072, 12898.8791981331, 0.018538497634247, 0.0117758505186677,
+ 0.133935146076606, "2Part", 0.999912218555296,
+ 10252.2089186134, 12928.747430743, 0.00140504193471408, 0.00203664967823852,
+ 0.00556308506257785, "2Error",
+ 0.999971878611095))
+})
+
+test_that("W3 Traffic light chart wide matches", {
+ plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_trafficPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W3 Traffic light chart wide")
+})
+
+test_that("W3 Components of variation plot matches", {
+ plotName <- results[["results"]][["varCompPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W3 components-of-variation")
+})
+
+test_that("W3 Variance Components table results match", {
+ table <- results[["results"]][["varCompTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.640642867591348, 1.19873470534066, 0.876622085936743, 0.141450061477036,
+ "Total gauge r&R", 0.640642867591348, 1.19873470534066,
+ 0.876622085936743, 0.141450061477036, "Repeatability", 1.26749861196421,
+ 8.57815073257154, 3.3707105788214, 1.97733245942888, "Part-to-part",
+ 2.106703999134, 9.47163777543298, 4.24733266475813, 1.98142724023979,
+ "Total variation"))
+})
+
+test_that("W3 Part-to-part plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Part-to-part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W3 part-to-part")
+})
+
+test_that("W3 Repeatability plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Repeatability"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W3 repeatability")
+})
+
+test_that("W3 Total gauge r&R plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Total gauge r&R"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W3 total-gauge-r-r")
+})
+
+test_that("W3 Total variation plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Total variation"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W3 total-variation")
+})
+
+test_that("W3 Posterior Summary table results match", {
+ table <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_postSummary"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(48.1714882535499, 65.4777848056588, "Total gauge r&R", 55.9859173475586,
+ 48.1714882535499, 65.4777848056588, "Repeatability", 55.9859173475586,
+ 68.0697507873148, 173.397787709273, "Part-to-part", 106.53503836118,
+ 87.6024563014082, 182.690390900527, "Total variation", 121.01621390635
+ ))
+})
+
+### historical SD & posterior on %Contribution (metalog)
+options <- analysisOptions("msaBayesianGaugeRR")
+options$dataFormat <- "wideFormat"
+options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3")
+options$operatorWideFormat <- "Operator"
+options$partWideFormat <- "Part"
+options$processVariationReference <- "historicalSd"
+options$historicalSdValue <- 1.5
+options$tolerance <- TRUE
+options$posteriorPlot <- TRUE
+options$posteriorPlotType <- "percContrib"
+options$posteriorHistogram <- TRUE
+options$posteriorCi <- TRUE
+options$trafficLightChart <- TRUE
+options$diagnosticsPlotType <- "density"
+options$distType <- "metalog"
+options$mcmcChains <- 2
+options$customCiType <- "customCiQuantiles"
+set.seed(1)
+results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options)
+
+
+test_that("W4 Model Comparison table results match", {
+ table <- results[["results"]][["BFtable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(92702680603773728, 0.00765529237919074, "Null model", 1, "", "Part + Operator + PartOperator",
+ 0.0121495135306725, 0.00886204496168727, "Part + Operator"
+ ))
+})
+
+test_that("W4 % Contribution to Total Variation table results match", {
+ table <- results[["results"]][["contribTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(36.0396204364212, 79.4023319799323, "Total gauge r&R", 242.772116112769,
+ 27.7992824249954, 38.1702789836703, "Repeatability", 52.0119465680019,
+ 4.29104924711261, 41.2320529962621, "Reproducibility", 204.495989395618,
+ 4.29104924711261, 41.2320529962621, "Operator", 204.495989395618,
+ "", 20.5976680200604, "Part-to-part", "", "", 100, "Total variation",
+ ""))
+})
+
+test_that("W4 % Study Variation & % Tolerance table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_percStudyVarTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(60.0330079497983, 54.0297071548185, 83.0550095735007, 74.7495086161511,
+ "Total gauge r&R", 155.811459971201, 140.230313974081, 52.7250248083311,
+ 47.452522327498, 61.5842690976603, 55.425842187894, "Repeatability",
+ 72.1193084844131, 64.9073776359718, 20.714847926143, 18.6433631335287,
+ 51.6821523158386, 46.5139370842548, "Reproducibility", 143.002092915289,
+ 128.70188362376, 20.714847926143, 18.6433631335287, 51.6821523158386,
+ 46.5139370842548, "Operator", 143.002092915289, 128.70188362376,
+ "", "", 45.3846538161075, 40.846188434481, "Part-to-part", "",
+ "", "", "", 100, 90, "Total variation", "", ""))
+})
+
+test_that("W4 Standard Deviation & Study Variation table results match", {
+ table <- results[["results"]][["gaugeEvaluation"]][["collection"]][["gaugeEvaluation_stdTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.900495119246975, 5.40297071548185, 1.24582514360251, 7.47495086161507,
+ "Total gauge r&R", 2.33717189956802, 14.0230313974081, 0.790875372124967,
+ 4.7452522327498, 0.923764036464903, 5.5425842187894, "Repeatability",
+ 1.0817896272662, 6.49073776359718, 0.310722718892144, 1.86433631335287,
+ 0.775232284737573, 4.65139370842548, "Reproducibility", 2.14503139372934,
+ 12.870188362376, 0.310722718892144, 1.86433631335287, 0.775232284737573,
+ 4.65139370842548, "Operator", 2.14503139372934, 12.870188362376,
+ "", "", 0.680769807241364, 4.08461884344987, "Part-to-part",
+ "", "", "", "", 1.5, 9, "Total variation", "", ""))
+})
+
+test_that("W4 Density plot histSd operators wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 Density plot histSd operators wide")
+})
+
+test_that("W4 Density plot histSd parts wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_g_Part"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 Density plot histSd parts wide")
+})
+
+test_that("W4 Density plot histSd error wide matches", {
+ plotName <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_sig2"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 Density plot histSd error wide")
+})
+
+test_that("W4 Diagnostics table wide results match", {
+ table <- results[["results"]][["mcmcDiagnostics"]][["collection"]][["mcmcDiagnostics_table"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(11489.1632603585, 13677.1607176617, 0.0188803933569998, 0.0110455472900119,
+ 0.159912102522656, "2Part", 1.00004644044169,
+ 8946.79354696483, 9284.24667889662, 0.0525552167179807, 0.00142100662694245,
+ 0.197346171272066, "2Operator",
+ 0.999921535112366, 9627.27034873237, 12550.7045825935, 0.00141570326076179,
+ 0.00158112334408733, 0.00365958909245312, "2Error",
+ 1.00097355083603))
+})
+
+test_that("W4 Traffic light chart wide matches", {
+ plotName <- results[["results"]][["trafficPlot"]][["collection"]][["trafficPlot_trafficPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 Traffic light chart wide")
+})
+
+test_that("W4 Components of variation plot matches", {
+ plotName <- results[["results"]][["varCompPlot"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 components-of-variation")
+})
+
+test_that("W4 Variance Components table results match", {
+ table <- results[["results"]][["varCompTable"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(0.810891459819477, 5.46237261253729, 1.78655246954848, 4.25598172544705,
+ "Total gauge r&R", 0.625483854562397, 1.17026879778004,
+ 0.858831277132578, 0.139329767865209, "Repeatability", 0.0965486080600336,
+ 4.6011597614014, 0.927721192415901, 4.24873211986627, "Reproducibility",
+ 0.0965486080600336, 4.6011597614014, 0.927721192415901, 4.24873211986627,
+ "Operator", "", "", 0.463447530451708, "", "Part-to-part", "",
+ "", 2.25, "", "Total variation"))
+})
+
+test_that("W4 Operator plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Operator"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 operator")
+})
+
+test_that("W4 Repeatability plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Repeatability"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 repeatability")
+})
+
+test_that("W4 Reproducibility plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Reproducibility"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 reproducibility")
+})
+
+test_that("W4 Total gauge r&R plot matches", {
+ plotName <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_Total gauge r&R"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W4 total-gauge-r-r")
+})
+
+test_that("W4 Posterior Summary table results match", {
+ table <- results[["results"]][["posteriorSummaries"]][["collection"]][["posteriorSummaries_postSummary"]][["data"]]
+ jaspTools::expect_equal_tables(table,
+ list(36.2684396989805, 246.249732595721, "Total gauge r&R", 79.4194770714244,
+ 28.0791556215122, 51.6892435406356, "Repeatability", 38.1493514877285,
+ 4.43965092830744, 196.978472951731, "Reproducibility", 42.7178342722391,
+ 4.43965092830744, 196.978472951731, "Operator", 42.7178342722391
+ ))
+})
+
+### report
+test_that("W Gauge r&R report plot matches", {
+ options <- analysisOptions("msaBayesianGaugeRR")
+ options$dataFormat <- "wideFormat"
+ options$measurementsWideFormat <- list("Measurement1", "Measurement2", "Measurement3")
+ options$operatorWideFormat <- "Operator"
+ options$partWideFormat <- "Part"
+ options$tolerance <- TRUE
+ options$posteriorPlotType <- "var"
+ options$report <- TRUE
+ options$reportRChartByOperator <- TRUE
+ options$reportMeasurementsByOperatorPlot <- TRUE
+ options$reportAverageChartByOperator <- TRUE
+ options$reportPartByOperatorPlot <- TRUE
+ options$mcmcChains <- 2
+ options$customCiType <- "customCiQuantiles"
+ set.seed(1)
+ results <- runAnalysis("msaBayesianGaugeRR", "datasets/msaGaugeRRCrossed/msaGaugeRRCrossed_wide.csv", options)
+ plotName <- results[["results"]][["report"]][["data"]]
+ testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
+ jaspTools::expect_equal_plots(testPlot, "W gauge-r-r-report")
+})