diff --git a/R/print_md.R b/R/print_md.R index a77f35732..57cfc5647 100644 --- a/R/print_md.R +++ b/R/print_md.R @@ -174,9 +174,62 @@ print_md.compare_parameters <- function(x, if (identical(engine, "tt")) { insight::check_if_installed("tinytable", minimum_version = "0.1.0") - gsub("(.*) \\((.*)\\)$", "\\2", colnames(out)) - gsub("(.*) \\((.*)\\)$", "\\1", colnames(out)) - lapply(groups, function(i) match(i, out$Parameter)) + # we need to find out which columns refer to which model, in order to + # add a column heading for each model + models <- attributes(x)$model_names + col_names <- gsub("(.*) \\((.*)\\)$", "\\2", colnames(formatted_table)) + col_groups <- sapply(models, function(i) which(i == col_names), simplify = FALSE) + row_groups <- NULL + # clean column names. These still contain the model name + colnames(formatted_table) <- gsub("(.*) \\((.*)\\)$", "\\1", colnames(formatted_table)) + # group rows? + if (!is.null(groups)) { + # make sure we have numeric indices for groups + groups <- lapply(groups, function(g) { + if (is.character(g)) { + # if groups were provided as parameter names, we find the row position + # by matching the parameter name + match(g, formatted_table$Parameter) + } else { + # else, we assume that the group is a row position + g + } + }) + # if row indices are not sorted, we need to resort the parameters data frame + if (is.unsorted(unlist(groups))) { + new_rows <- c(unlist(groups), setdiff(seq_len(nrow(formatted_table)), unlist(groups))) + formatted_table <- formatted_table[new_rows, ] + # we need to update indices in groups as well. Therefore, we need to convert + # list of row indices into a vector with row indices, then subtract the + # differences of old and new row positions, and then split that vector into + # a list again + groups <- stats::setNames(unlist(groups), rep(names(groups), lengths(groups))) + groups <- groups - (unlist(groups) - sort(unlist(groups))) + groups <- split(unname(groups), factor(names(groups), levels = unique(names(groups)))) + } + # find matching rows for groups + row_groups <- lapply(seq_along(groups), function(i) { + g <- groups[[i]] + if (is.character(g)) { + # if groups were provided as parameter names, we find the row position + # by matching the parameter name + g <- match(g, formatted_table$Parameter)[1] + } else { + # else, we assume that the group is a row position + g <- g[1] + } + g + }) + names(row_groups) <- paste0("*", names(groups), "*") + } + # replace NA in formatted_table by "" + formatted_table[is.na(formatted_table)] <- "" + # create base table + out <- tinytable::tt(formatted_table) + # insert sub header rows and column spans + out <- tinytable::group_tt(out, i = row_groups, j = col_groups) + out@output <- "markdown" + out } else { insight::export_table( formatted_table,