Improve test coverage by adding comprehensive tests for utility functions and helpers

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: report
 Type: Package
 Title: Automated Reporting of Results and Statistical Models
-Version: 0.6.1.6
+Version: 0.6.1.7
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",

NEWS.md

@@ -2,6 +2,8 @@
 
 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)

tests/testthat/test-format_model.R

@@ -44,3 +44,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")
+})

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")
+})

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))
+})

tests/testthat/test-report_table.R

@@ -94,3 +94,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)
+})

tests/testthat/test-utils_helpers.R

@@ -206,3 +206,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"
+  )
+})