diff --git a/R/doeAnalysis.R b/R/doeAnalysis.R index bd47f4dd..274000b9 100644 --- a/R/doeAnalysis.R +++ b/R/doeAnalysis.R @@ -1629,47 +1629,84 @@ get_levels <- function(var, num_levels, dataset) { if (!is.null(jaspResults[[dep]][["plotPareto"]]) || !options[["plotPareto"]]) { return() } - plot <- createJaspPlot(title = gettext("Pareto Chart of Standardized Effects"), width = 600, height = 400) - plot$dependOn(options = c("plotPareto", "tableAlias", .doeAnalysisBaseDependencies())) - plot$position <- 6 - jaspResults[[dep]][["plotPareto"]] <- plot if (!ready || is.null(jaspResults[[dep]][["doeResult"]]) || jaspResults[[dep]]$getError()) { return() } result <- if (options[["codeFactors"]]) jaspResults[[dep]][["doeResultCoded"]]$object[["regression"]] else jaspResults[[dep]][["doeResult"]]$object[["regression"]] fac <- if (options[["tableAlias"]]) result[["coefficients"]][["termsAliased"]][-1] else result[["coefficients"]][["terms"]][-1] - coefDf <- data.frame(result[["objectSummary"]]$coefficients) - tDf <- data.frame("tValue" = coefDf[["t.value"]], - terms = result[["coefficients"]][["terms"]]) + coefTerms <- result[["coefficients"]][["terms"]] + metricValues <- result[["coefficients"]][["effects"]] + df <- result[["objectSummary"]]$df[2] + pse <- NA_real_ + if (!is.na(df) && df > 0) { + metricValues <- result[["objectSummary"]]$coefficients[, "t value"] + } else { + effectAbs <- abs(metricValues) + effectAbs <- effectAbs[is.finite(effectAbs)] + if (length(effectAbs) > 0) { + s0 <- 1.5 * stats::median(effectAbs) + s1 <- effectAbs[effectAbs < 2.5 * s0] + if (length(s1) > 0) { + pse <- 1.5 * stats::median(s1) + } + } + } + metricDf <- data.frame(metric = metricValues, terms = coefTerms) # Do not include intercept, covariates and blocks in pareto plot - tDf <- tDf[-1, ] # remove intercept + metricDf <- metricDf[-1, ] # remove intercept if (length(blocks) > 0 && !identical(blocks, "")) { - tDf <- tDf[!grepl(blocks, tDf$terms),] + metricDf <- metricDf[!grepl(blocks, metricDf$terms),] fac <- if (options[["tableAlias"]]) fac[!grepl("BLK", fac)] else fac[!grepl(blocks, fac)] } if (length(covariates) > 0 && !identical(covariates, "")) { - tDf <- tDf[!tDf$terms %in% unlist(covariates), ] # remove the covariate(s) + metricDf <- metricDf[!metricDf$terms %in% unlist(covariates), ] # remove the covariate(s) fac <- if (options[["tableAlias"]]) fac[!grepl("COV", fac)] else fac[!fac %in% unlist(covariates)] } - t <- abs(tDf[["tValue"]]) - df <- result[["objectSummary"]]$df[2] - crit <- abs(qt(0.025, df)) - fac_t <- cbind.data.frame(fac, t) - fac_t <- cbind(fac_t[order(fac_t$t), ], y = seq_len(length(t))) - xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, t, crit)) - critLabelDf <- data.frame(x = 0, y = crit, label = sprintf("t = %.2f", crit)) - p <- ggplot2::ggplot(data = fac_t, mapping = ggplot2::aes(y = t, x = y)) + + metric <- abs(metricDf[["metric"]]) + facMetric <- cbind.data.frame(fac, metric) + facMetric <- cbind(facMetric[order(facMetric$metric), ], y = seq_len(length(metric))) + xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, metric)) + axisLabel <- if (!is.na(df) && df > 0) gettext("Standardized Effect") else gettext("Effect") + plotTitle <- if (!is.na(df) && df > 0) { + gettext("Pareto Chart of Standardized Effects") + } else { + gettext("Pareto Chart of Effects") + } + plot <- createJaspPlot(title = plotTitle, width = 600, height = 400) + plot$dependOn(options = c("plotPareto", "tableAlias", .doeAnalysisBaseDependencies())) + plot$position <- 6 + jaspResults[[dep]][["plotPareto"]] <- plot + p <- ggplot2::ggplot(data = facMetric, mapping = ggplot2::aes(y = metric, x = y)) + ggplot2::geom_bar(stat = "identity") + - ggplot2::geom_hline(yintercept = crit, linetype = "dashed", color = "red") + - ggplot2::geom_label(data = critLabelDf, mapping = ggplot2::aes(x = x, y = y, label = label), col = "red", size = 5) + - ggplot2::scale_x_continuous(name = gettext("Term"), breaks = fac_t$y, labels = fac_t$fac) + - ggplot2::scale_y_continuous(name = - gettext("Standardized Effect"), breaks = xBreaks, limits = range(xBreaks)) + + ggplot2::scale_x_continuous(name = gettext("Term"), breaks = facMetric$y, labels = facMetric$fac) + + ggplot2::scale_y_continuous(name = axisLabel, breaks = xBreaks, limits = range(xBreaks)) + ggplot2::coord_flip() + jaspGraphs::geom_rangeframe() + jaspGraphs::themeJaspRaw() + + df <- result[["objectSummary"]]$df[2] + if (!is.na(df) && df > 0) { + crit <- abs(qt(0.025, df)) + xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, metric, crit)) + critLabelDf <- data.frame(x = 0, y = crit, label = sprintf("t = %.2f", crit)) + p <- p + + ggplot2::geom_hline(yintercept = crit, linetype = "dashed", color = "red") + + ggplot2::geom_label(data = critLabelDf, mapping = ggplot2::aes(x = x, y = y, label = label), col = "red", size = 5) + + ggplot2::scale_y_continuous(name = axisLabel, breaks = xBreaks, limits = range(xBreaks)) + } else if (!is.na(pse) && pse > 0) { + effectAbs <- abs(metric) + dfLenth <- max(1, floor(length(effectAbs) / 3)) + crit <- stats::qt(0.975, dfLenth) * pse + xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, metric, crit)) + critLabelDf <- data.frame(x = 0, y = crit, label = sprintf("ME = %.2f", crit)) + p <- p + + ggplot2::geom_hline(yintercept = crit, linetype = "dashed", color = "red") + + ggplot2::geom_label(data = critLabelDf, mapping = ggplot2::aes(x = x, y = y, label = label), col = "red", size = 5) + + ggplot2::scale_y_continuous(name = axisLabel, breaks = xBreaks, limits = range(xBreaks)) + } + plot$plotObject <- p } } @@ -1679,18 +1716,30 @@ get_levels <- function(var, num_levels, dataset) { if (!is.null(jaspResults[[dep]][["normalEffectsPlot"]]) || !options[["normalEffectsPlot"]]) { return() } - plot <- createJaspPlot(title = gettext("Normal Plot of Standardized Effects"), width = 600, height = 600) - plot$dependOn(options = c("normalEffectsPlot", "tableAlias", .doeAnalysisBaseDependencies())) - plot$position <- 11 - jaspResults[[dep]][["normalEffectsPlot"]] <- plot if (!ready || is.null(jaspResults[[dep]][["doeResult"]]) || jaspResults[[dep]]$getError()) { return() } result <- if (options[["codeFactors"]]) jaspResults[[dep]][["doeResultCoded"]]$object[["regression"]] else jaspResults[[dep]][["doeResult"]]$object[["regression"]] fac <- if (options[["tableAlias"]]) result[["coefficients"]][["termsAliased"]][-1] else result[["coefficients"]][["terms"]][-1] - coefDf <- data.frame(result[["objectSummary"]]$coefficients) - tDf <- data.frame("tValue" = coefDf[["t.value"]], - "terms" = result[["coefficients"]][["terms"]], + coefTerms <- result[["coefficients"]][["terms"]] + metricValues <- result[["coefficients"]][["effects"]] + df <- result[["objectSummary"]]$df[2] + pse <- NA_real_ + if (!is.na(df) && df > 0) { + metricValues <- result[["objectSummary"]]$coefficients[, "t value"] + } else { + effectAbs <- abs(metricValues) + effectAbs <- effectAbs[is.finite(effectAbs)] + if (length(effectAbs) > 0) { + s0 <- 1.5 * stats::median(effectAbs) + s1 <- effectAbs[effectAbs < 2.5 * s0] + if (length(s1) > 0) { + pse <- 1.5 * stats::median(s1) + } + } + } + tDf <- data.frame("metric" = metricValues, + "terms" = coefTerms, "pValue" = result[["coefficients"]][["p"]]) # Do not include intercept, covariates and blocks in normal effects plot @@ -1707,26 +1756,61 @@ get_levels <- function(var, num_levels, dataset) { tDf$fac <- fac # median rank order function - x <- tDf$tValue[order(tDf$tValue)] - n <- length(x) - i <- rank(x) - p <- (i - 0.3) / (n + 0.4) - tDf$percentile <- p[order(tDf$tValue)] + orderIdx <- order(tDf$metric) + n <- length(orderIdx) + p <- (seq_len(n) - 0.3) / (n + 0.4) + tDf$percentile <- NA_real_ + tDf$percentile[orderIdx] <- p # statistical significance - tDf$significant <- ifelse(tDf$pValue < 0.05, "S", "N") + if (!is.na(df) && df > 0) { + tDf$significant <- ifelse(!is.na(tDf$pValue) & tDf$pValue < 0.05, "S", "N") + } else if (!is.na(pse) && pse > 0) { + dfLenth <- max(1, floor(nrow(tDf) / 3)) + crit <- stats::qt(0.975, dfLenth) * pse + tDf$significant <- ifelse(abs(tDf$metric) > crit, "S", "N") + } else { + tDf$significant <- "N" + } tDf$labelYPos <- stats::pnorm(stats::qnorm(tDf$percentile) + 0.2) # offset the label by a small amount (0.2) so it is displayed above the point yLabels <- c(0.1, 1, 5, seq(10, 90, 10), 95, 99, 99.9) yBreaks <- yLabels/100 - xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(tDf$tValue, -3, 3)) - xLimits <- range(c(tDf$tValue, xBreaks)) + yLimits <- range(yBreaks) + lineSpan <- if (!is.na(df) && df > 0) { + stats::qnorm(yLimits) + } else if (!is.na(pse) && pse > 0) { + stats::qnorm(yLimits, mean = 0, sd = pse) + } else { + stats::qnorm(yLimits) + } + xLimits <- range(c(tDf$metric, lineSpan)) + xBreaks <- jaspGraphs::getPrettyAxisBreaks(xLimits) + xLimits <- range(xBreaks) + axisLabel <- if (!is.na(df) && df > 0) gettext("Standardized Effect") else gettext("Effect") + plotTitle <- if (!is.na(df) && df > 0) { + gettext("Normal Plot of Standardized Effects") + } else { + gettext("Normal Plot of Effects") + } + plot <- createJaspPlot(title = plotTitle, width = 600, height = 600) + plot$dependOn(options = c("normalEffectsPlot", "tableAlias", .doeAnalysisBaseDependencies())) + plot$position <- 11 + jaspResults[[dep]][["normalEffectsPlot"]] <- plot # Create the ggplot with probit transformation - p <- ggplot2::ggplot(data = tDf, mapping = ggplot2::aes(x = tValue, y = percentile)) + - ggplot2::stat_function(fun = pnorm, linewidth = 1) + # Reference line using the pnorm function + lineFn <- if (!is.na(df) && df > 0) { + function(x) stats::pnorm(x) + } else if (!is.na(pse) && pse > 0) { + function(x) stats::pnorm(x, mean = 0, sd = pse) + } else { + function(x) stats::pnorm(x) + } + + p <- ggplot2::ggplot(data = tDf, mapping = ggplot2::aes(x = metric, y = percentile)) + + ggplot2::stat_function(fun = lineFn, linewidth = 1) + jaspGraphs::geom_point(mapping = ggplot2::aes(fill = significant), size = 4) + - ggplot2::scale_y_continuous(trans = 'probit', labels = yLabels, breaks = yBreaks, name = "Percent", limits = c(0.0001, 0.9999)) + - ggplot2::scale_x_continuous(name = "Standardized Effect", breaks = xBreaks, limits = xLimits) + + ggplot2::scale_y_continuous(trans = 'probit', labels = yLabels, breaks = yBreaks, name = "Percent", limits = yLimits) + + ggplot2::scale_x_continuous(name = axisLabel, breaks = xBreaks, limits = xLimits) + ggplot2::scale_fill_manual(values = c("S" = "darkred", "N" = "grey"), name = NULL, labels = c(gettext("Significant"), gettext("Not Significant")), breaks = c("S", "N")) + ggplot2::geom_label(mapping = ggplot2::aes(label = fac, y = labelYPos), size = 4) + jaspGraphs::themeJaspRaw() + diff --git a/tests/testthat/_snaps/doeAnalysis/histogram-of-residuals.svg b/tests/testthat/_snaps/doeAnalysis/histogram-of-residuals.svg new file mode 100644 index 00000000..aaea3da7 --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/histogram-of-residuals.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + +-1 +-0.8 +-0.6 +-0.4 +-0.2 +0 +Counts +histogram-of-residuals + + diff --git a/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-1.svg b/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-1.svg new file mode 100644 index 00000000..b160af19 --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-1.svg @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-1 +0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 +4.0 +Run order +Residuals +matrix-residual-plot-subplot-1 + + diff --git a/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-2.svg b/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-2.svg new file mode 100644 index 00000000..5fbf57ec --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-2.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-1 +0 + + + + + + + + + + +4 +6 +8 +10 +12 +14 +16 +Fitted values +Residuals +matrix-residual-plot-subplot-2 + + diff --git a/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-3.svg b/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-3.svg new file mode 100644 index 00000000..ee87deec --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-3.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +1 +2 +3 +4 + + + + + + + + + + + + +-1 +-0.8 +-0.6 +-0.4 +-0.2 +0 +Counts +matrix-residual-plot-subplot-3 + + diff --git a/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-4.svg b/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-4.svg new file mode 100644 index 00000000..cdf0f168 --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/matrix-residual-plot-subplot-4.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + +-1 +0 +1 +Theoretical quantiles +Observed quantiles +matrix-residual-plot-subplot-4 + + diff --git a/tests/testthat/_snaps/doeAnalysis/normal-plot-of-effects.svg b/tests/testthat/_snaps/doeAnalysis/normal-plot-of-effects.svg new file mode 100644 index 00000000..253f07b3 --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/normal-plot-of-effects.svg @@ -0,0 +1,100 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +A + +B + +AB + + + + + + +0.1 +1 +5 +10 +20 +30 +40 +50 +60 +70 +80 +90 +95 +99 +99.9 + + + + + + + + + + + + + + + + + + + + + + + +-30 +-20 +-10 +0 +10 +20 +30 +Effect +Percent + + + + +Not Significant +normal-plot-of-effects + + diff --git a/tests/testthat/_snaps/doeAnalysis/normal-probability-plot-of-residuals.svg b/tests/testthat/_snaps/doeAnalysis/normal-probability-plot-of-residuals.svg new file mode 100644 index 00000000..7eb62ff7 --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/normal-probability-plot-of-residuals.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-0.10 +-0.05 +0.00 +0.05 +0.10 + + + + + + + + + +-1 +0 +1 +Theoretical quantiles +Observed quantiles +normal-probability-plot-of-residuals + + diff --git a/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-effects.svg b/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-effects.svg new file mode 100644 index 00000000..c7cafd7e --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-effects.svg @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +ME = 85.77 + + + + +A +AB +B + + + + + + + + + + +0 +20 +40 +60 +80 +100 +Effect +Term +pareto-chart-of-effects + + diff --git a/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-standardized-effects27.new.svg b/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-standardized-effects27.new.svg new file mode 100644 index 00000000..7225e4fd --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-standardized-effects27.new.svg @@ -0,0 +1,113 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +t = 2.12 + + + + +C +BE +AD +AC +CD +AE +D +AB +BD +BC +A +DE +CE +B +E + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 +Standardized Effect +Term + + + diff --git a/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-standardized-effects27.svg b/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-standardized-effects27.svg index 6681f613..7225e4fd 100644 --- a/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-standardized-effects27.svg +++ b/tests/testthat/_snaps/doeAnalysis/pareto-chart-of-standardized-effects27.svg @@ -1,5 +1,6 @@ - + + - - + + - - + + - - + + - - - - - - - - - - - - - - - - - - - -t = 2.12 - - - + + + + + + + + + + + + + + + + + + + + + +t = 2.12 + + + + +C +BE +AD +AC +CD +AE +D +AB +BD +BC +A +DE +CE +B +E + + + + + + + + + + + + + + + + + + + + + + + + +0.0 +0.5 +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 +Standardized Effect +Term - - -C -BE -AD -AC -CD -AE -D -AB -BD -BC -A -DE -CE -B -E - - - - - - - - - - - - - - - - - - - - - - - - -0.0 -0.5 -1.0 -1.5 -2.0 -2.5 -3.0 -3.5 -Standardized Effect -Term -pareto-chart-of-standardized-effects27 diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/histogram-of-residuals.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/histogram-of-residuals.rds new file mode 100644 index 00000000..a8496173 Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/histogram-of-residuals.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-1.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-1.rds new file mode 100644 index 00000000..01efce26 Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-1.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-2.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-2.rds new file mode 100644 index 00000000..b77da550 Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-2.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-3.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-3.rds new file mode 100644 index 00000000..a8496173 Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-3.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-4.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-4.rds new file mode 100644 index 00000000..2cfd1d53 Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/matrix-residual-plot-subplot-4.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/normal-plot-of-effects.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/normal-plot-of-effects.rds new file mode 100644 index 00000000..b35fb03b Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/normal-plot-of-effects.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/normal-probability-plot-of-residuals.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/normal-probability-plot-of-residuals.rds new file mode 100644 index 00000000..2cfd1d53 Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/normal-probability-plot-of-residuals.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/pareto-chart-of-effects.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/pareto-chart-of-effects.rds new file mode 100644 index 00000000..1f4ee82d Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/pareto-chart-of-effects.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/pareto-chart-of-standardized-effects27.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/pareto-chart-of-standardized-effects27.rds index 4799b4ac..08019929 100644 Binary files a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/pareto-chart-of-standardized-effects27.rds and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/pareto-chart-of-standardized-effects27.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/residuals-versus-fitted-values.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/residuals-versus-fitted-values.rds new file mode 100644 index 00000000..b77da550 Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/residuals-versus-fitted-values.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/reference_plotobject/residuals-versus-run-order.rds b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/residuals-versus-run-order.rds new file mode 100644 index 00000000..01efce26 Binary files /dev/null and b/tests/testthat/_snaps/doeAnalysis/reference_plotobject/residuals-versus-run-order.rds differ diff --git a/tests/testthat/_snaps/doeAnalysis/residuals-versus-fitted-values.svg b/tests/testthat/_snaps/doeAnalysis/residuals-versus-fitted-values.svg new file mode 100644 index 00000000..5c4e3dd7 --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/residuals-versus-fitted-values.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-1 +0 + + + + + + + + + + +4 +6 +8 +10 +12 +14 +16 +Fitted values +Residuals +residuals-versus-fitted-values + + diff --git a/tests/testthat/_snaps/doeAnalysis/residuals-versus-run-order.svg b/tests/testthat/_snaps/doeAnalysis/residuals-versus-run-order.svg new file mode 100644 index 00000000..79c2d010 --- /dev/null +++ b/tests/testthat/_snaps/doeAnalysis/residuals-versus-run-order.svg @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-1 +0 + + + + + + + + + + +1.0 +1.5 +2.0 +2.5 +3.0 +3.5 +4.0 +Run order +Residuals +residuals-versus-run-order + + diff --git a/tests/testthat/datasets/doeAnalysis/doe_realDataExampleSaturated.csv b/tests/testthat/datasets/doeAnalysis/doe_realDataExampleSaturated.csv new file mode 100644 index 00000000..d07aad12 --- /dev/null +++ b/tests/testthat/datasets/doeAnalysis/doe_realDataExampleSaturated.csv @@ -0,0 +1,5 @@ +RunOrder,StandardOrder,Fac1,Fac2,Response +1,2,65,75,16 +2,3,40,100,6 +3,1,40,75,8 +4,4,65,100,5 diff --git a/tests/testthat/test-doeAnalysis.R b/tests/testthat/test-doeAnalysis.R index a520082e..48153bfe 100644 --- a/tests/testthat/test-doeAnalysis.R +++ b/tests/testthat/test-doeAnalysis.R @@ -5159,3 +5159,103 @@ test_that("53.4 Response Optimizer Response Surface Change All Options - Respons options("jaspRoundToPrecision" = NULL) # reset default + +## Factorial Design Saturated #### +options <- analysisOptions("doeAnalysis") +options$dependentFactorial <- "Response" +options$continuousFactorsFactorial <- c("Fac1", "Fac2") +options$codeFactors <- TRUE +options$codeFactorsMethod <- "automatic" +options$tableEquation <- TRUE +options$tableAlias <- TRUE +options$highestOrder <- FALSE +options$histogramBinWidthType <- "doane" +options$plotNorm <- TRUE +options$plotHist <- TRUE +options$plotFitted <- TRUE +options$plotRunOrder <- TRUE +options$fourInOneResidualPlot <- TRUE +options$normalEffectsPlot <- TRUE +options$plotPareto <- TRUE +options$modelTerms <- list( + list(components = "Fac1"), + list(components = "Fac2"), + list(components = c("Fac1", "Fac2")) +) +set.seed(123) +results <- runAnalysis("doeAnalysis", "datasets/doeAnalysis/doe_realDataExampleSaturated.csv", options) + +test_that("54.1 Factorial Design Saturated - Matrix residual plot matches", { + plotName <- results[["results"]][["Response"]][["collection"]][["Response_fourInOneResidualPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "matrix-residual-plot") +}) + +test_that("54.2 Factorial Design Saturated - Normal Plot of Effects matches", { + plotName <- results[["results"]][["Response"]][["collection"]][["Response_normalEffectsPlot"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "normal-plot-of-effects") +}) + +test_that("54.3 Factorial Design Saturated - Residuals versus Fitted Values plot matches", { + plotName <- results[["results"]][["Response"]][["collection"]][["Response_plotFitted"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "residuals-versus-fitted-values") +}) + +test_that("54.4 Factorial Design Saturated - Histogram of Residuals plot matches", { + plotName <- results[["results"]][["Response"]][["collection"]][["Response_plotHist"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "histogram-of-residuals") +}) + +test_that("54.5 Factorial Design Saturated - Normal Probability Plot of Residuals matches", { + plotName <- results[["results"]][["Response"]][["collection"]][["Response_plotNorm"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "normal-probability-plot-of-residuals") +}) + +test_that("54.6 Factorial Design Saturated - Pareto Chart of Effects plot matches", { + plotName <- results[["results"]][["Response"]][["collection"]][["Response_plotPareto"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "pareto-chart-of-effects") +}) + +test_that("54.7 Factorial Design Saturated - Residuals versus Run Order plot matches", { + plotName <- results[["results"]][["Response"]][["collection"]][["Response_plotRunOrder"]][["data"]] + testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]] + jaspTools::expect_equal_plots(testPlot, "residuals-versus-run-order") +}) + +test_that("54.8 Factorial Design Saturated - ANOVA table results match", { + table <- results[["results"]][["Response"]][["collection"]][["Response_tableAnova"]][["data"]] + jaspTools::expect_equal_tables(table, + list(24.9166666666667, 74.75, 3, "", "", "Model", "", 54.5, 2, "", + "", " Linear terms", 12.25, 12.25, 1, "", "", " Fac1", + 42.25, 42.25, 1, "", "", " Fac2", "", 20.25, + 1, "", "", " Interaction terms", 20.25, 20.25, 1, "", + "", " Fac1Fac2", + 0, 0, 0, "", "", "Error", "", 74.75, 3, "", "", "Total")) +}) + +test_that("54.9 Factorial Design Saturated - Coded Coefficients table results match", { + table <- results[["results"]][["Response"]][["collection"]][["Response_tableCoefficients"]][["data"]] + jaspTools::expect_equal_tables(table, + list("(Intercept)", 8.75, "", "", "", "(Intercept)", "", "", "A", 1.75, + 3.5, "", "", "Fac1", "", "NaN", "B", -3.25, -6.5, "", "", "Fac2", + "", "NaN", "AB", -2.25, -4.5, "", "", "Fac1Fac2", "", + "NaN")) +}) + +test_that("54.10 Factorial Design Saturated - Regression equation in Coded Units table results match", { + table <- results[["results"]][["Response"]][["collection"]][["Response_tableEquation"]][["data"]] + jaspTools::expect_equal_tables(table, + list("Response = 8.75 + 1.75 A 3.25 B 2.25 AB" + )) +}) + +test_that("54.11 Factorial Design Saturated - Model Summary table results match", { + table <- results[["results"]][["Response"]][["collection"]][["Response_tableSummary"]][["data"]] + jaspTools::expect_equal_tables(table, + list("", "", 1, "")) +})