diff --git a/R/ctl_colonnade.R b/R/ctl_colonnade.R index 5caa70f1b..4d819284f 100644 --- a/R/ctl_colonnade.R +++ b/R/ctl_colonnade.R @@ -55,12 +55,25 @@ ctl_colonnade <- function(x, has_row_id = TRUE, width = NULL, on_extra_cols <- function(my_extra_cols) { # print(extra_cols) - # FIXME: Show for all levels - is_top_level <- map_lgl(my_extra_cols$x, identical, x) - if (any(is_top_level)) { - extra_cols <<- as.list(x)[my_extra_cols$cols[is_top_level][[1]]] - names(extra_cols) <<- tick_if_needed(names(extra_cols)) - } + out <- pmap(my_extra_cols, function(x, title, cols) { + out <- as.list(x)[cols] + if (is.null(title)) { + return(out) + } + + if (length(out) > 1) { + title_empty <- rep_along(title, "") + new_names <- paste0(paste0(title_empty, "$", collapse = ""), names(out)) + new_names[[1]] <- paste0(paste0(title, "$", collapse = ""), names(out)[[1]]) + names(out) <- new_names + } else { + # Also account for the case of packed matrices here + names(out) <- prepare_title(c(title, names(out))) + } + out + }) + + extra_cols <<- unlist(out, recursive = FALSE) } cb <- new_emit_tiers_callbacks( @@ -69,10 +82,6 @@ ctl_colonnade <- function(x, has_row_id = TRUE, width = NULL, ) do_emit_tiers(x_focus, tier_widths, length(focus), cb) - if (length(extra_cols) == 0) { - extra_cols <- list() - } - new_colonnade_body(formatted_tiers, split_after = split_after, extra_cols = extra_cols) } @@ -156,9 +165,11 @@ do_emit_tiers <- function(x, tier_widths, n_focus, cb) { # message("extra_cols()") # print(title) # print(cols) - extra_cols <<- vec_rbind(extra_cols, data_frame( + new_extra_cols <- data_frame( x = list(x), title = list(title), cols = list(cols) - )) + ) + # Add to the front, because top-level columns are emitted first: + extra_cols <<- vec_rbind(new_extra_cols, extra_cols) } cb_pillars <- new_emit_pillars_callbacks( @@ -192,16 +203,36 @@ new_emit_pillars_callbacks <- function(controller, ) } -do_emit_pillars <- function(x, tier_widths, cb, title = NULL, first_pillar = NULL, parent_col_idx = 1L) { +do_emit_pillars <- function(x, tier_widths, cb, title = NULL, first_pillar = NULL, parent_col_idx = NULL) { top_level <- is.null(first_pillar) - pillar_list <- ctl_new_pillar_list(cb$controller, x, width = tier_widths, title = title, first_pillar = first_pillar) + # Only tweaking sub-title, because full title is needed for extra-cols + sub_title <- title + if (!is.null(sub_title)) { + sub_title[-length(sub_title)][parent_col_idx[-1] != 1] <- "" + } + + pillar_list <- ctl_new_pillar_list(cb$controller, x, width = tier_widths, title = sub_title, first_pillar = first_pillar) # Extra columns are known early on, and remain fixed extra <- attr(pillar_list, "extra") + # We emit early, this means that top-level columns are emitted before + # nested columns. We reverse in the callback. if (length(extra) > 0) { - cb$on_extra_cols(x, title, extra) + if (is.numeric(extra)) { + if (length(extra) == 1) { + extra <- paste0("[", extra, "]") + } else { + extra <- paste0("[", min(extra), ":", max(extra), "]") + } + x_extra <- set_names(list(x[1, ]), extra) + } else { + extra <- tick_if_needed(extra) + x_extra <- tick_names_if_needed(x) + } + + cb$on_extra_cols(x_extra, title, extra) } if (length(pillar_list) == 0) { @@ -252,16 +283,6 @@ do_emit_pillars <- function(x, tier_widths, cb, title = NULL, first_pillar = NUL x_pos <- 0L tier_pos <- 1L - # FIXME: Replace with title vector - sub_title <- title - if (!is.null(sub_title)) { - if (parent_col_idx >= 2) { - sub_title[[length(sub_title)]] <- "$" - } else { - sub_title[[length(sub_title)]] <- paste0(sub_title[[length(sub_title)]], "$") - } - } - # Advance column by column for (col in seq_along(pillar_list)) { target_tier <- rev$tier[[col]] @@ -286,9 +307,9 @@ do_emit_pillars <- function(x, tier_widths, cb, title = NULL, first_pillar = NUL x[[col]], sub_tier_widths, cb, - c(sub_title, tick_if_needed(names(x)[[col]])), + c(title, tick_if_needed(names(x)[[col]])), pillar_list[[col]], - col + c(parent_col_idx, if (!is.null(names(x))) col) ) "!!!!!DEBUG used" diff --git a/R/ctl_compound.R b/R/ctl_compound.R index 87cd20040..10d866d41 100644 --- a/R/ctl_compound.R +++ b/R/ctl_compound.R @@ -18,27 +18,15 @@ new_data_frame_pillar_list <- function(x, controller, width, title, first_pillar for (i in seq_along(x)) { "!!!!!DEBUG i = `i`, width = `width`" - # FIXME - # sub_title <- c(title, ticked_names[[i]]) if (i == 1 && !is.null(first_pillar)) { pillar <- first_pillar } else { - sub_title <- ticked_names[[i]] - if (!is.null(title)) { - if (i == 1) { - title[[length(title)]] <- paste0(title[[length(title)]], "$") - } else { - title[[length(title)]] <- "$" - } - sub_title <- c(title, sub_title) - } - # Call ctl_new_pillar_list(), return only the first sub-pillar # thanks to width = NULL new_pillars <- ctl_new_pillar_list( controller, x[[i]], width = NULL, - title = sub_title + title = c(title, ticked_names[[i]]) ) # Safety check: @@ -67,6 +55,10 @@ new_data_frame_pillar_list <- function(x, controller, width, title, first_pillar } pillars[[i]] <- pillar + + if (!is.null(title)) { + title[] <- "" + } } pillars <- compact(pillars) diff --git a/R/ctl_new_pillar.R b/R/ctl_new_pillar.R index f8bd86424..d108b2921 100644 --- a/R/ctl_new_pillar.R +++ b/R/ctl_new_pillar.R @@ -147,7 +147,13 @@ ctl_new_pillar_list.tbl <- function(controller, x, width, ..., title = NULL, fir } } -# FIXME: Keep vectorized titles later prepare_title <- function(title) { - paste(title, collapse = "") + n_title <- length(title) + if (n_title == 0) { + title + } else if (grepl("^[[]", title[[n_title]])) { + paste0(paste(title[-n_title], collapse = "$"), title[[n_title]]) + } else { + paste(title, collapse = "$") + } } diff --git a/R/tick.R b/R/tick.R index 7ff43f9f2..4533f082e 100644 --- a/R/tick.R +++ b/R/tick.R @@ -22,13 +22,26 @@ format_title <- function(x, width) { out } +tick_names_if_needed <- function(x) { + names(x) <- tick_if_needed(names(x)) + x +} + tick_if_needed <- function(x) { + # Compatibility with R 3.4 + if (is.null(x)) { + return(NULL) + } needs_ticks <- !is_syntactic(x) x[needs_ticks] <- tick(x[needs_ticks]) x } is_syntactic <- function(x) { + # Compatibility with R 3.4 + if (is.null(x)) { + return(logical()) + } ret <- make.names(x) == x ret[is.na(x)] <- FALSE ret diff --git a/tests/testthat/_snaps/tbl-format-setup.md b/tests/testthat/_snaps/tbl-format-setup.md index bd57f9366..315cbeff1 100644 --- a/tests/testthat/_snaps/tbl-format-setup.md +++ b/tests/testthat/_snaps/tbl-format-setup.md @@ -1,6 +1,7 @@ # output test Code + options(width = 100) tbl_format_setup(x, width = 4) Output @@ -532,7 +533,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , # `col 05` Code tbl_format_setup(x, width = 36) @@ -547,7 +550,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , # `col 05` Code tbl_format_setup(x, width = 37) @@ -562,7 +567,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , # `col 05` Code tbl_format_setup(x, width = 38) @@ -577,7 +584,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , # `col 05` Code tbl_format_setup(x, width = 39) @@ -592,7 +601,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , # `col 05` Code tbl_format_setup(x, width = 40) @@ -607,8 +618,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: - # `col 05` + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , `col 05` Code tbl_format_setup(x, width = 41) Output @@ -622,8 +634,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: - # `col 05` + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , `col 05` Code tbl_format_setup(x, width = 42) Output @@ -637,8 +650,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: - # `col 05` + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , `col 05` Code tbl_format_setup(x, width = 43) Output @@ -652,7 +666,9 @@ 2 2.23 b 3 3.23 c - # ... with 1 more variable: `col 05` + # ... with 3 more variables: + # `col 01`$`col 03` , + # $`col 04` , `col 05` Code tbl_format_setup(x, width = 44) Output @@ -666,6 +682,9 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , + # $`col 04` Code tbl_format_setup(x, width = 45) Output @@ -679,6 +698,9 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , + # $`col 04` Code tbl_format_setup(x, width = 46) Output @@ -692,6 +714,9 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , + # $`col 04` Code tbl_format_setup(x, width = 47) Output @@ -705,6 +730,9 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , + # $`col 04` Code tbl_format_setup(x, width = 48) Output @@ -718,6 +746,9 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , + # $`col 04` Code tbl_format_setup(x, width = 49) Output @@ -731,6 +762,8 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , $`col 04` Code tbl_format_setup(x, width = 50) Output @@ -744,6 +777,8 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , $`col 04` Code tbl_format_setup(x, width = 51) Output @@ -757,6 +792,8 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , $`col 04` Code tbl_format_setup(x, width = 52) Output @@ -770,6 +807,8 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , $`col 04` Code tbl_format_setup(x, width = 53) Output @@ -783,6 +822,8 @@ 2 2.23 b b 3 3.23 c c + # ... with 2 more variables: + # `col 01`$`col 03` , $`col 04` Code tbl_format_setup(x, width = 54) Output @@ -796,6 +837,8 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: + # `col 01`$`col 04` Code tbl_format_setup(x, width = 55) Output @@ -809,6 +852,8 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: + # `col 01`$`col 04` Code tbl_format_setup(x, width = 56) Output @@ -822,6 +867,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 57) Output @@ -835,6 +881,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 58) Output @@ -848,6 +895,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 59) Output @@ -861,6 +909,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 60) Output @@ -874,6 +923,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 61) Output @@ -887,6 +937,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 62) Output @@ -900,6 +951,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 63) Output @@ -913,6 +965,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 64) Output @@ -926,6 +979,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 65) Output @@ -939,6 +993,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 66) Output @@ -952,6 +1007,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 67) Output @@ -965,6 +1021,7 @@ 2 2.23 b B b 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 68) Output @@ -972,12 +1029,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col ~` $`col 03` $`col 04`[,1] `col 05` - - 1 1.23 a A 1 a - 2 2.23 b B 2 b - 3 3.23 c C 3 c + column_zero_zero `col 01`$`col 02` $`col 03` `col 05` + + 1 1.23 a A a + 2 2.23 b B b + 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 69) Output @@ -985,12 +1043,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] `col 05` - - 1 1.23 a A 1 a - 2 2.23 b B 2 b - 3 3.23 c C 3 c + column_zero_zero `col 01`$`col 02` $`col 03` `col 05` + + 1 1.23 a A a + 2 2.23 b B b + 3 3.23 c C c + # ... with 1 more variable: `col 01`$`col 04` Code tbl_format_setup(x, width = 70) Output @@ -998,12 +1057,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] `col 05` - - 1 1.23 a A 1 a - 2 2.23 b B 2 b - 3 3.23 c C 3 c + column_zero_zero `col 01`$`col ~` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 71) Output @@ -1011,12 +1071,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] `col 05` - - 1 1.23 a A 1 a - 2 2.23 b B 2 b - 3 3.23 c C 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 72) Output @@ -1024,12 +1085,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] `col 05` - - 1 1.23 a A 1 a - 2 2.23 b B 2 b - 3 3.23 c C 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 73) Output @@ -1037,12 +1099,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] `col 05` - - 1 1.23 a A 1 a - 2 2.23 b B 2 b - 3 3.23 c C 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 74) Output @@ -1050,12 +1113,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] `col 05` - - 1 1.23 a A 1 a - 2 2.23 b B 2 b - 3 3.23 c C 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 75) Output @@ -1063,12 +1127,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] `col 05` - - 1 1.23 a A 1 4 a - 2 2.23 b B 2 5 b - 3 3.23 c C 3 6 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 76) Output @@ -1076,12 +1141,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] `col 05` - - 1 1.23 a A 1 4 a - 2 2.23 b B 2 5 b - 3 3.23 c C 3 6 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 77) Output @@ -1089,12 +1155,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] `col 05` - - 1 1.23 a A 1 4 a - 2 2.23 b B 2 5 b - 3 3.23 c C 3 6 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 78) Output @@ -1102,12 +1169,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] `col 05` - - 1 1.23 a A 1 4 a - 2 2.23 b B 2 5 b - 3 3.23 c C 3 6 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] `col 05` + + 1 1.23 a A 1 a + 2 2.23 b B 2 b + 3 3.23 c C 3 c + # ... with 1 more variable: `col 01`$`col 04`[2:3] Code tbl_format_setup(x, width = 79) Output @@ -1115,12 +1183,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] `col 05` - - 1 1.23 a A 1 4 a - 2 2.23 b B 2 5 b - 3 3.23 c C 3 6 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] `col 05` + + 1 1.23 a A 1 4 a + 2 2.23 b B 2 5 b + 3 3.23 c C 3 6 c + # ... with 1 more variable: `col 01`$`col 04`[3] Code tbl_format_setup(x, width = 80) Output @@ -1128,12 +1197,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] `col 05` - - 1 1.23 a A 1 4 a - 2 2.23 b B 2 5 b - 3 3.23 c C 3 6 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] `col 05` + + 1 1.23 a A 1 4 a + 2 2.23 b B 2 5 b + 3 3.23 c C 3 6 c + # ... with 1 more variable: `col 01`$`col 04`[3] Code tbl_format_setup(x, width = 81) Output @@ -1141,17 +1211,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] `col 05` + + 1 1.23 a A 1 4 a + 2 2.23 b B 2 5 b + 3 3.23 c C 3 6 c + # ... with 1 more variable: `col 01`$`col 04`[3] Code tbl_format_setup(x, width = 82) Output @@ -1159,17 +1225,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] `col 05` + + 1 1.23 a A 1 4 a + 2 2.23 b B 2 5 b + 3 3.23 c C 3 6 c + # ... with 1 more variable: `col 01`$`col 04`[3] Code tbl_format_setup(x, width = 83) Output @@ -1177,17 +1239,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] `col 05` + + 1 1.23 a A 1 4 a + 2 2.23 b B 2 5 b + 3 3.23 c C 3 6 c + # ... with 1 more variable: `col 01`$`col 04`[3] Code tbl_format_setup(x, width = 84) Output @@ -1195,17 +1253,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] `col 05` + + 1 1.23 a A 1 4 a + 2 2.23 b B 2 5 b + 3 3.23 c C 3 6 c + # ... with 1 more variable: `col 01`$`col 04`[3] Code tbl_format_setup(x, width = 85) Output @@ -1213,17 +1267,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] `col 05` + + 1 1.23 a A 1 4 a + 2 2.23 b B 2 5 b + 3 3.23 c C 3 6 c + # ... with 1 more variable: `col 01`$`col 04`[3] Code tbl_format_setup(x, width = 86) Output @@ -1231,17 +1281,13 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] `col 05` + + 1 1.23 a A 1 4 a + 2 2.23 b B 2 5 b + 3 3.23 c C 3 6 c + # ... with 1 more variable: `col 01`$`col 04`[3] Code tbl_format_setup(x, width = 87) Output @@ -1249,16 +1295,11 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] $[,"C"] `col 05` + + 1 1.23 a A 1 4 7 a + 2 2.23 b B 2 5 8 b + 3 3.23 c C 3 6 9 c Code tbl_format_setup(x, width = 88) @@ -1267,16 +1308,11 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] $[,"C"] `col 05` + + 1 1.23 a A 1 4 7 a + 2 2.23 b B 2 5 8 b + 3 3.23 c C 3 6 9 c Code tbl_format_setup(x, width = 89) @@ -1285,16 +1321,11 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] $[,"C"] `col 05` + + 1 1.23 a A 1 4 7 a + 2 2.23 b B 2 5 8 b + 3 3.23 c C 3 6 9 c Code tbl_format_setup(x, width = Inf) @@ -1303,16 +1334,11 @@ # A data frame: 3 x 3 - column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,1] $[,2] $[,3] - - 1 1.23 a A 1 4 7 - 2 2.23 b B 2 5 8 - 3 3.23 c C 3 6 9 - `col 05` - - 1 a - 2 b - 3 c + column_zero_zero `col 01`$`col 02` $`col 03` $`col 04`[,"A"] $[,"B"] $[,"C"] `col 05` + + 1 1.23 a A 1 4 7 a + 2 2.23 b B 2 5 8 b + 3 3.23 c C 3 6 9 c # tbl_format_setup() results diff --git a/tests/testthat/test-tbl-format-setup.R b/tests/testthat/test-tbl-format-setup.R index 823cd9356..ef736ba82 100644 --- a/tests/testthat/test-tbl-format-setup.R +++ b/tests/testthat/test-tbl-format-setup.R @@ -4,12 +4,13 @@ test_that("output test", { `col 01` = new_tbl(list( `col 02` = letters[1:3], `col 03` = LETTERS[1:3], - `col 04` = matrix(1:9, nrow = 3) + `col 04` = matrix(1:9, nrow = 3, dimnames = list(letters[1:3], LETTERS[1:3])) )), `col 05` = ordered(letters[1:3]) )) expect_snapshot({ + options(width = 100) tbl_format_setup(x, width = 4) tbl_format_setup(x, width = 5) tbl_format_setup(x, width = 6)