diff --git a/NEWS.md b/NEWS.md index 5a417704..77b344ea 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,6 +14,8 @@ Bug fixes Bug fixes +* Added comprehensive test coverage for utility functions and helper methods to improve overall package coverage from 86% towards 90% +* Enhanced test coverage for `utils_grouped_df.R`, `format_model.R`, `report_table.R`, and `report_effectsize.R` helper functions * Fixed issue where `report_effectsize.htest()` called internal effectsize functions with undefined `table` parameter (#459) * `report.brmsfit()`: significantly improved performance by using faster `method = "basic"` instead of `method = "refit"` for effect size calculation, reducing execution time from hours to minutes for large Bayesian models (#568) * `report.brmsfit()`: fix issue where report text was printed multiple times when different parameters had different priors (#543) diff --git a/tests/testthat/test-format_model.R b/tests/testthat/test-format_model.R index aab771c7..1788e1f4 100644 --- a/tests/testthat/test-format_model.R +++ b/tests/testthat/test-format_model.R @@ -72,3 +72,43 @@ test_that("format_model", { "Bayesian logistic model" ) }) + +test_that("format_model character method works", { + # Test character method for different model types + expect_identical(format_model("lm"), "linear model") + expect_identical(format_model("glm"), "general linear model") + expect_identical(format_model("lmer"), "linear mixed model") + expect_identical(format_model("glmer"), "general linear mixed model") + expect_identical(format_model("gam"), "general additive model") + expect_identical(format_model("gamm"), "general additive mixed model") + expect_identical(format_model("unknown"), "model") +}) + +test_that("format_model handles edge cases", { + # Test with different family types for GLM + # Note: GLM with gaussian family is treated as linear model + glm_gaussian <- glm(mpg ~ wt, data = mtcars, family = gaussian()) + expect_identical(format_model(glm_gaussian), "linear model") + + # Test probit link + glm_probit <- glm(vs ~ wt, data = mtcars, family = binomial(link = "probit")) + expect_identical(format_model(glm_probit), "probit model") + + # Test different model families - use a model that will show general linear format + # GLM with quasibinomial + glm_quasi <- glm(vs ~ wt, data = mtcars, family = quasibinomial()) + expect_match(format_model(glm_quasi), "model") +}) + +test_that("get_model_type_prefix helper function works", { + # Create mock model info to test the helper function + # Since it's not exported, we test through format_model + + # Test different GLM families + poisson_model <- glm(round(mpg) ~ wt, data = mtcars, family = poisson()) + expect_identical(format_model(poisson_model), "poisson model") + + # Test logistic + logit_model <- glm(vs ~ wt, data = mtcars, family = binomial()) + expect_identical(format_model(logit_model), "logistic model") +}) diff --git a/tests/testthat/test-report_effectsize_helpers.R b/tests/testthat/test-report_effectsize_helpers.R new file mode 100644 index 00000000..f6cb1bfc --- /dev/null +++ b/tests/testthat/test-report_effectsize_helpers.R @@ -0,0 +1,153 @@ +# Tests for report_effectsize helper functions and edge cases + +test_that("as.report_effectsize works correctly", { + # Create a basic character vector to convert + effect_text <- c("small effect", "medium effect") + + # Test basic conversion + result <- as.report_effectsize(effect_text) + expect_s3_class(result, "report_effectsize") + expect_identical(length(result), 2L) + + # Test with summary + summary_text <- c("Overall: medium effect") + result_with_summary <- as.report_effectsize(effect_text, summary = summary_text) + expect_s3_class(result_with_summary, "report_effectsize") + + summ <- summary(result_with_summary) + expect_s3_class(summ, "report_effectsize") + expect_identical(as.character(summ), as.character(summary_text)) + + # Test with custom prefix + result_custom <- as.report_effectsize(effect_text, prefix = ">> ") + expect_identical(attr(result_custom, "prefix"), ">> ") +}) + +test_that("report_effectsize print method works", { + effect_text <- c("small effect", "medium effect") + result <- as.report_effectsize(effect_text) + + # Test printing without rules + expect_output(print(result), "small effect") + expect_output(print(result), "medium effect") + + # Test printing with rules + attr(result, "rules") <- "Effect sizes were calculated using custom rules." + expect_output(print(result), "custom rules") +}) + +test_that(".text_effectsize helper function works", { + # Test with different interpretation methods + + # Test cohen1988 + result_cohen <- report:::.text_effectsize("cohen1988") + expect_match(result_cohen, "Cohen's \\(1988\\)") + expect_match(result_cohen, "recommendations") + + # Test sawilowsky2009 + result_saw <- report:::.text_effectsize("sawilowsky2009") + expect_match(result_saw, "Savilowsky's \\(2009\\)") + + # Test gignac2016 + result_gignac <- report:::.text_effectsize("gignac2016") + expect_match(result_gignac, "Gignac's \\(2016\\)") + + # Test funder2019 + result_funder <- report:::.text_effectsize("funder2019") + expect_match(result_funder, "Funder's \\(2019\\)") + + # Test lovakov2021 + result_lovakov <- report:::.text_effectsize("lovakov2021") + expect_match(result_lovakov, "Lovakov's \\(2021\\)") + + # Test evans1996 + result_evans <- report:::.text_effectsize("evans1996") + expect_match(result_evans, "Evans's \\(1996\\)") + + # Test chen2010 + result_chen <- report:::.text_effectsize("chen2010") + expect_match(result_chen, "Chen's \\(2010\\)") + + # Test field2013 + result_field <- report:::.text_effectsize("field2013") + expect_match(result_field, "Field's \\(2013\\)") + + # Test landis1977 + result_landis <- report:::.text_effectsize("landis1977") + expect_match(result_landis, "Landis' \\(1977\\)") + + # Test with NULL (no interpretation) + result_null <- report:::.text_effectsize(NULL) + expect_identical(result_null, "") + + # Test with custom interpretation (not character) + result_custom <- report:::.text_effectsize(list(custom = TRUE)) + expect_match(result_custom, "custom set of rules") +}) + +test_that(".text_standardize helper function works", { + # Create mock standardized object for testing + mock_std_obj <- c("standardized result") + + # Test refit method + attr(mock_std_obj, "std_method") <- "refit" + attr(mock_std_obj, "robust") <- FALSE + attr(mock_std_obj, "two_sd") <- FALSE + + result_refit <- report:::.text_standardize(mock_std_obj) + expect_match(result_refit, "standardized version.*dataset") + + # Test refit method with robust + attr(mock_std_obj, "robust") <- TRUE + result_refit_robust <- report:::.text_standardize(mock_std_obj) + expect_match(result_refit_robust, "median and the MAD") + + # Test 2sd method + attr(mock_std_obj, "std_method") <- "2sd" + attr(mock_std_obj, "robust") <- FALSE + result_2sd <- report:::.text_standardize(mock_std_obj) + expect_match(result_2sd, "2 times the.*SD") + + # Test 2sd method with robust + attr(mock_std_obj, "robust") <- TRUE + result_2sd_robust <- report:::.text_standardize(mock_std_obj) + expect_match(result_2sd_robust, "MAD.*median-based") + + # Test smart method + attr(mock_std_obj, "std_method") <- "smart" + attr(mock_std_obj, "robust") <- FALSE + result_smart <- report:::.text_standardize(mock_std_obj) + expect_match(result_smart, "mean and the SD.*response variable") + + # Test smart method with robust + attr(mock_std_obj, "robust") <- TRUE + result_smart_robust <- report:::.text_standardize(mock_std_obj) + expect_match(result_smart_robust, "median and the MAD.*response variable") + + # Test basic method + attr(mock_std_obj, "std_method") <- "basic" + attr(mock_std_obj, "robust") <- FALSE + result_basic <- report:::.text_standardize(mock_std_obj) + expect_match(result_basic, "scaled by the.*mean and the SD") + + # Test posthoc method + attr(mock_std_obj, "std_method") <- "posthoc" + attr(mock_std_obj, "robust") <- FALSE + result_posthoc <- report:::.text_standardize(mock_std_obj) + expect_match(result_posthoc, "scaled by the.*mean and the SD") + + # Test unknown method + attr(mock_std_obj, "std_method") <- "unknown_method" + result_unknown <- report:::.text_standardize(mock_std_obj) + expect_match(result_unknown, "standardized using the unknown_method method") +}) + +test_that("report_effectsize generic method dispatch works", { + # Test that report_effectsize is a function (may not be S3 generic in base form) + expect_true(exists("report_effectsize")) + expect_true(is.function(report_effectsize)) + + # Test with unsupported object + unsupported_obj <- structure(list(), class = "unsupported_class") + expect_error(report_effectsize(unsupported_obj), "objects of class.*not supported") +}) \ No newline at end of file diff --git a/tests/testthat/test-report_s.R b/tests/testthat/test-report_s.R index 032ed42c..0f157017 100644 --- a/tests/testthat/test-report_s.R +++ b/tests/testthat/test-report_s.R @@ -7,3 +7,25 @@ test_that("report_s, arguments", { expect_error(report_s()) expect_error(report_s(s = 1:2), "single value") }) + +test_that("report_s edge cases and parameters", { + # Test with p-value conversion to s-value - just check it doesn't error + expect_no_error(report_s(p = 0.05)) + + # Test with custom test_value and test_parameter + expect_no_error(report_s(s = 2.0, test_value = 1, test_parameter = "mean")) + + # Test with very small p-value + expect_no_error(report_s(p = 0.001)) + + # Test with larger s-value + expect_no_error(report_s(s = 10)) + + # Test error handling for multiple values + expect_error(report_s(p = c(0.05, 0.01)), "single value") + expect_error(report_s(s = c(1, 2)), "single value") + + # Test error handling for missing values + expect_error(report_s(s = NULL, p = NULL)) + expect_error(report_s(s = NA, p = NA)) +}) diff --git a/tests/testthat/test-report_table.R b/tests/testthat/test-report_table.R index 271c159f..4a1d7552 100644 --- a/tests/testthat/test-report_table.R +++ b/tests/testthat/test-report_table.R @@ -96,3 +96,104 @@ test_that("report_table methods work correctly", { # Test print (should not error) expect_output(print(result)) }) + +test_that("report_table advanced methods work", { + # Test as.report_table with summary + df <- data.frame(Parameter = c("A", "B"), Value = c(1, 2)) + summary_df <- data.frame(Parameter = c("A"), Value = c(1.5)) + + result_with_summary <- as.report_table(df, summary = summary_df) + expect_s3_class(result_with_summary, "report_table") + + summ <- summary(result_with_summary) + expect_s3_class(summ, "report_table") + expect_identical(nrow(summ), 1L) + + # Test as.report_table with as_is parameter + result_as_is <- as.report_table(df, as_is = TRUE) + expect_s3_class(result_as_is, "report_table") + + # Test c.report_table method (concatenation) + df1 <- as.report_table(data.frame(x = 1:2, y = 3:4)) + df2 <- as.report_table(data.frame(x = 5:6, y = 7:8)) + combined <- c(df1, df2) + expect_s3_class(combined, "report_table") + expect_identical(nrow(combined), 4L) +}) + +test_that("report_table formatting and printing work", { + # Create table with Method and Alternative columns to test removal + df <- data.frame( + Parameter = "test", + Coefficient = 1.5, + Method = "Test Method", + Alternative = "two.sided", + null.value = 0 + ) + result <- as.report_table(df) + + # Test formatting removes unwanted columns + formatted <- format(result) + expect_false("Method" %in% names(formatted)) + expect_false("Alternative" %in% names(formatted)) + + # Test print with caption and footer + expect_output(print(result), "Test Method") + + # Test table footer creation + footer_result <- report:::.report_table_footer(df) + expect_type(footer_result, "character") + expect_length(footer_result, 2) + + # Test caption creation + caption_result <- report:::.report_table_caption(df) + expect_identical(caption_result, "Test Method") +}) + +test_that("report_table edge cases for footer and caption", { + # Test footer with different alternatives + df_less <- data.frame(Alternative = "less", null.value = 0) + names(df_less$null.value) <- "mean" + footer_less <- report:::.report_table_footer(df_less) + expect_match(footer_less[1], "less than") + + df_greater <- data.frame(Alternative = "greater", null.value = 0) + names(df_greater$null.value) <- "mean" + footer_greater <- report:::.report_table_footer(df_greater) + expect_match(footer_greater[1], "greater than") + + # Test with multiple null values + df_multi <- data.frame(Alternative = "two.sided", null.value = c(0, 1)) + footer_multi <- report:::.report_table_footer(df_multi) + expect_match(footer_multi[1], "two.sided") + + # Test without Method + df_no_method <- data.frame(Parameter = "test", Value = 1) + caption_none <- report:::.report_table_caption(df_no_method) + expect_null(caption_none) +}) + +test_that("as.report_table.report works correctly", { + # Create a mock report object + mock_table <- data.frame(Parameter = "test", Value = 1) + class(mock_table) <- c("report_table", "data.frame") + + mock_summary <- data.frame(Parameter = "test", Summary_Value = 0.5) + class(mock_summary) <- c("report_table", "data.frame") + attr(mock_table, "summary") <- mock_summary + + mock_report <- structure( + "Mock report text", + table = mock_table, + class = "report" + ) + + # Test extracting table + result_table <- as.report_table(mock_report, summary = FALSE) + expect_s3_class(result_table, "report_table") + + # Test extracting summary + result_summary <- as.report_table(mock_report, summary = TRUE) + expect_s3_class(result_summary, "report_table") + expect_identical(nrow(result_summary), 1L) +}) diff --git a/tests/testthat/test-utils_helpers.R b/tests/testthat/test-utils_helpers.R index a15ac8b8..b65cbd6f 100644 --- a/tests/testthat/test-utils_helpers.R +++ b/tests/testthat/test-utils_helpers.R @@ -218,3 +218,40 @@ test_that("grouped dataframe utilities work correctly", { expect_false(report:::.has_groups(ungrouped)) expect_false(inherits(ungrouped, "grouped_df")) }) + +test_that("grouped dataframe utilities handle edge cases", { + skip_if_not_installed("dplyr") + + # Test .group_indices function + df <- data.frame( + group = rep(c("A", "B"), each = 3), + value = 1:6 + ) + grouped_df <- dplyr::group_by(df, group) + + # Test group indices + indices <- report:::.group_indices(grouped_df) + expect_type(indices, "list") + expect_equal(length(indices), 2) + + # Test groups_drop function + drop_setting <- report:::.groups_drop(grouped_df) + expect_type(drop_setting, "logical") + + # Test calculate_groups with factor data + df_factor <- data.frame( + group = factor(rep(c("A", "B"), each = 3), levels = c("A", "B", "C")), + value = 1:6 + ) + + # Test .calculate_groups function + groups_result <- report:::.calculate_groups(df_factor, "group", drop = FALSE) + expect_s3_class(groups_result, "data.frame") + expect_true(".rows" %in% names(groups_result)) + + # Test error handling in .calculate_groups + expect_error( + report:::.calculate_groups(df_factor, "missing_column"), + "groups.*missing" + ) +})