diff --git a/R/utils.R b/R/utils.R index e2a5b3e81..b06ac1181 100644 --- a/R/utils.R +++ b/R/utils.R @@ -113,7 +113,7 @@ # insert row if (index == 1) { rbind(row, data) - } else if (index == nrow(data)) { + } else if (index == (nrow(data) + 1)) { rbind(data, row) } else { rbind(data[1:(index - 1), ], row, data[index:nrow(data), ]) @@ -121,6 +121,17 @@ } +.insert_element_at <- function(data, element, index) { + if (index == 1) { + c(element, data) + } else if (index == length(data)) { + c(data, element) + } else { + c(data[1:(index - 1)], element, data[index:length(data)]) + } +} + + .find_factor_levels <- function(data) { out <- lapply(colnames(data), function(i) { v <- data[[i]] diff --git a/R/utils_format.R b/R/utils_format.R index be26faef8..494ccad6e 100644 --- a/R/utils_format.R +++ b/R/utils_format.R @@ -347,12 +347,31 @@ params } + pretty_names <- attributes(params)$pretty_names out <- params - for (f in factors) { - min(which(f %in% out$Parameter)) + + for (fn in names(factors)) { + f <- factors[[fn]] + found <- which(names(pretty_names) %in% f) + if (length(found)) { + reference_level <- f[!f %in% names(pretty_names)] + pretty_level <- paste0(fn, " [", sub(fn, "", reference_level, fixed = TRUE), " (ref.)]") + pretty_names <- .insert_element_at( + pretty_names, + stats::setNames(pretty_level, reference_level), + min(found) + ) + out <- .insert_row_at( + out, + data.frame(Parameter = reference_level, Coefficient = 0, stringsAsFactors = FALSE), + min(found) + ) + } + attr(out, "pretty_names") <- pretty_names + attr(out, "pretty_labels") <- pretty_names } - params + out }