Issue #816

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)
     <doi:10.18637/jss.v103.i01>.
-Version: 2.2.0.3
+Version: 2.2.0.4
 Authors@R: c(person("Vincent", "Arel-Bundock", 
                    email = "[email protected]", 
                    role = c("aut", "cre", "cph"),

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:
 

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

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