From 75156666bf0aeb83fba607f4b2a0c6501d1437cc Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Wed, 20 Nov 2024 19:41:35 -0500 Subject: [PATCH] Issue #816 --- DESCRIPTION | 2 +- NEWS.md | 1 + R/bind_est_gof.R | 6 +- R/shape_estimates.R | 73 +++++++------ inst/tinytest/test-shape.R | 205 +++++++++++++++++++++---------------- 5 files changed, 157 insertions(+), 130 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 746b62d34..fe5437e7f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,7 +10,7 @@ Description: Create beautiful and customizable tables to summarize several RTF, JPG, or PNG. Tables can easily be embedded in 'Rmarkdown' or 'knitr' dynamic documents. Details can be found in Arel-Bundock (2022) . -Version: 2.2.0.3 +Version: 2.2.0.4 Authors@R: c(person("Vincent", "Arel-Bundock", email = "vincent.arel-bundock@umontreal.ca", role = c("aut", "cre", "cph"), diff --git a/NEWS.md b/NEWS.md index 66a8b96e6..eb8f9ec19 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ Bugs: * Stars note in `kableExtra` escaped `\num{}` in LaTeX. * Bad horizontal rule placement with `add_rows`. Thanks to @pyoungblood for Issue #813. +* `shape` creates bad columns when model names include spaces. Thanks to @daSilva5 for report #816. New features: diff --git a/R/bind_est_gof.R b/R/bind_est_gof.R index ee4693f6d..775934fb8 100644 --- a/R/bind_est_gof.R +++ b/R/bind_est_gof.R @@ -21,8 +21,9 @@ bind_est_gof <- function(est, gof) { bad <- c("part", "term", "model", "group", "statistic") bad <- stats::na.omit(match(bad, colnames(est))) - idx <- sapply(colnames(gof), function(x) # first matches - setdiff(grep(x, colnames(est)), bad)[1]) + idx <- sapply(colnames(gof), function(x) { # first matches + setdiff(grep(x, colnames(est), fixed = TRUE), bad)[1] + }) idx <- stats::na.omit(idx) if (length(idx) > 0) { data.table::setnames(gof, old = names(idx), new = names(est)[idx]) @@ -33,4 +34,3 @@ bind_est_gof <- function(est, gof) { return(out) } - diff --git a/R/shape_estimates.R b/R/shape_estimates.R index 4f2b802d8..99ba6b9fb 100644 --- a/R/shape_estimates.R +++ b/R/shape_estimates.R @@ -3,53 +3,52 @@ #' @keywords internal #' @noRd shape_estimates <- function(estimates, shape, conf_level, statistic, estimate) { + # default + if (isTRUE(all.equal(shape$shape_formula, term + statistic ~ model))) { + return(estimates) + } - # default - if (isTRUE(all.equal(shape$shape_formula, term + statistic ~ model))) { - return(estimates) - } - - shape_formula <- shape$shape_formula + shape_formula <- shape$shape_formula - idx <- intersect(colnames(estimates), c("term", "statistic", "group", shape$group_name)) + idx <- intersect(colnames(estimates), c("term", "statistic", "group", shape$group_name)) - # long - out <- data.table::melt(data.table::data.table(estimates), - id.vars = idx, - variable.name = "model", - value.name = "estimate") + # long + out <- data.table::melt(data.table::data.table(estimates), + id.vars = idx, + variable.name = "model", + value.name = "estimate") - if ("statistic" %in% shape$rhs) { - out$statistic <- rename_statistics(out$statistic, conf_level = conf_level, statistic = statistic, estimate = estimate) - } + if ("statistic" %in% shape$rhs) { + out$statistic <- rename_statistics(out$statistic, conf_level = conf_level, statistic = statistic, estimate = estimate) + } - # use factors to preserve order in `dcast` - for (col in c("part", "model", "term", shape$group_name, "statistic")) { - if (col %in% colnames(out)) { - out[[col]] <- factor(out[[col]], unique(out[[col]])) - } + # use factors to preserve order in `dcast` + for (col in c("part", "model", "term", shape$group_name, "statistic")) { + if (col %in% colnames(out)) { + out[[col]] <- factor(out[[col]], unique(out[[col]])) } + } - # wide - out <- data.table::dcast(eval(shape_formula), - data = out, - value.var = "estimate", - sep = "||||") + # wide + out <- data.table::dcast(eval(shape_formula), + data = out, + value.var = "estimate", + sep = "||||") - data.table::setDF(out) + data.table::setDF(out) - out[out == "NA"] <- "" - out[is.na(out)] <- "" + out[out == "NA"] <- "" + out[is.na(out)] <- "" - # empty columns - idx <- sapply(out, function(x) !all(x == "")) - out <- out[, idx, drop = FALSE] + # empty columns + idx <- sapply(out, function(x) !all(x == "")) + out <- out[, idx, drop = FALSE] - # empty rows - idx <- setdiff(colnames(out), c("part", "term", "statistic", "model")) - tmp <- out[, idx, drop = FALSE] - idx <- apply(tmp, 1, function(x) !all(x == "")) - out <- out[idx, ] + # empty rows + idx <- setdiff(colnames(out), c("part", "term", "statistic", "model")) + tmp <- out[, idx, drop = FALSE] + idx <- apply(tmp, 1, function(x) !all(x == "")) + out <- out[idx, ] - return(out) + return(out) } diff --git a/inst/tinytest/test-shape.R b/inst/tinytest/test-shape.R index 10e93104e..ea5d3877d 100644 --- a/inst/tinytest/test-shape.R +++ b/inst/tinytest/test-shape.R @@ -13,10 +13,10 @@ tab1 <- modelsummary(mfx, output = "dataframe", shape = term:contrast ~ model) tab2 <- modelsummary(mfx, output = "dataframe", shape = term:contrast + statistic ~ model) tab3 <- modelsummary(mfx, output = "dataframe", shape = term + contrast + statistic ~ model) tab4 <- modelsummary( - mfx, - output = "dataframe", - coef_rename = function(x) gsub(" dY/dX", " (Slope)", x), - shape = term : contrast ~ model) + mfx, + output = "dataframe", + coef_rename = function(x) gsub(" dY/dX", " (Slope)", x), + shape = term:contrast ~ model) expect_equivalent(tab1, tab2) expect_equivalent(nrow(tab1), nrow(tab3)) expect_equivalent(ncol(tab1) + 1, ncol(tab3)) @@ -39,7 +39,7 @@ options(modelsummary_factory_default = "data.frame") mod <- lm(mpg ~ hp + factor(cyl), data = mtcars) # term + statistic ~ model -tab1 <- modelsummary(mod, shape = ~ model, gof_map = NA) +tab1 <- modelsummary(mod, shape = ~model, gof_map = NA) tab2 <- modelsummary(mod, shape = statistic ~ model, gof_map = NA) tab3 <- modelsummary(mod, shape = term + statistic ~ model, gof_map = NA) expect_equivalent(dim(tab1), c(8, 4)) @@ -72,21 +72,23 @@ options(modelsummary_factory_default = NULL) mod <- lm(mpg ~ hp + factor(cyl), data = mtcars) tab <- modelsummary(mod, shape = model + term ~ statistic, output = "data.frame", gof_map = NA) expect_equivalent(dim(tab), c(4, 5)) -tab <- modelsummary(list(mod, mod), shape = model + term ~ statistic, - output = "data.frame", gof_map = NA) +tab <- modelsummary(list(mod, mod), + shape = model + term ~ statistic, + output = "data.frame", gof_map = NA) expect_equivalent(dim(tab), c(8, 5)) -tab <- modelsummary(list(mod, mod), shape = term ~ model + statistic, - output = "data.frame", gof_map = NA) +tab <- modelsummary(list(mod, mod), + shape = term ~ model + statistic, + output = "data.frame", gof_map = NA) expect_equivalent(dim(tab), c(4, 6)) tab <- modelsummary(mod, - statistic = c("std.error", "conf.int"), - shape = model + term ~ statistic, - fmt = 2, - conf_level = .99, - output = "data.frame", - gof_map = NA) + statistic = c("std.error", "conf.int"), + shape = model + term ~ statistic, + fmt = 2, + conf_level = .99, + output = "data.frame", + gof_map = NA) expect_equivalent(dim(tab), c(4, 7)) expect_true(all(c("Est.", "S.E.", "0.5 %", "99.5 %") %in% colnames(tab))) @@ -99,14 +101,14 @@ dat_multinom <- mtcars dat_multinom$cyl <- as.factor(dat_multinom$cyl) dat_multinom$under_score <- dat_multinom$mpg mod <- list( - "a" = nnet::multinom(cyl ~ under_score, data = dat_multinom, trace = FALSE), - "b" = nnet::multinom(cyl ~ under_score + drat, data = dat_multinom, trace = FALSE)) + "a" = nnet::multinom(cyl ~ under_score, data = dat_multinom, trace = FALSE), + "b" = nnet::multinom(cyl ~ under_score + drat, data = dat_multinom, trace = FALSE)) coef_list = c("under_score" = "Under Score") void <- capture.output( - tab <- modelsummary(mod, - output = "latex", - coef_map = coef_list, - shape = term ~ model + response) + tab <- modelsummary(mod, + output = "latex", + coef_map = coef_list, + shape = term ~ model + response) ) expect_snapshot_print(tab, "shape-multinom_wide") @@ -114,11 +116,11 @@ expect_snapshot_print(tab, "shape-multinom_wide") # flipped table (no groups) mod <- list( -lm(hp ~ mpg, mtcars), -lm(hp ~ mpg + drat, mtcars)) + lm(hp ~ mpg, mtcars), + lm(hp ~ mpg + drat, mtcars)) tab <- modelsummary(mod, - output = "data.frame", - shape = model ~ term) + output = "data.frame", + shape = model ~ term) expect_true("model" %in% colnames(tab)) @@ -129,37 +131,41 @@ dat_multinom <- mtcars dat_multinom$cyl <- as.factor(dat_multinom$cyl) mod <- list( - nnet::multinom(cyl ~ mpg, data = dat_multinom, trace = FALSE), - nnet::multinom(cyl ~ mpg + drat, data = dat_multinom, trace = FALSE)) + nnet::multinom(cyl ~ mpg, data = dat_multinom, trace = FALSE), + nnet::multinom(cyl ~ mpg + drat, data = dat_multinom, trace = FALSE)) ## order of rows determined by order of formula terms trash <- capture.output(tab <- modelsummary(mod, "data.frame", shape = response + term ~ model)) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "response", "term", "statistic", "(1)", "(2)")) +expect_equivalent( + colnames(tab), + c("part", "response", "term", "statistic", "(1)", "(2)")) expect_equivalent(tab$term[1:4], c("(Intercept)", "(Intercept)", "mpg", "mpg")) expect_equivalent(tab$response[1:12], c(rep("6", 6), rep("8", 6))) ## order of rows determined by order of formula terms trash <- capture.output(tab <- modelsummary(mod, "data.frame", shape = term + response ~ model)) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "term", "response", "statistic", "(1)", "(2)")) +expect_equivalent( + colnames(tab), + c("part", "term", "response", "statistic", "(1)", "(2)")) expect_equivalent(tab$term[1:4], rep("(Intercept)", 4)) expect_equivalent(tab$response[1:4], c("6", "6", "8", "8")) ## order of rows determined by order of formula terms trash <- capture.output(tab <- modelsummary(mod, "data.frame", shape = model + term ~ response)) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "model", "term", "statistic", "6", "8")) +expect_equivalent( + colnames(tab), + c("part", "model", "term", "statistic", "6", "8")) expect_equivalent(tab$model[1:10], c(rep("(1)", 4), rep("(2)", 6))) ## order of rows determined by order of formula terms trash <- capture.output(tab <- modelsummary(mod, "data.frame", shape = term + model ~ response)) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "term", "model", "statistic", "6", "8")) +expect_equivalent( + colnames(tab), + c("part", "term", "model", "statistic", "6", "8")) expect_equivalent(tab$model[1:3], c("(1)", "(1)", "(2)")) @@ -168,24 +174,26 @@ expect_equivalent(tab$model[1:3], c("(1)", "(1)", "(2)")) dat_multinom <- mtcars dat_multinom$cyl <- as.factor(dat_multinom$cyl) mod <- list( - nnet::multinom(cyl ~ mpg, data = dat_multinom, trace = FALSE), - nnet::multinom(cyl ~ mpg + drat, data = dat_multinom, trace = FALSE)) + nnet::multinom(cyl ~ mpg, data = dat_multinom, trace = FALSE), + nnet::multinom(cyl ~ mpg + drat, data = dat_multinom, trace = FALSE)) tab <- modelsummary(mod, - output = "data.frame", - shape = response ~ model + term, - metrics = "RMSE") -known <- c("part", "response", "statistic", "(1) / (Intercept)", "(1) / mpg", -"(2) / (Intercept)", "(2) / mpg", "(2) / drat") + output = "data.frame", + shape = response ~ model + term, + metrics = "RMSE") +known <- c( + "part", "response", "statistic", "(1) / (Intercept)", "(1) / mpg", + "(2) / (Intercept)", "(2) / mpg", "(2) / drat") expect_equivalent(colnames(tab), known) expect_equivalent(dim(tab), c(6, 8)) tab <- modelsummary(mod, - output = "data.frame", - shape = response ~ term + model, - metrics = "RMSE") -known <- c("part", "response", "statistic", "(Intercept) / (1)", "(Intercept) / (2)", -"mpg / (1)", "mpg / (2)", "drat / (2)") + output = "data.frame", + shape = response ~ term + model, + metrics = "RMSE") +known <- c( + "part", "response", "statistic", "(Intercept) / (1)", "(Intercept) / (2)", + "mpg / (1)", "mpg / (2)", "drat / (2)") expect_equivalent(colnames(tab), known) expect_equivalent(dim(tab), c(6, 8)) @@ -195,36 +203,42 @@ requiet("nnet") dat_multinom$cyl <- as.factor(dat_multinom$cyl) mod <- list( - nnet::multinom(cyl ~ mpg, data = dat_multinom, trace = FALSE), - nnet::multinom(cyl ~ mpg + drat, data = dat_multinom, trace = FALSE)) + nnet::multinom(cyl ~ mpg, data = dat_multinom, trace = FALSE), + nnet::multinom(cyl ~ mpg + drat, data = dat_multinom, trace = FALSE)) ## term ~ model + response trash <- capture.output( - tab <- modelsummary(mod, "data.frame", shape = term ~ model + response)) + tab <- modelsummary(mod, "data.frame", shape = term ~ model + response)) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "term", "statistic", "(1) / 6", "(1) / 8", "(2) / 6", "(2) / 8")) +expect_equivalent( + colnames(tab), + c("part", "term", "statistic", "(1) / 6", "(1) / 8", "(2) / 6", "(2) / 8")) ## term ~ response + model trash <- capture.output(tab <- modelsummary(mod, "data.frame", shape = term ~ response + model)) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "term", "statistic", "6 / (1)", "6 / (2)", "8 / (1)", "8 / (2)")) +expect_equivalent( + colnames(tab), + c("part", "term", "statistic", "6 / (1)", "6 / (2)", "8 / (1)", "8 / (2)")) ## model ~ term + response trash <- capture.output(tab <- modelsummary(mod, "data.frame", shape = model ~ term + response)) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "model", "statistic", "(Intercept) / 6", - "(Intercept) / 8", "mpg / 6", "mpg / 8", "drat / 6", - "drat / 8")) +expect_equivalent( + colnames(tab), + c( + "part", "model", "statistic", "(Intercept) / 6", + "(Intercept) / 8", "mpg / 6", "mpg / 8", "drat / 6", + "drat / 8")) ## model ~ response + term trash <- capture.output(tab <- modelsummary(mod, "data.frame", shape = model ~ response + term)) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "model", "statistic", "6 / (Intercept)", "6 / mpg", "6 / drat", - "8 / (Intercept)", "8 / mpg", "8 / drat")) +expect_equivalent( + colnames(tab), + c( + "part", "model", "statistic", "6 / (Intercept)", "6 / mpg", "6 / drat", + "8 / (Intercept)", "8 / mpg", "8 / drat")) @@ -232,22 +246,25 @@ expect_equivalent(colnames(tab), requiet("gamlss") data(abdom) -mod <- list(gamlss(y ~ pb(x), - sigma.fo = ~ pb(x), trace = FALSE, - family = BCT, data = abdom, method = mixed(1, 20)), - gamlss(y ~ x, - sigma.fo = ~ pb(x), trace = FALSE, - family = BCT, data = abdom, method = mixed(1, 20))) +mod <- list( + gamlss(y ~ pb(x), + sigma.fo = ~ pb(x), trace = FALSE, + family = BCT, data = abdom, method = mixed(1, 20)), + gamlss(y ~ x, + sigma.fo = ~ pb(x), trace = FALSE, + family = BCT, data = abdom, method = mixed(1, 20))) tab <- modelsummary(mod, "data.frame", shape = term + component ~ model) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "term", "component", "statistic", "(1)", "(2)")) +expect_equivalent( + colnames(tab), + c("part", "term", "component", "statistic", "(1)", "(2)")) tab <- modelsummary(mod, "data.frame", shape = component + term ~ model) expect_inherits(tab, "data.frame") -expect_equivalent(colnames(tab), - c("part", "component", "term", "statistic", "(1)", "(2)")) +expect_equivalent( + colnames(tab), + c("part", "component", "term", "statistic", "(1)", "(2)")) tab <- modelsummary(mod, "data.frame", shape = term ~ model + component) expect_inherits(tab, "data.frame") @@ -265,7 +282,7 @@ expect_inherits(tab, "data.frame") # model names are preserved requiet("gamlss") -dat <- rgamma(100, shape=1, scale=10) +dat <- rgamma(100, shape = 1, scale = 10) models <- list() models[["GA"]] <- gamlss(dat ~ 1, family = GA, trace = FALSE) models[["GA 2"]] <- gamlss(dat ~ 1, family = GA, trace = FALSE) @@ -279,9 +296,9 @@ requiet("pscl") data("bioChemists", package = "pscl") mod <- hurdle(art ~ phd + fem | ment, data = bioChemists, dist = "negbin") tab <- modelsummary(mod, - shape = component + term ~ model, - group_map = c("zero_inflated" = "Zero", "conditional" = "Count"), - output = "data.frame") + shape = component + term ~ model, + group_map = c("zero_inflated" = "Zero", "conditional" = "Count"), + output = "data.frame") expect_equivalent(tab$component[1], "Zero") @@ -289,15 +306,15 @@ expect_equivalent(tab$component[1], "Zero") # Issue #531 mod <- lm(mpg ~ hp + factor(cyl), data = mtcars) tab <- modelsummary( - mod, - output = "dataframe", - shape = term + model ~ statistic, - estimate = c("$\\hat{\\beta}$" = "{estimate}"), - statistic = c("S.E." = "std.error", "p" = "{p.value}{stars}", "Est. (t)" = "{estimate} ({statistic})"), - fmt = fmt_statistic(estimate = 3, p.value = 2)) + mod, + output = "dataframe", + shape = term + model ~ statistic, + estimate = c("$\\hat{\\beta}$" = "{estimate}"), + statistic = c("S.E." = "std.error", "p" = "{p.value}{stars}", "Est. (t)" = "{estimate} ({statistic})"), + fmt = fmt_statistic(estimate = 3, p.value = 2)) expect_equivalent( - colnames(tab), - c("part", "term", "model", "$\\hat{\\beta}$", "S.E.", "p", "Est. (t)")) + colnames(tab), + c("part", "term", "model", "$\\hat{\\beta}$", "S.E.", "p", "Est. (t)")) # Issue #631: bad group column @@ -305,8 +322,8 @@ requiet("nnet") dat_multinom <- mtcars dat_multinom$cyl <- sprintf("Cyl: %s", dat_multinom$cyl) mod <- list( - nnet::multinom(cyl ~ mpg, data = dat_multinom, trace = FALSE), - nnet::multinom(cyl ~ mpg + drat, data = dat_multinom, trace = FALSE)) + nnet::multinom(cyl ~ mpg, data = dat_multinom, trace = FALSE), + nnet::multinom(cyl ~ mpg + drat, data = dat_multinom, trace = FALSE)) tab <- modelsummary(mod, shape = model + term + response ~ statistic, output = "dataframe") expect_true(all(tab$model %in% c("(1)", "(2)"))) @@ -315,12 +332,22 @@ expect_true(all(tab$model %in% c("(1)", "(2)"))) dat_multinom <- mtcars dat_multinom <- transform(mtcars, vs = as.factor(vs), carb = as.factor(carb)) mod <- list( - nnet::multinom(cyl ~ vs, data = dat_multinom, trace = FALSE), - nnet::multinom(cyl ~ vs + carb, data = dat_multinom, trace = FALSE)) + nnet::multinom(cyl ~ vs, data = dat_multinom, trace = FALSE), + nnet::multinom(cyl ~ vs + carb, data = dat_multinom, trace = FALSE)) tab <- modelsummary( - mod, shape = model + term + response ~ statistic, - output = "dataframe", coef_rename = TRUE) + mod, + shape = model + term + response ~ statistic, + output = "dataframe", coef_rename = TRUE) known <- sort(unique(tab$term)) unknown <- c("(Intercept)", "carb [2]", "carb [3]", "carb [4]", "carb [6]", "carb [8]", "vs [1]") expect_equal(known, unknown) + + +# Issue #816: Bad rbind(est, gof) with space in model names +mod <- list( + "Talk" = lm(mpg ~ hp, data = mtcars), + "Talk (blah)" = lm(mpg ~ hp + qsec, data = mtcars) +) +tab <- modelsummary(mod, shape = term ~ model + statistic) +expect_equivalent(ncol(tab), 5)