diff --git a/NAMESPACE b/NAMESPACE index 74c56da..1862953 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -67,6 +67,8 @@ S3method(select,tbl_graph) S3method(semi_join,tbl_graph) S3method(slice,morphed_tbl_graph) S3method(slice,tbl_graph) +S3method(tbl_format_footer,named_tbl) +S3method(tbl_sum,named_tbl) S3method(tbl_vars,tbl_graph) S3method(ungroup,grouped_tbl_graph) S3method(ungroup,morphed_tbl_graph) @@ -548,6 +550,8 @@ importFrom(igraph,which_multiple) importFrom(igraph,which_mutual) importFrom(magrittr,"%>%") importFrom(pillar,style_subtle) +importFrom(pillar,tbl_format_footer) +importFrom(pillar,tbl_sum) importFrom(rlang,"!!!") importFrom(rlang,"%||%") importFrom(rlang,.data) @@ -573,7 +577,6 @@ importFrom(stats,na.omit) importFrom(stats,setNames) importFrom(tibble,as_tibble) importFrom(tibble,tibble) -importFrom(tibble,trunc_mat) importFrom(tidyr,nest_legacy) importFrom(tools,toTitleCase) importFrom(utils,head) diff --git a/R/tbl_graph.R b/R/tbl_graph.R index 743a96d..64d1fdb 100644 --- a/R/tbl_graph.R +++ b/R/tbl_graph.R @@ -74,31 +74,48 @@ as_tbl_graph.default <- function(x, ...) { is.tbl_graph <- function(x) { inherits(x, 'tbl_graph') } -#' @importFrom tibble trunc_mat + +new_name_tibble <- function(x, active = NULL, name = "A tibble", suffix = "") { + x <- as_tibble(x, active) + attr(x, "name") <- name + attr(x, "suffix") <- suffix + class(x) <- c("named_tbl", class(x)) + x +} +#' @importFrom pillar tbl_sum +#' @export +tbl_sum.named_tbl <- function(x) { + summary <- NextMethod() + names(summary)[1] <- attr(x, "name") + summary[1] <- paste0(summary[1], attr(x, "suffix")) + summary +} +#' @importFrom pillar tbl_format_footer +#' @export +tbl_format_footer.named_tbl <- function(x, setup, ...) { + footer <- NextMethod() + footer[min(1, length(footer))] +} + #' @importFrom tools toTitleCase #' @importFrom rlang as_quosure sym -#' @importFrom pillar style_subtle #' @export print.tbl_graph <- function(x, ...) { - arg_list <- list(...) - arg_list[['useS4']] <- NULL graph_desc <- describe_graph(x) not_active <- if (active(x) == 'nodes') 'edges' else 'nodes' - top <- do.call(trunc_mat, modifyList(arg_list, list(x = as_tibble(x), n = 6))) - top$summary[1] <- paste0(top$summary[1], ' (active)') - names(top$summary)[1] <- toTitleCase(paste0(substr(active(x), 1, 4), ' data')) - bottom <- do.call(trunc_mat, modifyList(arg_list, list(x = as_tibble(x, active = not_active), n = 3))) - names(bottom$summary)[1] <- toTitleCase(paste0(substr(not_active, 1, 4), ' data')) + top <- toTitleCase(paste0(substr(active(x), 1, 4), ' data')) + bottom <- toTitleCase(paste0(substr(not_active, 1, 4), ' data')) cat_subtle('# A tbl_graph: ', gorder(x), ' nodes and ', gsize(x), ' edges\n', sep = '') cat_subtle('#\n') cat_subtle('# ', graph_desc, '\n', sep = '') cat_subtle('#\n') - print(top) + print(new_name_tibble(x, NULL, top, " (active)"), ...) cat_subtle('#\n') - print(bottom) + print(new_name_tibble(x, not_active, bottom, ""), n = 3) invisible(x) } +#' @importFrom pillar style_subtle cat_subtle <- function(...) cat(pillar::style_subtle(paste0(...))) #' @export