diff --git a/DESCRIPTION b/DESCRIPTION index d3a176f..85216d8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,15 +12,14 @@ Description: Create publication-ready regression tables in multiple formats or LaTeX for PDF output. License: MIT + file LICENSE Encoding: UTF-8 -LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 Imports: dplyr, + flextable, magrittr, stats Suggests: - flextable, knitr, kableExtra, lmtest, diff --git a/NEWS.md b/NEWS.md index a2fefc6..e03a8d2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -271,7 +271,7 @@ install.packages("kableExtra") # optional, for enhanced formatting ✅ Parameter names: `robust.se`, `margins`, `control.var`, `highlight`, `csv` ✅ Model support: `lm`, `glm` ✅ Significance stars: `***` p < .01, `**` p < .05, `*` p < .1 -✅ Model fit statistics: N, R sq., Adj. R sq., AIC +✅ Model fit statistics: N, R sq., Adj. R sq., AIC (glm only) ### What's Different diff --git a/R/easytab.R b/R/easytab.R index ae867ec..d1e5bc2 100644 --- a/R/easytab.R +++ b/R/easytab.R @@ -51,7 +51,8 @@ #' @details #' The function extracts coefficients, standard errors, and p-values from each #' model, adds significance stars (*** p<.01, ** p<.05, * p<.1), and includes -#' model fit statistics (N, R-squared, Adjusted R-squared, AIC). +#' model fit statistics such as N, R-squared, Adjusted R-squared, and +#' AIC (for \code{glm} models). #' #' Control variables can be grouped to show presence/absence rather than #' individual coefficients for each factor level or transformation. @@ -147,11 +148,14 @@ easytable <- function(..., # Append custom row below AIC if provided if (!is.null(custom.row)) { - model_cols <- names(transformed)[-1] + # model_cols should exclude row_type + model_cols <- setdiff(names(transformed), c("term", "row_type")) new_row <- data.frame(term = custom.row[1], stringsAsFactors = FALSE) for (i in seq_along(model_cols)) { new_row[[model_cols[i]]] <- custom.row[i + 1L] } + new_row$row_type <- "custom" + transformed <- rbind(transformed, new_row) existing_stat_terms <- attr(transformed, "stat_terms") attr(transformed, "stat_terms") <- c(existing_stat_terms, custom.row[1]) @@ -160,6 +164,7 @@ easytable <- function(..., # Export to CSV if requested if (!is.null(export.csv)) { csv_table <- transformed + csv_table$row_type <- NULL for (col in names(csv_table)) { if (is.character(csv_table[[col]])) { csv_table[[col]] <- gsub("\n", " ", csv_table[[col]], fixed = TRUE) diff --git a/R/format_latex.R b/R/format_latex.R index b18976e..b7cba4c 100644 --- a/R/format_latex.R +++ b/R/format_latex.R @@ -29,6 +29,10 @@ format_latex <- function(table, table <- as.data.frame(table, stringsAsFactors = FALSE) table$term <- wrap_interaction_terms(table$term, output = "latex") + + row_types <- table$row_type + table$row_type <- NULL + display_headers <- names(table) display_headers[1] <- "Coefficient" @@ -110,7 +114,7 @@ format_latex <- function(table, stripe_count <- 0 if (length(coef_row_indices) > 0) { for (row_idx in coef_row_indices) { - is_control <- any(grepl("^Y$", table[row_idx, 2:ncol(table)])) + is_control <- !is.null(row_types) && row_types[row_idx] == "control" if (!is_control) { stripe_count <- stripe_count + 1 striped_row[row_idx] <- (stripe_count %% 2 == 0) diff --git a/R/format_word.R b/R/format_word.R index 58b23c3..e852e27 100644 --- a/R/format_word.R +++ b/R/format_word.R @@ -28,6 +28,9 @@ format_word <- function(table, table <- as.data.frame(table, stringsAsFactors = FALSE) table$term <- wrap_interaction_terms(table$term, output = "word") + row_types <- table$row_type + table$row_type <- NULL + wrap_model_header <- function(x, chunk = 11L) { if (is.na(x) || !nzchar(x) || grepl("\\s", x)) { return(x) @@ -101,7 +104,7 @@ format_word <- function(table, stripe_rows <- integer(0) for (row_idx in 1:(first_measure_row - 1)) { - is_control <- any(table[row_idx, 2:ncol(table), drop = TRUE] == "Y") + is_control <- !is.null(row_types) && row_types[row_idx] == "control" if (!is_control) { stripe_count <- stripe_count + 1 if (stripe_count %% 2 == 0) { diff --git a/R/parse_models.R b/R/parse_models.R index b0549d1..612bef1 100644 --- a/R/parse_models.R +++ b/R/parse_models.R @@ -176,7 +176,8 @@ format_coefficients <- function(coef_data, digits = 2) { #' Extract goodness-of-fit measures from a model #' #' Rounding is fixed per statistic and independent of the user-facing \code{digits} -#' option: N = 0, R sq. = 2, Adj. R sq. = 2, AIC = 0. +#' option: N = 0, R sq. = 2, Adj. R sq. = 2, AIC = 0. AIC is only reported +#' for \code{glm} models. #' #' @param model A statistical model object (lm or glm) #' diff --git a/R/transform_table.R b/R/transform_table.R index 661623f..1ffc05c 100644 --- a/R/transform_table.R +++ b/R/transform_table.R @@ -178,15 +178,27 @@ transform_table <- function(parsed_table, control.var = NULL, abbreviate = FALSE # Separate model-stat rows and put them at the bottom result <- separate_measures(result, control.var) - # Format term labels for display (skip model-stat rows) stat_terms <- attr(result, "stat_terms") if (is.null(stat_terms) || length(stat_terms) == 0) { stat_terms <- get_measure_names() } + + # Add row metadata to remove brittle string inference downstream + result$row_type <- "coefficient" + result$row_type[result$term == "(Intercept)"] <- "intercept" + + result$row_type[result$term %in% stat_terms] <- "statistic" + + if (!is.null(control.var)) { + result$row_type[result$term %in% control.var] <- "control" + } + + # Format term labels for display (skip model-stat rows) non_measure_rows <- !result$term %in% stat_terms result$term[non_measure_rows] <- format_term_labels( result$term[non_measure_rows], + row_types = result$row_type[non_measure_rows], levels_map = levels_map, abbreviate = abbreviate ) diff --git a/R/utils.R b/R/utils.R index 40cef67..12db963 100644 --- a/R/utils.R +++ b/R/utils.R @@ -66,14 +66,15 @@ wrap_interaction_terms <- function(terms, output = c("word", "latex")) { #' - Three-plus-token names become `t1[1:2] . t2[1:2] . t3[1:2]` #' #' @param var_name Character string +#' @param is_intercept Logical indicating if this variable is the intercept #' @return Character string #' @keywords internal -abbreviate_var_name <- function(var_name) { +abbreviate_var_name <- function(var_name, is_intercept = FALSE) { if (is.na(var_name) || !nzchar(var_name)) return(var_name) - # Preserve intercept label - if (identical(var_name, "(Intercept)")) return(var_name) + # Preserve intercept label using metadata + if (is_intercept) return(var_name) take <- function(x, k) { if (nchar(x) <= k) x else substring(x, 1, k) @@ -155,9 +156,12 @@ split_factor_level <- function(term, levels_map = NULL) { #' - Abbreviate only variable portion (if abbreviate = TRUE) #' - Ensure uniqueness after abbreviation #' +#' @param terms Character vector of displayed term labels. +#' @param row_types Optional character vector of row types +#' @param levels_map List mapping factor names to their levels #' @param abbreviate Logical. Apply abbreviation? Default FALSE #' @keywords internal -format_term_labels <- function(terms, levels_map = NULL, abbreviate = FALSE) { +format_term_labels <- function(terms, row_types = NULL, levels_map = NULL, abbreviate = FALSE) { formatted <- terms @@ -199,17 +203,17 @@ format_term_labels <- function(terms, levels_map = NULL, abbreviate = FALSE) { if (isTRUE(abbreviate)) { # Helper: abbreviate variable portion only - abbrev_piece <- function(piece) { + abbrev_piece <- function(piece, is_intercept = FALSE) { piece <- trimws(piece) - if (identical(piece, "(Intercept)")) return(piece) + if (is_intercept) return(piece) # Preserve polynomial suffixes like ".L", ".Q", ".C", ".^4" if (grepl("\\.[A-Za-z^0-9]+$", piece)) { base <- sub("(\\.[A-Za-z^0-9]+)$", "", piece) suffix <- sub("^.*(\\.[A-Za-z^0-9]+)$", "\\1", piece) - return(paste0(abbreviate_var_name(base), suffix)) + return(paste0(abbreviate_var_name(base, is_intercept), suffix)) } if (grepl(":", piece, fixed = TRUE)) { @@ -218,26 +222,27 @@ format_term_labels <- function(terms, levels_map = NULL, abbreviate = FALSE) { level_part <- paste(parts[-1], collapse = ":") # Replace underscores with periods in level part, then abbreviate level_part <- gsub("_", ".", level_part, fixed = TRUE) - level_part <- abbreviate_var_name(level_part) - return(paste0(abbreviate_var_name(var_name), ":", level_part)) + level_part <- abbreviate_var_name(level_part, is_intercept) + return(paste0(abbreviate_var_name(var_name, is_intercept), ":", level_part)) } - abbreviate_var_name(piece) + abbreviate_var_name(piece, is_intercept) } for (i in seq_along(formatted)) { term <- formatted[i] + is_idx_intercept <- !is.null(row_types) && row_types[i] == "intercept" if (grepl("\\*", term)) { parts <- strsplit(term, " \\* ")[[1]] - parts <- vapply(parts, abbrev_piece, character(1)) + parts <- vapply(parts, function(p) abbrev_piece(p, is_idx_intercept), character(1)) formatted[i] <- paste(parts, collapse = " * ") } else { - formatted[i] <- abbrev_piece(term) + formatted[i] <- abbrev_piece(term, is_idx_intercept) } } diff --git a/R/validators.R b/R/validators.R index 35a702a..cc94be8 100644 --- a/R/validators.R +++ b/R/validators.R @@ -53,9 +53,11 @@ validate_model_types <- function(model_list) { if (!is_supported_model(model)) { stop( - "Model '", model_name, "' is not supported yet.\n", + "Model '", model_name, "' is not supported.\n", "Detected class: ", paste(class(model), collapse = ", "), "\n", - "easytable currently supports: lm, glm", + "easytable currently supports: lm, glm.\n", + "For other model types, please see the modelsummary package:\n", + " https://modelsummary.com", call. = FALSE ) } diff --git a/README.md b/README.md index 37ff4ee..118d703 100644 --- a/README.md +++ b/README.md @@ -170,4 +170,4 @@ Hernandez Sanchez, A. (2026). easytable: Simple and Clean Regression Tables in R ## Acknowledgements -This package was created as an education technology to facilitate statistics teaching. Many thanks to the students at Vilnius University and the University of Bucaramanga for their feedback on usability and design. The development of this package was assisted by AI coding tools such as Claude `4.5 Sonnet` and ChatGPT `5.3 Codex` for code debugging, documentation updates, and package restructuring. +This package was created as an education technology to facilitate statistics teaching. Many thanks to the students at Vilnius University and the University of Bucaramanga for their feedback on usability and design. The development of this package was assisted by AI coding tools such as Gemini `3.1 Pro`, Claude `4.5 Sonnet`, and ChatGPT `5.3 Codex` for code debugging, documentation updates, and package restructuring. diff --git a/man/abbreviate_var_name.Rd b/man/abbreviate_var_name.Rd index 2eb6b3e..0be27f9 100644 --- a/man/abbreviate_var_name.Rd +++ b/man/abbreviate_var_name.Rd @@ -4,10 +4,12 @@ \alias{abbreviate_var_name} \title{Abbreviate variable name} \usage{ -abbreviate_var_name(var_name) +abbreviate_var_name(var_name, is_intercept = FALSE) } \arguments{ \item{var_name}{Character string} + +\item{is_intercept}{Logical indicating if this variable is the intercept} } \value{ Character string diff --git a/man/easytable.Rd b/man/easytable.Rd index ef0b479..90dd66a 100644 --- a/man/easytable.Rd +++ b/man/easytable.Rd @@ -85,7 +85,8 @@ marginal effects, and control variable grouping. \details{ The function extracts coefficients, standard errors, and p-values from each model, adds significance stars (*** p<.01, ** p<.05, * p<.1), and includes -model fit statistics (N, R-squared, Adjusted R-squared, AIC). +model fit statistics such as N, R-squared, Adjusted R-squared, and +AIC (for \code{glm} models). Control variables can be grouped to show presence/absence rather than individual coefficients for each factor level or transformation. diff --git a/man/extract_model_measures.Rd b/man/extract_model_measures.Rd index 8ddfa8f..1886a49 100644 --- a/man/extract_model_measures.Rd +++ b/man/extract_model_measures.Rd @@ -14,6 +14,7 @@ A data frame with model fit statistics } \description{ Rounding is fixed per statistic and independent of the user-facing \code{digits} -option: N = 0, R sq. = 2, Adj. R sq. = 2, AIC = 0. +option: N = 0, R sq. = 2, Adj. R sq. = 2, AIC = 0. AIC is only reported +for \code{glm} models. } \keyword{internal} diff --git a/man/format_term_labels.Rd b/man/format_term_labels.Rd index 9488787..de020ce 100644 --- a/man/format_term_labels.Rd +++ b/man/format_term_labels.Rd @@ -4,9 +4,20 @@ \alias{format_term_labels} \title{Format term labels for display} \usage{ -format_term_labels(terms, levels_map = NULL, abbreviate = FALSE) +format_term_labels( + terms, + row_types = NULL, + levels_map = NULL, + abbreviate = FALSE +) } \arguments{ +\item{terms}{Character vector of displayed term labels.} + +\item{row_types}{Optional character vector of row types} + +\item{levels_map}{List mapping factor names to their levels} + \item{abbreviate}{Logical. Apply abbreviation? Default FALSE} } \description{ diff --git a/tests/testthat/test-integration.R b/tests/testthat/test-integration.R index a8e1eda..29d8d03 100644 --- a/tests/testthat/test-integration.R +++ b/tests/testthat/test-integration.R @@ -102,6 +102,19 @@ test_that("easytable full pipeline with all features", { unlink(paste0(temp_csv, ".csv")) }) +test_that("export.word creates a non-empty .docx file", { + skip_if_word_tests_unavailable() + + tmp <- tempfile(fileext = ".docx") + on.exit(unlink(tmp), add = TRUE) + + result <- easytable(test_m1, test_m2, export.word = tmp) + + expect_s3_class(result, "flextable") + expect_true(file.exists(tmp)) + expect_true(file.info(tmp)$size > 0) +}) + test_that("easytable latex pipeline with control vars", { skip_if_not_installed("knitr") @@ -141,11 +154,13 @@ test_that("custom.row appears in the transformed table below AIC", { transformed <- transform_table(parsed) # Simulate what easytable does after transform - model_cols <- names(transformed)[-1] + model_cols <- setdiff(names(transformed), c("term", "row_type")) new_row <- data.frame(term = "F. Statistic", stringsAsFactors = FALSE) - new_row[[model_cols[1]]] <- ".004" - new_row[[model_cols[2]]] <- ".3" - new_row[[model_cols[3]]] <- ".1" + vals <- c(".004", ".3", ".1") + for (i in seq_along(model_cols)) { + new_row[[model_cols[i]]] <- vals[i] + } + new_row$row_type <- "custom" result <- rbind(transformed, new_row) # Custom row label is present diff --git a/tests/testthat/test-row-type-metadata.R b/tests/testthat/test-row-type-metadata.R new file mode 100644 index 0000000..129e1e7 --- /dev/null +++ b/tests/testthat/test-row-type-metadata.R @@ -0,0 +1,53 @@ +test_that("row_type metadata is created during transformation", { + m1 <- lm(mpg ~ cyl + hp, data = mtcars) + parsed <- parse_models(list("Model 1" = m1)) + transformed <- transform_table(parsed) + + expect_true("row_type" %in% names(transformed)) + expect_true(all(transformed$row_type %in% c("intercept", "coefficient", "statistic"))) + + # Check intercept specifically + intercept_idx <- which(transformed$term == "(Intercept)") + expect_equal(transformed$row_type[intercept_idx], "intercept") +}) + +test_that("row_type handles controls and custom rows properly", { + m1 <- lm(mpg ~ cyl + hp + wt, data = mtcars) + m2 <- lm(mpg ~ cyl + hp + wt + am, data = mtcars) + + parsed <- parse_models(list("M1" = m1, "M2" = m2)) + transformed <- transform_table(parsed, control.var = c("wt", "am")) + + expect_true(all(transformed$row_type[transformed$term %in% c("wt", "am")] == "control")) +}) + +test_that("row_type is stripped from final word and latex output", { + m1 <- lm(mpg ~ cyl, data = mtcars) + + # Word parsing + out_word <- suppressWarnings(easytable(m1, output = "word")) + # flextable's internal body dataset should NOT have row_type + expect_false("row_type" %in% out_word$col_keys) + + # LaTeX + out_latex <- as.character(suppressWarnings(easytable(m1, output = "latex"))) + # Check latex string has no reference to row_type (just an extra safety) + expect_false(grepl("row_type", out_latex, fixed = TRUE)) +}) + +test_that("formatting uses row_type instead of literal 'Y' for control rows", { + # Mock a variable named "Y" to prove we don't accidentally stripe it incorrectly + # by confusing it with the literal control indicator "Y" + mtcars_mock <- mtcars + mtcars_mock$Y <- mtcars_mock$wt + + m1 <- lm(mpg ~ cyl + Y, data = mtcars_mock) + + # If the logic mistakenly matched the coefficient value "Y" or term "Y", + # it might act strangely. + res_word <- suppressWarnings(easytable(m1, output = "word")) + res_latex <- as.character(suppressWarnings(easytable(m1, output = "latex"))) + + # Just verify it rendered successfully without crashing or mutating the name + expect_true(is.character(res_latex)) +}) diff --git a/tests/testthat/test-validators.R b/tests/testthat/test-validators.R index cc08e2d..335bb9c 100644 --- a/tests/testthat/test-validators.R +++ b/tests/testthat/test-validators.R @@ -26,7 +26,7 @@ test_that("validate_model_types catches unsupported models", { bad_model <- structure(list(), class = "unsupported_model") expect_error( validate_model_types(list(BadModel = bad_model)), - "not supported yet" + "not supported" ) # Valid models pass