tests/testthat/test-mct.R

dat.aov <- aov(Petal.Width ~ Species, data = iris)

# ============================================================================
# NEW TESTS FOR LIST STRUCTURE AND P-VALUE MATRIX
# ============================================================================

test_that("multiple_comparisons returns a list with correct structure", {
    output <- multiple_comparisons(dat.aov, classify = "Species")

    # Test that output is a list
    expect_type(output, "list")
    expect_s3_class(output, "mct")

    # Test that all expected elements are present
    expect_true("predictions" %in% names(output))
    expect_true("pairwise_pvalues" %in% names(output))
    expect_true("hsd" %in% names(output))
    expect_true("sig_level" %in% names(output))

    # Test that each element has the correct type
    expect_s3_class(output$predictions, "data.frame")
    expect_type(output$pairwise_pvalues, "double")
    expect_true(is.matrix(output$pairwise_pvalues))
    expect_type(output$hsd, "double")
    expect_type(output$sig_level, "double")
})

test_that("predictions component has correct structure", {
    output <- multiple_comparisons(dat.aov, classify = "Species")
    pred <- output$predictions

    # Check it's a data frame
    expect_s3_class(pred, "data.frame")

    # Check expected columns exist
    expect_true("Species" %in% colnames(pred))
    expect_true("predicted.value" %in% colnames(pred))
    expect_true("std.error" %in% colnames(pred))
    expect_true("low" %in% colnames(pred))
    expect_true("up" %in% colnames(pred))
    expect_true("groups" %in% colnames(pred))

    # Check number of rows
    expect_equal(nrow(pred), 3)  # 3 species

    # Check values are correct
    expect_equal(pred$predicted.value, c(0.25, 1.33, 2.03), tolerance = 5e-2)
})

test_that("p-value matrix has correct properties", {
    output <- multiple_comparisons(dat.aov, classify = "Species")
    pvals <- output$pairwise_pvalues

    # Check it's a matrix
    expect_true(is.matrix(pvals))

    # Check dimensions
    expect_equal(nrow(pvals), 3)
    expect_equal(ncol(pvals), 3)

    # Check row and column names
    expect_equal(rownames(pvals), c("setosa", "versicolor", "virginica"))
    expect_equal(colnames(pvals), c("setosa", "versicolor", "virginica"))

    # Check diagonal is 1 (no difference with itself)
    expect_equal(diag(pvals), c(setosa=1, versicolor=1, virginica=1))

    # Check all values are in [0, 1]
    expect_true(all(pvals >= 0 & pvals <= 1))

    # Check symmetry
    expect_true(isSymmetric(pvals))

    # Check that p-values match expected significance
    # setosa vs versicolor should be significant (different groups)
    expect_true(pvals["setosa", "versicolor"] < 0.05)
    # setosa vs virginica should be significant
    expect_true(pvals["setosa", "virginica"] < 0.05)
    # versicolor vs virginica should be significant
    expect_true(pvals["versicolor", "virginica"] < 0.05)
})

test_that("calculate_pvalue_matrix supports Matrix SED inputs", {
    skip_if_not_installed("Matrix")

    pp <- data.frame(
        predicted.value = c(10, 12, 13, 15),
        Names = c("A", "B", "C", "D")
    )

    sed_base <- matrix(0.5, nrow = 4, ncol = 4)
    diag(sed_base) <- NA_real_

    # Create a packed symmetric *dense* Matrix (dspMatrix).
    # Using sparse=TRUE yields a dsCMatrix which cannot be coerced to dspMatrix.
    sed_mat <- as(
        Matrix::forceSymmetric(Matrix::Matrix(sed_base, sparse = FALSE), uplo = "U"),
        "packedMatrix"
    )

    pvals <- biometryassist:::calculate_pvalue_matrix(pp, sed_mat, ndf = 10)

    expect_true(is.matrix(pvals))
    expect_type(pvals, "double")
    expect_true(isSymmetric(pvals))
    expect_equal(rownames(pvals), pp$Names)
    expect_equal(colnames(pvals), pp$Names)
    expect_true(all(pvals[upper.tri(pvals)] >= 0 & pvals[upper.tri(pvals)] <= 1, na.rm = TRUE))
})

test_that("calculate_pvalue_matrix supports scalar SED inputs", {
    pp <- data.frame(
        predicted.value = c(10, 12, 13, 15),
        Names = c("A", "B", "C", "D")
    )

    # Scalar SED implies the same standard error for every comparison.
    # This covers the `rep_len(sed, length(diff))` branch.
    pvals <- biometryassist:::calculate_pvalue_matrix(pp, sed = 0.5, ndf = 10)

    expect_true(is.matrix(pvals))
    expect_type(pvals, "double")
    expect_true(isSymmetric(pvals))
    expect_equal(rownames(pvals), pp$Names)
    expect_equal(colnames(pvals), pp$Names)
    expect_equal(diag(pvals), rep(1, nrow(pp)), ignore_attr = TRUE)
    expect_true(all(pvals[upper.tri(pvals)] >= 0 & pvals[upper.tri(pvals)] <= 1, na.rm = TRUE))
})

test_that("calculate_pvalue_matrix supports base-matrix SED inputs", {
    pp <- data.frame(
        predicted.value = c(10, 11, 15),
        Names = c("A", "B", "C")
    )

    # A plain base matrix should take the `!is.null(dim(sed))` branch.
    sed_mat <- matrix(0.5, nrow = 3, ncol = 3,
                      dimnames = list(pp$Names, pp$Names))
    diag(sed_mat) <- NA_real_

    pvals <- biometryassist:::calculate_pvalue_matrix(pp, sed = sed_mat, ndf = 10)

    expect_true(is.matrix(pvals))
    expect_type(pvals, "double")
    expect_true(isSymmetric(pvals))
    expect_equal(rownames(pvals), pp$Names)
    expect_equal(colnames(pvals), pp$Names)
    expect_equal(diag(pvals), rep(1, 3), ignore_attr = TRUE)

    # Spot-check one expected p-value to ensure indexing is correct.
    diff_ab <- abs(pp$predicted.value[1] - pp$predicted.value[2])
    q_ab <- as.numeric(diff_ab / 0.5) * sqrt(2)
    expected_ab <- stats::ptukey(q_ab, nmeans = 3, df = 10, lower.tail = FALSE)
    expect_equal(pvals["A", "B"], expected_ab, tolerance = 1e-12)
})

test_that("calculate_pvalue_matrix returns a 1x1 matrix when n <= 1", {
    pp <- data.frame(
        predicted.value = 10,
        Names = "A"
    )

    pvals <- biometryassist:::calculate_pvalue_matrix(pp, sed = 0.5, ndf = 10)

    expect_true(is.matrix(pvals))
    expect_equal(dim(pvals), c(1L, 1L))
    expect_equal(rownames(pvals), "A")
    expect_equal(colnames(pvals), "A")
    expect_equal(pvals[1, 1], 1)
})

test_that("HSD value is accessible and correct", {
    output <- multiple_comparisons(dat.aov, classify = "Species")

    # Check HSD is numeric
    expect_type(output$hsd, "double")

    # Check HSD is positive
    expect_true(output$hsd > 0)

    # Check HSD is accessible via attribute for backward compatibility
    expect_equal(attr(output, "HSD"), output$hsd)
})

test_that("sig_level is stored correctly", {
    output1 <- multiple_comparisons(dat.aov, classify = "Species", sig = 0.05)
    expect_equal(output1$sig_level, 0.05)

    output2 <- multiple_comparisons(dat.aov, classify = "Species", sig = 0.01)
    expect_equal(output2$sig_level, 0.01)
})

test_that("p-value matrix calculation with interaction terms", {
    # Create data with two factors
    set.seed(123)
    factorial_data <- expand.grid(
        Factor1 = factor(c("A", "B")),
        Factor2 = factor(c("X", "Y")),
        Rep = 1:5
    )
    factorial_data$Response <- rnorm(nrow(factorial_data),
                                     mean = 50 + as.numeric(factorial_data$Factor1) * 10 +
                                         as.numeric(factorial_data$Factor2) * 5,
                                     sd = 5)

    model_int <- aov(Response ~ Factor1 * Factor2, data = factorial_data)
    output <- multiple_comparisons(model_int, classify = "Factor1:Factor2")

    # Check matrix dimensions (2 * 2 = 4 combinations)
    expect_equal(nrow(output$pairwise_pvalues), 4)
    expect_equal(ncol(output$pairwise_pvalues), 4)

    # Check row/column names are treatment combinations
    expected_names <- c("A_X", "A_Y", "B_X", "B_Y")
    expect_equal(sort(rownames(output$pairwise_pvalues)), sort(expected_names))

    # Check matrix properties
    expect_true(isSymmetric(output$pairwise_pvalues))
    expect_equal(diag(output$pairwise_pvalues), rep(1, 4), ignore_attr = TRUE)
})

test_that("p-values without letter groups still calculated", {
    output <- multiple_comparisons(dat.aov, classify = "Species", groups = FALSE)

    # Check predictions doesn't have groups column
    expect_false("groups" %in% colnames(output$predictions))

    # Check p-value matrix is still created
    expect_true("pairwise_pvalues" %in% names(output))
    expect_true(is.matrix(output$pairwise_pvalues))
    expect_equal(nrow(output$pairwise_pvalues), 3)
})

test_that("print.mct shows list structure information", {
    output <- multiple_comparisons(dat.aov, classify = "Species")

    # Capture print output
    printed <- capture.output(print(output))

    # Check for key elements in output
    expect_true(any(grepl("Multiple Comparisons", printed)))
    expect_true(any(grepl("Significance level", printed)))
    expect_true(any(grepl("HSD", printed)))
    expect_true(any(grepl("Predicted values", printed)))
})

test_that("aliased treatments in list structure", {
    CO_2 <- CO2
    CO_2$uptake[CO_2$Type=="Quebec" & CO_2$Treatment=="nonchilled"] <- NA
    model <- aov(uptake~Type+Treatment+Type:Treatment, data = CO_2)

    expect_warning(
        output <- multiple_comparisons(model, classify = "Type:Treatment"),
        "A level of Type\\:Treatment is aliased"
    )

    # Check aliased is stored in list
    expect_true("aliased" %in% names(output))
    expect_equal(output$aliased, "Quebec:nonchilled")

    # Check aliased is also in attributes for backward compatibility
    expect_equal(attr(output, "aliased"), "Quebec:nonchilled")
})

test_that("backward compatibility: attributes still accessible", {
    output <- multiple_comparisons(dat.aov, classify = "Species")

    # Check attributes that should be preserved
    expect_false(is.null(attr(output, "ylab")))
    expect_false(is.null(attr(output, "HSD")))
    expect_equal(attr(output, "HSD"), output$hsd)
})

test_that("list elements accessible via $ and [[", {
    output <- multiple_comparisons(dat.aov, classify = "Species")

    # Test $ access
    expect_s3_class(output$predictions, "data.frame")
    expect_true(is.matrix(output$pairwise_pvalues))
    expect_type(output$hsd, "double")
    expect_type(output$sig_level, "double")

    # Test [[ access
    expect_identical(output$predictions, output[[1]])
    expect_identical(output$pairwise_pvalues, output[[2]])
    expect_identical(output$hsd, output[[3]])
    expect_identical(output$sig_level, output[[4]])
})

test_that("p-value matrix with different interval types", {
    # All interval types should produce the same p-value matrix
    output_ci <- multiple_comparisons(dat.aov, classify = "Species", int.type = "ci")
    output_tukey <- multiple_comparisons(dat.aov, classify = "Species", int.type = "tukey")
    output_1se <- multiple_comparisons(dat.aov, classify = "Species", int.type = "1se")

    # P-values should be identical regardless of interval type
    expect_equal(output_ci$pairwise_pvalues, output_tukey$pairwise_pvalues)
    expect_equal(output_ci$pairwise_pvalues, output_1se$pairwise_pvalues)
})

test_that("p-value matrix with transformations", {
    dat.aov.log <- aov(log(Petal.Width) ~ Species, data = iris)
    output <- multiple_comparisons(dat.aov.log, classify = "Species",
                                   trans = "log", offset = 0)

    # Check p-value matrix exists and has correct properties
    expect_true("pairwise_pvalues" %in% names(output))
    expect_true(is.matrix(output$pairwise_pvalues))
    expect_equal(nrow(output$pairwise_pvalues), 3)
    expect_true(isSymmetric(output$pairwise_pvalues))
    expect_equal(diag(output$pairwise_pvalues), rep(1, 3), ignore_attr = TRUE)
})


# ============================================================================
# ORIGINAL TESTS (Updated to work with new structure)
# ============================================================================

test_that("mct produces output", {
    tmp <- withr::local_tempdir()
    withr::with_dir(tmp, {
        withr::local_file("Rplots.pdf")

        output <- multiple_comparisons(dat.aov, classify = "Species", plot = TRUE)
        while (grDevices::dev.cur() > 1) grDevices::dev.off()

        expect_equal(output$predictions$predicted.value, c(0.25, 1.33, 2.03), tolerance = 5e-2)
        vdiffr::expect_doppelganger("mct output", autoplot(output))
    })
})

test_that("mct ylab handles call/language labels", {
    pp <- data.frame(
        trt = factor(c("A", "B")),
        predicted.value = c(1, 2),
        std.error = c(0.1, 0.1),
        Df = c(10, 10),
        ci = c(0.2, 0.2),
        low = c(0.8, 1.8),
        up = c(1.2, 2.2),
        groups = c("a", "b")
    )

    # Note: This test uses internal function, may need adjustment
    # based on how add_attributes is updated
    out <- biometryassist:::add_attributes(pp, ylab = quote(sqrt(response)),
                                           crit_val = matrix(0, nrow = 2, ncol = 2),
                                           aliased_names = NULL)

    expect_identical(attr(out, "ylab"), quote(sqrt(response)))
})

test_that("add_attributes stores aliased and matrix HSD attributes", {
    pp <- data.frame(
        trt = factor(c("A", "B")),
        predicted.value = c(1, 2),
        std.error = c(0.1, 0.1),
        df = c(10, 10),
        ci = c(0.2, 0.2),
        low = c(0.8, 1.8),
        up = c(1.2, 2.2),
        groups = c("a", "b")
    )

    # Non-constant matrix ensures the var() check takes the matrix branch.
    crit_val <- matrix(c(0, 1, 2, 3), nrow = 2, ncol = 2)

    out <- biometryassist:::add_attributes(
        pp,
        ylab = quote(log(Petal.Width)),
        crit_val = crit_val,
        aliased_names = "B",
        trans = "log"
    )

    expect_identical(attr(out, "ylab"), "Petal.Width")
    expect_identical(attr(out, "aliased"), "B")
    expect_identical(attr(out, "HSD"), crit_val)
})

test_that("mct transformation: log", {
    dat.aov.log <- aov(log(Petal.Width) ~ Species, data = iris)
    output.log <- multiple_comparisons(dat.aov.log, classify = "Species", trans = "log", offset = 0)
    output.log2 <- multiple_comparisons(dat.aov.log, classify = "Species", trans = "log", offset = 0, int.type = "1se")
    output.log3 <- multiple_comparisons(dat.aov.log, classify = "Species", trans = "log", offset = 0, int.type = "2se")

    expect_identical(attr(output.log, "ylab"), "Petal.Width")
    expect_equal(output.log$predictions$predicted.value, c(-1.48, 0.27, 0.70), tolerance = 5e-2)
    expect_equal(output.log2$predictions$low, c(0.22, 1.26, 1.94), tolerance = 5e-2)
    expect_equal(output.log3$predictions$up, c(0.25, 1.41, 2.17), tolerance = 5e-2)
    vdiffr::expect_doppelganger("mct log output", autoplot(output.log))
})

test_that("mct transformation: sqrt", {
    dat.aov.sqrt <- aov(sqrt(Petal.Width) ~ Species, data = iris)
    output.sqrt <- multiple_comparisons(dat.aov.sqrt, classify = "Species", trans = "sqrt", offset = 0)
    output.sqrt2 <- multiple_comparisons(dat.aov.sqrt, classify = "Species", trans = "sqrt", offset = 0, int.type = "1se")
    output.sqrt3 <- multiple_comparisons(dat.aov.sqrt, classify = "Species", trans = "sqrt", offset = 0, int.type = "2se")

    expect_identical(attr(output.sqrt, "ylab"), "Petal.Width")
    expect_equal(output.sqrt$predictions$predicted.value, c(0.49, 1.15, 1.42), tolerance = 5e-2)
    expect_equal(output.sqrt2$predictions$low, c(0.23, 1.29, 1.98), tolerance = 5e-2)
    expect_equal(output.sqrt3$predictions$up, c(0.27, 1.38, 2.09), tolerance = 5e-2)
    vdiffr::expect_doppelganger("mct sqrt output", autoplot(output.sqrt))
})

test_that("mct transformation: logit", {
    dat.aov.logit <- aov(logit(1/Petal.Width) ~ Species, data = iris)
    expect_warning(
        output.logit <- multiple_comparisons(dat.aov.logit, classify = "Species", trans = "logit", offset = 0),
        "Some standard errors are very small and would round to zero with 2 decimal places"
    )
    expect_warning(
        output.logit2 <- multiple_comparisons(dat.aov.logit, classify = "Species", trans = "logit", offset = 0, int.type = "1se"),
        "Some standard errors are very small and would round to zero with 2 decimal places"
    )
    expect_warning(
        output.logit3 <- multiple_comparisons(dat.aov.logit, classify = "Species", trans = "logit", offset = 0, int.type = "2se"),
        "Some standard errors are very small and would round to zero with 2 decimal places"
    )

    expect_identical(attr(output.logit, "ylab"), "1/Petal.Width")
    expect_equal(output.logit$predictions$predicted.value, c(-5.30, -4.87, -3.07), tolerance = 5e-2)
    expect_equal(output.logit2$predictions$low, c(0.00, 0.01, 0.04), tolerance = 5e-2)
    expect_equal(output.logit3$predictions$up, c(0.01, 0.01, 0.05), tolerance = 5e-2)
    vdiffr::expect_doppelganger("mct logit output", autoplot(output.logit))
})

test_that("mct transformation: inverse", {
    dat.aov.inverse <- aov((1/Petal.Width) ~ Species, data = iris)
    output.inverse <- multiple_comparisons(dat.aov.inverse, classify = "Species", trans = "inverse", offset = 0)
    output.inverse2 <- multiple_comparisons(dat.aov.inverse, classify = "Species", trans = "inverse", offset = 0, int.type = "1se")
    output.inverse3 <- multiple_comparisons(dat.aov.inverse, classify = "Species", trans = "inverse", offset = 0, int.type = "2se")

    expect_identical(attr(output.inverse, "ylab"), "Petal.Width")
    expect_equal(output.inverse$predictions$predicted.value, c(0.50, 0.77, 4.79), tolerance = 5e-2)
    expect_equal(output.inverse2$predictions$up, c(3.01, 1.66, 0.22), tolerance = 5e-2)
    expect_equal(output.inverse3$predictions$low, c(1.20, 0.90, 0.20), tolerance = 5e-2)
    vdiffr::expect_doppelganger("mct inverse output", autoplot(output.inverse))
})

test_that("mct transformation: power", {
    iris_new <- iris
    iris_new$Petal.Width <- (iris_new$Petal.Width+1)^3
    dat.aov.power <- aov(Petal.Width ~ Species, data = iris_new)
    output.power <- multiple_comparisons(dat.aov.power, classify = "Species", trans = "power", offset = 1, power = 3)
    output.power2 <- multiple_comparisons(dat.aov.power, classify = "Species", trans = "power", offset = 1, power = 3, int.type = "1se")
    output.power3 <- multiple_comparisons(dat.aov.power, classify = "Species", trans = "power", offset = 1, power = 3, int.type = "2se")

    expect_identical(attr(output.power, "ylab"), "Petal.Width")
    expect_equal(output.power$predictions$predicted.value, c(1.98, 12.85, 28.38), tolerance = 5e-2)
    expect_equal(output.power2$predictions$low, c(0.09, 1.30, 2.03), tolerance = 5e-2)
    expect_equal(output.power3$predictions$up, c(0.49, 1.42, 2.10), tolerance = 5e-2)
    vdiffr::expect_doppelganger("mct power output", autoplot(output.power))
})

test_that("mct transformation: arcsin", {
    iris_arc <- iris
    iris_arc$PW <- iris_arc$Petal.Width / max(iris_arc$Petal.Width)
    dat.aov.arcsin <- aov(asin(sqrt(PW)) ~ Species, data = iris_arc)
    expect_warning(output.arcsin <- multiple_comparisons(dat.aov.arcsin,
                                                         classify = "Species",
                                                         trans = "arcsin", offset = 0),
                   "There are unevaluated constants in the response formula")

    expect_identical(attr(output.arcsin, "ylab"), "PW")
    expect_true("PredictedValue" %in% names(output.arcsin$predictions))
    expect_true(all(output.arcsin$predictions$PredictedValue >= 0 & output.arcsin$predictions$PredictedValue <= 1))
    expected_pw_means <- tapply(iris_arc$PW, iris_arc$Species, mean)
    expect_equal(output.arcsin$predictions$PredictedValue,
                 as.numeric(expected_pw_means[as.character(output.arcsin$predictions$Species)]),
                 tolerance = 5e-2)
})

test_that("apply_transformation warns when offset is missing", {
    pp <- data.frame(
        predicted.value = c(0),
        std.error = c(0.1),
        ci = c(0.2)
    )

    expect_warning(
        out <- biometryassist:::apply_transformation(pp, trans = "log", offset = NULL, power = NULL),
        "Offset value assumed to be 0\\. Change with `offset` argument\\."
    )

    expect_true(all(c("PredictedValue", "ApproxSE", "low", "up") %in% names(out)))
})

test_that("multiple_comparisons warns when offset is omitted", {
    dat.aov <- aov(log(Petal.Width) ~ Species, data = iris)
    expect_warning(
        multiple_comparisons(dat.aov, classify = "Species", trans = "log"),
        "Offset value assumed to be 0\\. Change with `offset` argument\\."
    )
})

test_that("apply_transformation warns for invalid back-transformed values", {
    # sqrt: negative value after offset removal
    pp.sqrt <- data.frame(
        predicted.value = c(0.1),
        std.error = c(0.1),
        ci = c(0.2)
    )
    expect_warning(
        out.sqrt <- biometryassist:::apply_transformation(pp.sqrt, trans = "sqrt", offset = 1, power = NULL),
        "Square root back-transformation produced negative values\\. Check offset parameter\\."
    )
    expect_true(out.sqrt$PredictedValue < 0)

    # log: non-positive value after offset removal
    pp.log <- data.frame(
        predicted.value = c(0),
        std.error = c(0.1),
        ci = c(0.2)
    )
    expect_warning(
        out.log <- biometryassist:::apply_transformation(pp.log, trans = "log", offset = 1, power = NULL),
        "Log back-transformation produced non-positive values\\. Check offset parameter\\."
    )
    expect_true(out.log$PredictedValue <= 0)

    # logit: force exact boundary value with -Inf
    pp.logit <- data.frame(
        predicted.value = c(-Inf),
        std.error = c(0.1),
        ci = c(0.2)
    )
    expect_warning(
        out.logit <- biometryassist:::apply_transformation(pp.logit, trans = "logit", offset = 0, power = NULL),
        "Logit back-transformation produced values outside \\(0,1\\)"
    )
    expect_true(out.logit$PredictedValue <= 0 || out.logit$PredictedValue >= 1)
})

test_that("apply_transformation warns for inverse edge cases", {
    pp.inv <- data.frame(
        predicted.value = c(0.1),
        std.error = c(0.1),
        ci = c(0.2)
    )

    warnings <- character()
    out <- withCallingHandlers(
        biometryassist:::apply_transformation(pp.inv, trans = "inverse", offset = 0, power = NULL),
        warning = function(w) {
            warnings <<- c(warnings, conditionMessage(w))
            invokeRestart("muffleWarning")
        }
    )

    expect_true(any(grepl("Inverse transformation: confidence interval crosses zero", warnings, fixed = TRUE)))
    expect_true("PredictedValue" %in% names(out))
    expect_true(out$low <= out$up)
})

test_that("apply_transformation warns for inverse near-zero predicted values", {
    pp.inv <- data.frame(
        predicted.value = c(1e-20),
        std.error = c(0.1),
        ci = c(1e-25)
    )

    expect_warning(
        out <- biometryassist:::apply_transformation(pp.inv, trans = "inverse", offset = 0, power = NULL),
        "Inverse transformation: predicted values very close to zero detected\\."
    )
    expect_true("PredictedValue" %in% names(out))
})

test_that("apply_transformation power validation and warnings", {
    pp <- data.frame(
        predicted.value = c(1),
        std.error = c(0.1),
        ci = c(0.2)
    )

    expect_error(
        biometryassist:::apply_transformation(pp, trans = "power", offset = 0, power = NULL),
        "Power transformation requires a non-zero numeric 'power' argument\\."
    )

    expect_warning(
        out <- biometryassist:::apply_transformation(pp, trans = "power", offset = 1, power = -1),
        "Power back-transformation with negative power produced values near zero\\."
    )
    expect_true("PredictedValue" %in% names(out))
})

test_that("apply_transformation arcsin warning and bounds", {
    pp <- data.frame(
        predicted.value = c(pi),
        std.error = c(0.1),
        ci = c(0.2)
    )

    expect_warning(
        out <- biometryassist:::apply_transformation(pp, trans = "arcsin", offset = 0, power = NULL),
        "Arcsin transformation: some predicted values outside \\[-pi/2, pi/2\\]\\."
    )

    expect_true("PredictedValue" %in% names(out))
    expect_true(out$PredictedValue >= 0 && out$PredictedValue <= 1)
})

test_that("apply_transformation arcsin warns when back-transformation is outside [0,1]", {
    # This branch is numerically very hard to reach with real sin() output because sin(x)^2
    # should be in [0,1]. Here we temporarily override `sin()` and `sqrt()` in the
    # apply_transformation() function environment to force an out-of-bounds value.
    fn2 <- biometryassist:::apply_transformation
    fn2_env <- new.env(parent = environment(fn2))
    fn2_env$sin <- function(x) rep(2, length(x))
    fn2_env$sqrt <- function(x) rep(0, length(x))
    environment(fn2) <- fn2_env

    pp <- data.frame(
        predicted.value = c(0),
        std.error = c(0.1),
        ci = c(0.2)
    )

    expect_warning(
        out <- fn2(pp, trans = "arcsin", offset = 0, power = NULL),
        "Arcsin back-transformation produced values outside \\[0,1\\]\\. This may indicate numerical issues\\."
    )

    expect_true("PredictedValue" %in% names(out))
    expect_true(out$PredictedValue > 1)
})

test_that("apply_transformation errors on invalid trans", {
    pp <- data.frame(
        predicted.value = c(0),
        std.error = c(0.1),
        ci = c(0.2)
    )

    expect_error(
        biometryassist:::apply_transformation(pp, trans = "not-a-transformation", offset = 0, power = NULL),
        "Invalid trans value\\. Must be one of: 'sqrt', 'log', 'logit', 'power', 'inverse', 'arcsin'\\.",
        fixed = FALSE
    )
})

test_that("ordering output works", {
    output1 <- multiple_comparisons(dat.aov, classify = "Species", descending = FALSE)
    output2 <- multiple_comparisons(dat.aov, classify = "Species", descending = TRUE)
    expect_equal(output1$predictions$predicted.value, c(0.25, 1.33, 2.03), tolerance = 5e-2)
    expect_equal(output2$predictions$predicted.value, c(2.03, 1.33, 0.25), tolerance = 5e-2)

    vdiffr::expect_doppelganger("mct ascending order", autoplot(output1))
    vdiffr::expect_doppelganger("mct descending output", autoplot(output2))
})

test_that("different interval types work", {
    output1 <- multiple_comparisons(dat.aov, classify = "Species", int.type = "1se")
    output2 <- multiple_comparisons(dat.aov, classify = "Species", int.type = "2se")
    expect_equal(output1$predictions$low, c(0.22, 1.30, 2.00), tolerance = 5e-2)
    expect_equal(output1$predictions$up, c(0.28, 1.36, 2.06), tolerance = 5e-2)
    expect_equal(output2$predictions$low, c(0.19, 1.27, 1.97), tolerance = 5e-2)
    expect_equal(output2$predictions$up, c(0.31, 1.39, 2.09), tolerance = 5e-2)

    vdiffr::expect_doppelganger("mct output 1se", autoplot(output1))
    vdiffr::expect_doppelganger("mct output 2se", autoplot(output2))
})

test_that("Testing asreml predictions", {
    skip_if_not_installed("Matrix")
    load(test_path("data", "asreml_model.Rdata"), .GlobalEnv)
    expect_warning(output <- multiple_comparisons(model.asr,
                                                  classify = "Nitrogen",
                                                  pred.obj = pred.asr,
                                                  dendf = dendf),
                   "Argument `pred\\.obj` has been deprecated and will be removed in a future version\\. Predictions are now performed internally in the function\\.")
    expect_equal(output$predictions$predicted.value,
                 c(77.76, 100.15, 114.41, 123.23),
                 tolerance = 5e-2)
    expect_snapshot_output(output)
    vdiffr::expect_doppelganger("asreml predictions", autoplot(output))
})

test_that("save produces output", {
    withr::local_file("pred_vals.csv")
    output <- multiple_comparisons(dat.aov, classify = "Species", save = TRUE, savename = "pred_vals")
    expect_snapshot_output(output)

    expect_csv_matches_df(output$predictions, "pred_vals.csv")
})

test_that("Interaction terms work", {
    load(test_path("data", "asreml_model.Rdata"), .GlobalEnv)
    skip_if_not_installed("asreml")
    quiet(library(asreml))
    output <- multiple_comparisons(model.asr, classify = "Nitrogen:Variety", pvals = T)
    expect_equal(output$predictions$predicted.value,
                 c(70.85, 76.58, 85.86, 92.22, 99.91, 108.32, 113.1, 113.5, 116.63, 118.4, 123.75, 127.53),
                 tolerance = 5e-2)

    vdiffr::expect_doppelganger("Interactions work", autoplot(output))
})

test_that("order argument is deprecated", {
    # dat.aov <- aov(Petal.Width ~ Species, data = iris)
    expect_warning(multiple_comparisons(dat.aov, classify = "Species", order = "xyz"),
                   "Argument `order` has been deprecated and will be removed in a future version. Please use `descending` instead.")
})

test_that("dashes are handled", {
    iris2 <- iris
    # Replace 'gin' in setosa with '-'
    iris2$Species <- as.factor(gsub("to", "-", iris2$Species))
    dat.aov2 <- aov(Petal.Width ~ Species, data = iris2)
    output2 <- suppressWarnings(multiple_comparisons(dat.aov2, classify = "Species"))
    expect_warning(multiple_comparisons(dat.aov2, classify = "Species"),
                   "The treatment level se-sa contained '-', which has been replaced in the final output with '_'")
    expect_equal(output2$predictions$predicted.value, c(0.25, 1.33, 2.03), tolerance = 5e-2)

    # Replace 'gin' in virginica with '-' as well
    iris2$Species <- as.factor(gsub("gin", "-", iris2$Species))
    dat.aov2 <- aov(Petal.Width ~ Species, data = iris2)

    expect_warning(multiple_comparisons(dat.aov2, classify = "Species"),
                   "The treatment levels se-sa, vir-ica contained '-', which has been replaced in the final output with '_'")
    expect_equal(output2$predictions$predicted.value, c(0.25, 1.33, 2.03), tolerance = 5e-2)

    # skip_if(interactive())
    vdiffr::expect_doppelganger("mct dashes output", autoplot(output2))
})

test_that("mct removes aliased treatments in aov", {
    CO_2 <- CO2
    CO_2$uptake[CO_2$Type=="Quebec" & CO_2$Treatment=="nonchilled"] <- NA
    model <- aov(uptake~Type+Treatment+Type:Treatment, data = CO_2)
    expect_warning(output1 <- multiple_comparisons(model, classify = "Type:Treatment"),
                   "A level of Type\\:Treatment is aliased\\. It has been removed from predicted output\\.\n  Aliased level is\\: Quebec:nonchilled\\.\n  This level is saved as an attribute of the output object\\.")
    expect_snapshot_output(output1$predictions$predicted.value)
    # skip_if(interactive())
    vdiffr::expect_doppelganger("aov aliased output", autoplot(output1))
})


test_that("mct handles aliased results in asreml with a warning", {
    skip_if_not_installed("asreml")
    quiet(library(asreml))
    load(test_path("data", "asreml_model.Rdata"), envir = .GlobalEnv)
    load(test_path("data", "oats_data_missing.Rdata"), envir = .GlobalEnv)
    expect_warning(
        output <- multiple_comparisons(model.asr, classify = "Nitrogen:Variety"),
        "Aliased level is: 0\\.2_cwt:Golden_rain\\."
    )
    expect_snapshot_output(output)

    load(test_path("data", "oats_data_missing2.Rdata"), envir = .GlobalEnv)

    expect_warning(
        output <- multiple_comparisons(model2.asr, classify = "Nitrogen:Variety"),
        "Some levels of Nitrogen:Variety are aliased\\. They have been removed from predicted output\\."
    )
    expect_snapshot_output(output)
    expect_warning(multiple_comparisons(model2.asr, classify = "Nitrogen:Variety"),
                   "Aliased levels are: 0\\.2_cwt:Golden_rain, 0\\.2_cwt:Victory\\.")
})

test_that("Invalid classify argument causes an error", {
    dat.aov <- aov(Petal.Width ~ Species, data = iris)
    expect_error(multiple_comparisons(dat.aov, classify = "ABC"),
                 "ABC is not a term in the model\\. Please check model specification\\.")
    expect_error(multiple_comparisons(model.asr, classify = "ABC"),
                 "ABC is not a term in the model\\. Please check model specification\\.")
})

test_that("Significance values that are too high give a warning or error", {
    # dat.aov <- aov(Petal.Width ~ Species, data = iris)
    expect_warning(multiple_comparisons(dat.aov, classify = "Species", sig = 0.95),
                   "Significance level given by `sig` is high. Perhaps you meant 0.05?")
    expect_error(multiple_comparisons(dat.aov, classify = "Species", sig = 5),
                 "Significance level given by `sig` is high. Perhaps you meant 0.05?")
    expect_error(multiple_comparisons(dat.aov, classify = "Species", sig = 95),
                 "Significance level given by `sig` is high. Perhaps you meant 0.05?")
})

test_that("Use of pred argument gives warning", {
    # dat.aov <- aov(Petal.Width ~ Species, data = iris)
    expect_warning(multiple_comparisons(dat.aov, classify = "Species", pred = "Species"),
                   "Argument `pred` has been deprecated and will be removed in a future version. Please use `classify` instead.")
})

test_that("Invalid column name causes an error", {
    dat <- design("crd", LETTERS[1:4], 4, nrow = 4, ncols = 4, quiet = TRUE)$design
    names(dat)[5] <- "groups"
    dat.aov <- aov(rnorm(16, 10)~groups, data = dat)

    expect_error(multiple_comparisons(dat.aov, classify = "groups"),
                 "Invalid column name. Please change the name of column\\(s\\): groups")
})

test_that("Including pred.obj object causes warning", {
    skip_if_not_installed("asreml")
    quiet(library(asreml))
    load(test_path("data", "asreml_model.Rdata"), envir = .GlobalEnv)
    expect_warning(multiple_comparisons(model.asr, pred.obj = pred.asr, classify = "Nitrogen"),
                   "Argument \\`pred.obj\\` has been deprecated and will be removed in a future version\\. Predictions are now performed internally in the function\\.")
})

test_that("Providing a random term in classify produces an error.", {
    skip_if_not_installed("asreml")
    load(test_path("data", "oats_data_missing2.Rdata"), envir = .GlobalEnv)
    expect_error(multiple_comparisons(model2.asr, classify = "Blocks"),
                 "All predicted values are aliased\\. Perhaps you need the `present` argument\\?")
})

test_that("lme4 model works", {
    skip_if_not_installed("lme4")
    quiet(library(lme4))
    dat.lmer <- lmer(yield ~ Nitrogen*Variety + (1|Blocks), data = dat)
    output <- multiple_comparisons(dat.lmer, classify = "Nitrogen")
    expect_equal(output$predictions$std.error, rep(7.39, 4), tolerance = 5e-2)
    expect_equal(min(output$predictions$predicted.value), 79.39, tolerance = 5e-2)
    expect_equal(max(output$predictions$predicted.value), 123.39, tolerance = 5e-2)
    expect_equal(output$predictions$predicted.value, c(79.39, 98.89, 114.22, 123.39), tolerance = 5e-2)
    vdiffr::expect_doppelganger("lme4 output", autoplot(output))
})

test_that("3 way interaction works", {
    des <- design(type = "crossed:crd", treatments = c(3, 3, 3),
                  reps = 3, nrows = 9, ncols = 9, seed = 42, quiet = TRUE)
    des$design$response <- rnorm(81, 100)
    des$design$A <- factor(des$design$A)
    des$design$B <- factor(des$design$B)
    des$design$C <- factor(des$design$C)
    dat.aov <- aov(response~A*B*C, data = des$design)
    output <- multiple_comparisons(dat.aov, classify = "A:B:C")
    expect_snapshot_output(output$predictions$predicted.value)
    expect_equal(output$predictions$std.error,
                 rep(0.63, 27))
    # skip_if(interactive())
    vdiffr::expect_doppelganger("3 way interaction", autoplot(output), variant = ggplot2_variant())
})

test_that("plots are produced when requested", {
    withr::local_seed(123)
    des <- design(type = "crossed:crd", treatments = c(3, 3, 3),
                  reps = 3, nrows = 9, ncols = 9, seed = 42, quiet = TRUE)
    des$design$response <- rnorm(81, 100)
    des$design$A <- factor(des$design$A)
    des$design$B <- factor(des$design$B)
    des$design$C <- factor(des$design$C)
    dat.aov <- aov(response~A*B*C, data = des$design)

    tmp <- withr::local_tempdir()
    withr::with_dir(tmp, {
        withr::local_file("Rplots.pdf")

        expect_snapshot_output(
            output <- multiple_comparisons(dat.aov, classify = "A:B:C", plot = TRUE)
        )
        while (grDevices::dev.cur() > 1) grDevices::dev.off()

        expect_s3_class(output, "mct")
        expect_equal(nrow(output$predictions), 27)
        expect_equal(output$predictions$std.error, rep(0.63, 27))

        skip_if(interactive())
        vdiffr::expect_doppelganger(
            "3 way interaction internal",
            function() {
                invisible(multiple_comparisons(dat.aov, classify = "A:B:C", plot = TRUE))
            },
            variant = ggplot2_variant()
        )
        while (grDevices::dev.cur() > 1) grDevices::dev.off()
    })
})

test_that("nlme model produces an error", {
    skip_if_not_installed("nlme")
    suppressPackageStartupMessages(library(nlme))
    load(test_path("data", "oats_data.Rdata"), envir = .GlobalEnv)
    dat.lme <- lme(yield ~ Nitrogen*Variety, random = ~1|Blocks, data = dat)
    output <- multiple_comparisons(dat.lme, classify = "Nitrogen")
    expect_equal(output$predictions$std.error, rep(7.39, 4), tolerance = 5e-2)
    expect_equal(min(output$predictions$predicted.value), 79.39, tolerance = 5e-2)
    expect_equal(max(output$predictions$predicted.value), 123.39, tolerance = 5e-2)
    expect_equal(output$predictions$predicted.value, c(79.39, 98.89, 114.22, 123.39), tolerance = 5e-2)
    vdiffr::expect_doppelganger("nlme output", autoplot(output))
})

test_that("invalid model types give a clear error", {
    # Use an unsupported model type that still has a `formula()` method so that
    # the error comes from `get_predictions.default()` (not from validate_inputs()).
    dat <- data.frame(x = 1:10, y = 1:10)
    m <- stats::nls(density ~ SSlogis(log(conc), Asym, xmid, scal), data = subset(DNase, Run == 1))

    expect_error(
        multiple_comparisons(m, classify = "x"),
        "model\\.obj must be a linear \\(mixed\\) model object\\.",
        fixed = FALSE
    )
})

test_that("multiple_comparisons output has a class of 'mct'", {
    output <- multiple_comparisons(dat.aov, classify = "Species")
    expect_s3_class(output, "mct")
})

test_that("Setting groups to FALSE disables letter groups", {
    output <- multiple_comparisons(dat.aov, classify = "Species")
    expect_true("groups" %in% colnames(output$predictions))
    expect_equal(output$predictions$groups, c("a", "b", "c"))

    output <- multiple_comparisons(dat.aov, classify = "Species", groups = FALSE)
    expect_false("groups" %in% colnames(output$predictions))

    output <- multiple_comparisons(dat.aov, classify = "Species", letters = FALSE)
    expect_false("groups" %in% colnames(output$predictions))

    vdiffr::expect_doppelganger("No letter groups",
                                autoplot(output))
})

test_that("Check for letters as an alias of groups", {
    expect_warning(output <- multiple_comparisons(dat.aov, classify = "Species",
                                                  groups = FALSE, letters = TRUE),
                   "Both 'groups' and 'letters' provided\\. Using 'groups'\\.")
    expect_false("groups" %in% colnames(output$predictions))
})

test_that("autoplot supports legacy mct data.frame objects", {
    # Old versions of biometryassist used an `mct` object that was itself a data.frame.
    # This test covers the backward-compatibility branch in autoplot.mct().
    legacy <- data.frame(
        Species = factor(c("setosa", "versicolor", "virginica")),
        predicted.value = c(0.25, 1.33, 2.03),
        std.error = c(0.02, 0.02, 0.02),
        ci = c(0.05, 0.05, 0.05),
        low = c(0.20, 1.28, 1.98),
        up = c(0.30, 1.38, 2.08),
        groups = c("a", "b", "c")
    )
    class(legacy) <- c("mct", class(legacy))
    attr(legacy, "ylab") <- "Petal.Width"

    p <- autoplot(legacy)
    expect_s3_class(p, "ggplot")
})

test_that("autoplot can rotate axis and labels independently", {
    output <- multiple_comparisons(dat.aov, classify = "Species")
    vdiffr::expect_doppelganger("label rotation",
                                autoplot(output, label_rotation = 90))
    vdiffr::expect_doppelganger("axis rotation",
                                autoplot(output, axis_rotation = 90))
    vdiffr::expect_doppelganger("axis rotation -90",
                                autoplot(output, axis_rotation = -90))
    vdiffr::expect_doppelganger("axis and label rotation",
                                autoplot(output, axis_rotation = 45, label_rotation = 90))
    vdiffr::expect_doppelganger("rotation and axis rotation",
                                autoplot(output, rotation = 45, axis_rotation = 90))
    vdiffr::expect_doppelganger("rotation and label rotation",
                                autoplot(output, rotation = 45, label_rotation = 90))
})

test_that("Autoplot can output column graphs", {
    output <- multiple_comparisons(dat.aov, classify = "Species")
    p1 <- autoplot(output, type = "column", label_height = 1)
    p2 <- autoplot(output, type = "col", label_height = 1)
    expect_in("GeomCol", class(p1$layers[[1]]$geom))
    expect_in("GeomCol", class(p2$layers[[1]]$geom))
    expect_true(equivalent_ggplot2(p1, p2))
    vdiffr::expect_doppelganger("autoplot column", p1)
})

test_that("A warning is printed if a transformation is detected with no trans argument provided", {
    dat.aov.log <- aov(log(Petal.Width) ~ Species, data = iris)
    dat.aov.sqrt <- aov(sqrt(Petal.Width) ~ Species, data = iris)
    dat.aov.logit <- aov(logit(1/Petal.Width) ~ Species, data = iris)
    dat.aov.inverse <- aov((1/Petal.Width) ~ Species, data = iris)
    dat.aov.power <- aov(Petal.Width^3 ~ Species, data = iris)

    expect_warning(multiple_comparisons(dat.aov.log, classify = "Species"),
                   "The response variable appears to be transformed in the model formula: log\\(Petal\\.Width\\)\\.
Please specify the 'trans' argument if you want back-transformed predictions\\.")
    expect_warning(multiple_comparisons(dat.aov.sqrt, classify = "Species"),
                   "The response variable appears to be transformed in the model formula: sqrt\\(Petal\\.Width\\)\\.
Please specify the 'trans' argument if you want back-transformed predictions\\.")
    expect_warning(multiple_comparisons(dat.aov.logit, classify = "Species"),
                   "The response variable appears to be transformed in the model formula: logit\\(1/Petal\\.Width\\)\\.
Please specify the 'trans' argument if you want back-transformed predictions\\.")
    expect_warning(multiple_comparisons(dat.aov.inverse, classify = "Species"),
                   "The response variable appears to be transformed in the model formula: \\(1/Petal\\.Width\\)\\.
Please specify the 'trans' argument if you want back-transformed predictions\\.")
    expect_warning(multiple_comparisons(dat.aov.power, classify = "Species"),
                   "The response variable appears to be transformed in the model formula: Petal\\.Width\\^3\\.
Please specify the 'trans' argument if you want back-transformed predictions\\.")
})


# Test aliased output prints
test_that("print.mct with no aliased attribute", {
    dat.aov <- aov(Petal.Width ~ Species, data = iris)
    output <- multiple_comparisons(dat.aov, classify = "Species", plot = FALSE)

    # Manually set aliased for testing (in new structure)
    output$aliased <- "ABC"
    attr(output, "aliased") <- "ABC"

    expect_true("aliased" %in% names(output))
    expect_length(output$aliased, 1)
    expect_output(print(output),
                  "Aliased level is: ABC")

    output$aliased <- c("ABC", "DEF")
    attr(output, "aliased") <- c("ABC", "DEF")

    expect_length(output$aliased, 2)
    expect_true("aliased" %in% names(output))
    expect_output(print(output),
                  "Aliased levels are: ABC and DEF")

    output$aliased <- c("ABC", "DEF", "GHI")
    attr(output, "aliased") <- c("ABC", "DEF", "GHI")

    expect_length(output$aliased, 3)
    expect_true("aliased" %in% names(output))
    expect_output(print(output),
                  "Aliased levels are: ABC, DEF and GHI")

})

test_that("Standard error rounding preserves error bars", {
    # Create data with very small standard errors
    set.seed(123)

    # Create a mock model that would produce very small standard errors
    # We'll use a simple approach with very precise data
    precise_data <- data.frame(
        treatment = factor(rep(c("A", "B", "C"), each = 100)),
        response = c(rep(1.000001, 100), rep(1.000002, 100), rep(1.000003, 100)) +
            rnorm(300, 0, 0.0000001)  # Very small error
    )

    dat.aov <- aov(response ~ treatment, data = precise_data)

    # Test with default decimals (2) - should trigger warning
    expect_warning(
        output <- multiple_comparisons(dat.aov, classify = "treatment", decimals = 2),
        "Some standard errors are very small and would round to zero with 2 decimal places"
    )

    # Check that standard errors are preserved (not rounded to 0)
    expect_true(all(output$predictions$std.error > 0))
    expect_false(any(output$predictions$std.error == 0))

    # Check that other columns are still rounded to 2 decimal places
    expect_true(all(nchar(sub(".*\\.", "", as.character(output$predictions$predicted.value))) <= 2))
})

test_that("Standard error rounding works with transformed data", {
    # Create data that will have small standard errors on the transformed scale
    set.seed(456)
    # Use data that's already on log scale with very small differences
    transform_data <- data.frame(
        treatment = factor(rep(c("A", "B", "C"), each = 100)),
        # Create log-scale response with tiny differences and very small error
        log_response = c(rep(-0.0001, 100), rep(0.0000, 100), rep(0.0001, 100)) +
            rnorm(300, 0, 0.000001)  # Very small error on log scale
    )

    # Apply log transformation - the model is on log scale, transform back to original
    dat.aov <- aov(log_response ~ treatment, data = transform_data)

    # Test with transformation - should handle both std.error and ApproxSE
    expect_warning(
        output <- multiple_comparisons(dat.aov, classify = "treatment",
                                       trans = "log", offset = 0, decimals = 3),
        "Some standard errors are very small"
    )

    # Check that both standard error columns are preserved
    expect_true(all(output$predictions$std.error > 0))
    expect_true(all(output$predictions$ApproxSE > 0))
    expect_false(any(output$predictions$std.error == 0))
    expect_false(any(output$predictions$ApproxSE == 0))
})

test_that("Normal rounding works when standard errors are not too small", {
    # Use the standard iris data which has reasonable standard errors
    dat.aov <- aov(Petal.Width ~ Species, data = iris)

    # Should not trigger warning with normal data
    expect_no_warning(
        output <- multiple_comparisons(dat.aov, classify = "Species", decimals = 2)
    )

    # Check that all numeric columns are properly rounded
    expect_true(all(nchar(sub(".*\\.", "", as.character(output$predictions$predicted.value))) <= 2))
    expect_true(all(nchar(sub(".*\\.", "", as.character(output$predictions$std.error))) <= 2))
})

test_that("Standard error rounding works with different decimal settings", {
    # Create data with moderately small standard errors
    set.seed(789)
    moderate_data <- data.frame(
        treatment = factor(rep(c("A", "B"), each = 20)),
        response = c(rep(1.001, 20), rep(1.002, 20)) + rnorm(40, 0, 0.001)
    )

    dat.aov <- aov(response ~ treatment, data = moderate_data)

    # Test with decimals = 4 (should not trigger warning)
    expect_no_warning(
        output4 <- multiple_comparisons(dat.aov, classify = "treatment", decimals = 4)
    )

    # Test with decimals = 1 (might trigger warning depending on actual SE values)
    expect_warning(
        output1 <- multiple_comparisons(dat.aov, classify = "treatment", decimals = 1),
        "Some standard errors are very small and would round to zero with 1 decimal places"
    )

    # Ensure standard errors are never exactly 0
    expect_true(all(output1$predictions$std.error > 0))
    expect_true(all(output4$predictions$std.error > 0))
})


test_that("ApproxSE column is also preserved during rounding", {
    # Create data that will trigger the standard error preservation
    set.seed(111)
    # Create data with extremely small values to get tiny standard errors after log transformation
    precise_data <- data.frame(
        treatment = factor(rep(c("A", "B"), each = 100)),
        # Use very small response values that will have tiny standard errors
        response = c(rep(0.000001, 100), rep(0.000002, 100)) + rnorm(200, 0, 0.0000001)
    )

    # Use log transformation to create ApproxSE column
    dat.aov <- aov(log(response) ~ treatment, data = precise_data)

    # Should trigger warning and preserve both std.error and ApproxSE
    expect_warning(
        output <- multiple_comparisons(dat.aov, classify = "treatment",
                                       trans = "log", offset = 0, decimals = 2),
        "Some standard errors are very small"
    )

    # Both standard error columns should be preserved
    expect_true(all(output$predictions$std.error > 0))
    expect_true(all(output$predictions$ApproxSE > 0))
    expect_false(any(output$predictions$std.error == 0))
    expect_false(any(output$predictions$ApproxSE == 0))
})

Try the biometryassist package in your browser

Any scripts or data that you put into this service are public.

biometryassist documentation built on Feb. 3, 2026, 5:06 p.m.