diff --git a/NEWS.md b/NEWS.md index 558de0c1e5..db8c004962 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,17 @@ # gt (development version) +## Breaking changes + +* The `extract_body()` function now, by default, will not display columns that have been hidden (e.g., by `cols_hide()` or `cols_merge*()`); the previous behavior can be restored by using `incl_hidden_cols = TRUE`. + ## New features * Creating a caption with `tab_caption()` will now be preserved in Latex output with `as_latex()`. Cross-referencing a table using the internal cross-referencing system of **bookdown** is now enabled for PDF and HTML outputs (for HTML, set `options("htmltools.preserve.raw" = FALSE)`). Quarto users should use the `tbl-cap` and `label` cell options. * PDF output now defaults to a full-width floating environment using `tabular*` (@AronGullickson, #1588). Float position can be controlled by the `latex.tbl.pos` argument in `tab_options`. Quarto users can alternatively use the `tbl-pos` argument to control positioning. To use a `longtable` environment instead, use `tab_option(latex.use_longtable = TRUE)`. +* New arguments have been added to `extract_body()` to better control which columns will be present in the returned data (#1875). (#1889) + * The `locale` argument of `gt()` now defaults to `getOption("gt.locale")` if set (#1894). ## Interactive table support diff --git a/R/extract.R b/R/extract.R index 194725c70b..926beac976 100644 --- a/R/extract.R +++ b/R/extract.R @@ -86,6 +86,25 @@ #' value for `build_stage` then the entire build for the table body (i.e., up #' to and including the `"footnotes_attached"` stage) will be performed before #' returning the data frame. +#' +#' @param incl_hidden_cols *Should hidden columns be included?* +#' +#' `scalar` // *default:* `FALSE` +#' +#' Certain columns may be hidden from final display via [cols_hide()]. By +#' default, those columns won't be part of the extracted data frame. However, +#' we can choose to include them by using `incl_hidden_cols = TRUE`. +#' +#' @param incl_stub_cols *Should stub columns be included?* +#' +#' `scalar` // *default:* `TRUE` +#' +#' Any stub columns in the **gt** object (which may consist of a grouping +#' column and a column for row labels) are included in the extracted data for +#' clarity but clearly marked with the names `"::group_id::"` and +#' `"::rowname::"`. We can exclude them by setting `incl_stub_cols = FALSE`. +#' +#' @inheritParams rlang::args_dots_empty #' #' @param output *Output format* #' @@ -95,6 +114,61 @@ #' `"html"` (the default), `"latex"`, `"rtf"`, or `"word"`. #' #' @return A data frame or tibble object containing the table body. +#' +#' @section Examples: +#' +#' Use a modified version of [`sp500`] the dataset to create a **gt** table with +#' row groups and row labels. Formatting will be applied to the date- and +#' currency-based columns. +#' +#' ```r +#' gt_tbl <- +#' sp500 |> +#' dplyr::filter(date >= "2015-01-05" & date <= "2015-01-16") |> +#' dplyr::arrange(date) |> +#' dplyr::mutate(week = paste0("W", strftime(date, format = "%V"))) |> +#' dplyr::select(-adj_close, -volume) |> +#' gt( +#' rowname_col = "date", +#' groupname_col = "week" +#' ) |> +#' fmt_date(columns = date, date_style = "day_month_year") |> +#' fmt_currency(columns = c(open, high, low, close)) |> +#' cols_hide(columns = c(high, low)) +#' +#' gt_tbl +#' ``` +#' +#' \if{html}{\out{ +#' `r man_get_image_tag(file = "man_extract_body_1.png")` +#' }} +#' +#' Using `extract_body()` on the **gt** object (`gt_tbl`) will provide us with +#' a tibble that contains the fully built data cells for the `output` context +#' (in this case, `"html"`). +#' +#' ```{r} +#' extract_body(gt_tbl) +#' ``` +#' +#' To provide us with a better frame of reference, the grouping and row label +#' values are provided as the first columns in the returned output. We could +#' suppress those in the output by setting `incl_stub_cols = FALSE`. +#' +#' ```{r} +#' extract_body(gt_tbl, incl_stub_cols = FALSE) +#' ``` +#' +#' The `high` and `low` columns were hidden via [`cols_hide()`] and so they +#' won't be shown in the returned data unless we use `incl_hidden_cols = TRUE`. +#' +#' ```{r} +#' extract_body( +#' gt_tbl, +#' incl_stub_cols = FALSE, +#' incl_hidden_cols = TRUE +#' ) +#' ``` #' #' @family table export functions #' @section Function ID: @@ -107,49 +181,156 @@ extract_body <- function( data, build_stage = NULL, + incl_hidden_cols = FALSE, + incl_stub_cols = TRUE, + ..., output = c("html", "latex", "rtf", "word", "grid") ) { # Perform input object validation stop_if_not_gt_tbl(data = data) + # If `build_stage` is given a keyword value, check that value is valid + if (!is.null(build_stage)) { + + rlang::arg_match0( + build_stage, + values = c( + "init", "fmt_applied", "sub_applied", "unfmt_included", "cols_merged", + "body_reassembled", "text_transformed", "footnotes_attached" + ) + ) + } + # Ensure that `output` is matched correctly to one option output <- rlang::arg_match(output) + rlang::check_dots_empty() - data <- dt_body_build(data = data) + # Generate vector of columns to include in output + if (isTRUE(incl_hidden_cols)) { + + boxhead_df <- dt_boxhead_get(data = data) + + included_cols <- + boxhead_df$var[boxhead_df$type %in% c("default", "hidden")] + + } else { + included_cols <- dt_boxhead_get_vars_default(data = data) + } + + # If there are any stub columns, get the column names for that component + group_col <- dt_boxhead_get_vars_groups(data = data) + if (is.na(group_col)) { + group_col <- NULL + } + + rowname_col <- dt_boxhead_get_var_stub(data = data) + if (is.na(rowname_col)) { + rowname_col <- NULL + } + + stub_cols <- c(group_col, rowname_col) + + if (isTRUE(incl_stub_cols)) { + # Add stub columns to `included_cols`, if any are present; and deduplicate + included_cols <- unique(c(stub_cols, included_cols)) + } + + data <- dt_body_build(data = data) + if (identical(build_stage, "init")) { - return(data[["_body"]]) + + out_df <- + assemble_body_extract( + data = data, + included_cols = included_cols, + incl_stub_cols = incl_stub_cols, + group_col = group_col, + rowname_col = rowname_col + ) + + return(out_df) } data <- render_formats(data = data, context = output) if (identical(build_stage, "fmt_applied")) { - return(data[["_body"]]) + + out_df <- + assemble_body_extract( + data = data, + included_cols = included_cols, + incl_stub_cols = incl_stub_cols, + group_col = group_col, + rowname_col = rowname_col + ) + + return(out_df) } data <- render_substitutions(data = data, context = output) if (identical(build_stage, "sub_applied")) { - return(data[["_body"]]) + + out_df <- + assemble_body_extract( + data = data, + included_cols = included_cols, + incl_stub_cols = incl_stub_cols, + group_col = group_col, + rowname_col = rowname_col + ) + + return(out_df) } data <- migrate_unformatted_to_output(data = data, context = output) if (identical(build_stage, "unfmt_included")) { - return(data[["_body"]]) + + out_df <- + assemble_body_extract( + data = data, + included_cols = included_cols, + incl_stub_cols = incl_stub_cols, + group_col = group_col, + rowname_col = rowname_col + ) + + return(out_df) } data <- perform_col_merge(data = data, context = output) if (identical(build_stage, "cols_merged")) { - return(data[["_body"]]) + + out_df <- + assemble_body_extract( + data = data, + included_cols = included_cols, + incl_stub_cols = incl_stub_cols, + group_col = group_col, + rowname_col = rowname_col + ) + + return(out_df) } data <- dt_body_reassemble(data = data) if (identical(build_stage, "body_reassembled")) { - return(data[["_body"]]) + + out_df <- + assemble_body_extract( + data = data, + included_cols = included_cols, + incl_stub_cols = incl_stub_cols, + group_col = group_col, + rowname_col = rowname_col + ) + + return(out_df) } data <- reorder_stub_df(data = data) @@ -159,7 +340,17 @@ extract_body <- function( data <- perform_text_transforms(data = data) if (identical(build_stage, "text_transformed")) { - return(data[["_body"]]) + + out_df <- + assemble_body_extract( + data = data, + included_cols = included_cols, + incl_stub_cols = incl_stub_cols, + group_col = group_col, + rowname_col = rowname_col + ) + + return(out_df) } data <- dt_boxhead_build(data = data, context = output) @@ -173,11 +364,43 @@ extract_body <- function( data <- resolve_footnotes_styles(data = data, tbl_type = "footnotes") data <- apply_footnotes_to_output(data = data, context = output) - if (is.null(build_stage) || identical(build_stage, "footnotes_attached")) { - return(data[["_body"]]) + if (is.null(build_stage) || identical(build_stage, "footnotes_attached")) { + + out_df <- + assemble_body_extract( + data = data, + included_cols = included_cols, + incl_stub_cols = incl_stub_cols, + group_col = group_col, + rowname_col = rowname_col + ) } - data[["_body"]] + out_df +} + +assemble_body_extract <- function( + data, + included_cols, + incl_stub_cols, + group_col, + rowname_col +) { + + out_df <- data[["_body"]][, included_cols] + + if (isTRUE(incl_stub_cols)) { + + if (!is.null(group_col)) { + names(out_df)[names(out_df) == group_col] <- "::group_id::" + } + + if (!is.null(rowname_col)) { + names(out_df)[names(out_df) == rowname_col] <- "::rowname::" + } + } + + out_df } # extract_summary() ------------------------------------------------------------ diff --git a/images/man_extract_body_1.png b/images/man_extract_body_1.png new file mode 100644 index 0000000000..ca3a4eddfb Binary files /dev/null and b/images/man_extract_body_1.png differ diff --git a/man/extract_body.Rd b/man/extract_body.Rd index 3f24108758..e5d980a8d6 100644 --- a/man/extract_body.Rd +++ b/man/extract_body.Rd @@ -7,6 +7,9 @@ extract_body( data, build_stage = NULL, + incl_hidden_cols = FALSE, + incl_stub_cols = TRUE, + ..., output = c("html", "latex", "rtf", "word", "grid") ) } @@ -32,6 +35,25 @@ value for \code{build_stage} then the entire build for the table body (i.e., up to and including the \code{"footnotes_attached"} stage) will be performed before returning the data frame.} +\item{incl_hidden_cols}{\emph{Should hidden columns be included?} + +\verb{scalar} // \emph{default:} \code{FALSE} + +Certain columns may be hidden from final display via \code{\link[=cols_hide]{cols_hide()}}. By +default, those columns won't be part of the extracted data frame. However, +we can choose to include them by using \code{incl_hidden_cols = TRUE}.} + +\item{incl_stub_cols}{\emph{Should stub columns be included?} + +\verb{scalar} // \emph{default:} \code{TRUE} + +Any stub columns in the \strong{gt} object (which may consist of a grouping +column and a column for row labels) are included in the extracted data for +clarity but clearly marked with the names \code{"::group_id::"} and +\code{"::rowname::"}. We can exclude them by setting \code{incl_stub_cols = FALSE}.} + +\item{...}{These dots are for future extensions and must be empty.} + \item{output}{\emph{Output format} \verb{singl-kw:[html|latex|rtf|word]} // \emph{default:} \code{"html"} @@ -81,6 +103,98 @@ apparent. attachment. } } +\section{Examples}{ + + +Use a modified version of \code{\link{sp500}} the dataset to create a \strong{gt} table with +row groups and row labels. Formatting will be applied to the date- and +currency-based columns. + +\if{html}{\out{
}}\preformatted{gt_tbl <- + sp500 |> + dplyr::filter(date >= "2015-01-05" & date <= "2015-01-16") |> + dplyr::arrange(date) |> + dplyr::mutate(week = paste0("W", strftime(date, format = "\%V"))) |> + dplyr::select(-adj_close, -volume) |> + gt( + rowname_col = "date", + groupname_col = "week" + ) |> + fmt_date(columns = date, date_style = "day_month_year") |> + fmt_currency(columns = c(open, high, low, close)) |> + cols_hide(columns = c(high, low)) + +gt_tbl +}\if{html}{\out{
}} + +\if{html}{\out{ +This image of a table was generated from the first code example in the `extract_body()` help file. +}} + +Using \code{extract_body()} on the \strong{gt} object (\code{gt_tbl}) will provide us with +a tibble that contains the fully built data cells for the \code{output} context +(in this case, \code{"html"}). + +\if{html}{\out{
}}\preformatted{extract_body(gt_tbl) +#> # A tibble: 10 x 4 +#> `::group_id::` `::rowname::` open close +#> +#> 1 W02 5 January 2015 $2,054.44 $2,020.58 +#> 2 W02 6 January 2015 $2,022.15 $2,002.61 +#> 3 W02 7 January 2015 $2,005.55 $2,025.90 +#> 4 W02 8 January 2015 $2,030.61 $2,062.14 +#> 5 W02 9 January 2015 $2,063.45 $2,044.81 +#> 6 W03 12 January 2015 $2,046.13 $2,028.26 +#> 7 W03 13 January 2015 $2,031.58 $2,023.03 +#> 8 W03 14 January 2015 $2,018.40 $2,011.27 +#> 9 W03 15 January 2015 $2,013.75 $1,992.67 +#> 10 W03 16 January 2015 $1,992.25 $2,019.42 +}\if{html}{\out{
}} + +To provide us with a better frame of reference, the grouping and row label +values are provided as the first columns in the returned output. We could +suppress those in the output by setting \code{incl_stub_cols = FALSE}. + +\if{html}{\out{
}}\preformatted{extract_body(gt_tbl, incl_stub_cols = FALSE) +#> # A tibble: 10 x 2 +#> open close +#> +#> 1 $2,054.44 $2,020.58 +#> 2 $2,022.15 $2,002.61 +#> 3 $2,005.55 $2,025.90 +#> 4 $2,030.61 $2,062.14 +#> 5 $2,063.45 $2,044.81 +#> 6 $2,046.13 $2,028.26 +#> 7 $2,031.58 $2,023.03 +#> 8 $2,018.40 $2,011.27 +#> 9 $2,013.75 $1,992.67 +#> 10 $1,992.25 $2,019.42 +}\if{html}{\out{
}} + +The \code{high} and \code{low} columns were hidden via \code{\link[=cols_hide]{cols_hide()}} and so they +won't be shown in the returned data unless we use \code{incl_hidden_cols = TRUE}. + +\if{html}{\out{
}}\preformatted{extract_body( + gt_tbl, + incl_stub_cols = FALSE, + incl_hidden_cols = TRUE +) +#> # A tibble: 10 x 4 +#> open high low close +#> +#> 1 $2,054.44 $2,054.44 $2,017.34 $2,020.58 +#> 2 $2,022.15 $2,030.25 $1,992.44 $2,002.61 +#> 3 $2,005.55 $2,029.61 $2,005.55 $2,025.90 +#> 4 $2,030.61 $2,064.08 $2,030.61 $2,062.14 +#> 5 $2,063.45 $2,064.43 $2,038.33 $2,044.81 +#> 6 $2,046.13 $2,049.30 $2,022.58 $2,028.26 +#> 7 $2,031.58 $2,056.93 $2,008.25 $2,023.03 +#> 8 $2,018.40 $2,018.40 $1,988.44 $2,011.27 +#> 9 $2,013.75 $2,021.35 $1,991.47 $1,992.67 +#> 10 $1,992.25 $2,020.46 $1,988.12 $2,019.42 +}\if{html}{\out{
}} +} + \section{Function ID}{ 13-7 diff --git a/tests/testthat/_snaps/extract_body.md b/tests/testthat/_snaps/extract_body.md new file mode 100644 index 0000000000..b0c8187b56 --- /dev/null +++ b/tests/testthat/_snaps/extract_body.md @@ -0,0 +1,544 @@ +# Extraction of the table body works with variation in arguments + + Code + . + Output + # A tibble: 8 x 9 + num char fctr date time datetime currency row group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 0~ 49.950 row_1 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 1~ 17.950 row_2 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 0~ 1.390 row_3 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 1~ 65100.0~ row_4 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 0~ 1325.810 row_5 grp_b + 6 NA fig six 2015-06-15 2018-06-06 1~ 13.255 row_6 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 0~ NA row_7 grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::group_id::` `::rowname::` num char fctr date time datetime currency + + 1 grp_a row_1 1.111e~ apri~ one 2015~ 13:35 2018-01~ 49.950 + 2 grp_a row_2 2.222e~ bana~ two 2015~ 14:40 2018-02~ 17.950 + 3 grp_a row_3 3.333e~ coco~ three 2015~ 15:45 2018-03~ 1.390 + 4 grp_a row_4 4.444e~ duri~ four 2015~ 16:50 2018-04~ 65100.0~ + 5 grp_b row_5 5.550e~ five 2015~ 17:55 2018-05~ 1325.810 + 6 grp_b row_6 NA fig six 2015~ 2018-06~ 13.255 + 7 grp_b row_7 7.770e~ grap~ seven 19:10 2018-07~ NA + 8 grp_b row_8 8.880e~ hone~ eight 2015~ 20:20 0.440 + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::rowname::` num char fctr date time datetime currency group + + 1 row_1 1.111e-01 apricot one 2015-0~ 13:35 2018-01~ 49.950 grp_a + 2 row_2 2.222e+00 banana two 2015-0~ 14:40 2018-02~ 17.950 grp_a + 3 row_3 3.333e+01 coconut three 2015-0~ 15:45 2018-03~ 1.390 grp_a + 4 row_4 4.444e+02 durian four 2015-0~ 16:50 2018-04~ 65100.0~ grp_a + 5 row_5 5.550e+03 five 2015-0~ 17:55 2018-05~ 1325.810 grp_b + 6 row_6 NA fig six 2015-0~ 2018-06~ 13.255 grp_b + 7 row_7 7.770e+05 grapefruit seven 19:10 2018-07~ NA grp_b + 8 row_8 8.880e+06 honeydew eight 2015-0~ 20:20 0.440 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::group_id::` num char fctr date time datetime currency row + + 1 grp_a 1.111e-01 apricot one 2015-~ 13:35 2018-01~ 49.950 row_1 + 2 grp_a 2.222e+00 banana two 2015-~ 14:40 2018-02~ 17.950 row_2 + 3 grp_a 3.333e+01 coconut three 2015-~ 15:45 2018-03~ 1.390 row_3 + 4 grp_a 4.444e+02 durian four 2015-~ 16:50 2018-04~ 65100.0~ row_4 + 5 grp_b 5.550e+03 five 2015-~ 17:55 2018-05~ 1325.810 row_5 + 6 grp_b NA fig six 2015-~ 2018-06~ 13.255 row_6 + 7 grp_b 7.770e+05 grapefruit seven 19:10 2018-07~ NA row_7 + 8 grp_b 8.880e+06 honeydew eight 2015-~ 20:20 0.440 row_8 + +--- + + Code + . + Output + # A tibble: 8 x 7 + num char fctr time currency row group + + 1 1.111e-01 apricot one 13:35 49.950 row_1 grp_a + 2 2.222e+00 banana two 14:40 17.950 row_2 grp_a + 3 3.333e+01 coconut three 15:45 1.390 row_3 grp_a + 4 4.444e+02 durian four 16:50 65100.000 row_4 grp_a + 5 5.550e+03 five 17:55 1325.810 row_5 grp_b + 6 NA fig six 13.255 row_6 grp_b + 7 7.770e+05 grapefruit seven 19:10 NA row_7 grp_b + 8 8.880e+06 honeydew eight 20:20 0.440 row_8 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 7 + `::group_id::` `::rowname::` num char fctr time currency + + 1 grp_a row_1 1.111e-01 apricot one 13:35 49.950 + 2 grp_a row_2 2.222e+00 banana two 14:40 17.950 + 3 grp_a row_3 3.333e+01 coconut three 15:45 1.390 + 4 grp_a row_4 4.444e+02 durian four 16:50 65100.000 + 5 grp_b row_5 5.550e+03 five 17:55 1325.810 + 6 grp_b row_6 NA fig six 13.255 + 7 grp_b row_7 7.770e+05 grapefruit seven 19:10 NA + 8 grp_b row_8 8.880e+06 honeydew eight 20:20 0.440 + +--- + + Code + . + Output + # A tibble: 8 x 7 + `::rowname::` num char fctr time currency group + + 1 row_1 1.111e-01 apricot one 13:35 49.950 grp_a + 2 row_2 2.222e+00 banana two 14:40 17.950 grp_a + 3 row_3 3.333e+01 coconut three 15:45 1.390 grp_a + 4 row_4 4.444e+02 durian four 16:50 65100.000 grp_a + 5 row_5 5.550e+03 five 17:55 1325.810 grp_b + 6 row_6 NA fig six 13.255 grp_b + 7 row_7 7.770e+05 grapefruit seven 19:10 NA grp_b + 8 row_8 8.880e+06 honeydew eight 20:20 0.440 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 7 + `::group_id::` num char fctr time currency row + + 1 grp_a 1.111e-01 apricot one 13:35 49.950 row_1 + 2 grp_a 2.222e+00 banana two 14:40 17.950 row_2 + 3 grp_a 3.333e+01 coconut three 15:45 1.390 row_3 + 4 grp_a 4.444e+02 durian four 16:50 65100.000 row_4 + 5 grp_b 5.550e+03 five 17:55 1325.810 row_5 + 6 grp_b NA fig six 13.255 row_6 + 7 grp_b 7.770e+05 grapefruit seven 19:10 NA row_7 + 8 grp_b 8.880e+06 honeydew eight 20:20 0.440 row_8 + +--- + + Code + . + Output + # A tibble: 8 x 9 + num char fctr date time datetime currency row group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 0~ 49.950 row_1 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 1~ 17.950 row_2 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 0~ 1.390 row_3 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 1~ 65100.0~ row_4 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 0~ 1325.810 row_5 grp_b + 6 NA fig six 2015-06-15 2018-06-06 1~ 13.255 row_6 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 0~ NA row_7 grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 7 + num char fctr date time datetime currency + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 + +--- + + Code + . + Output + # A tibble: 8 x 8 + num char fctr date time datetime currency group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 grp_b + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 8 + num char fctr date time datetime currency row + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 row_1 + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 row_2 + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 row_3 + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 row_4 + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 row_5 + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 row_6 + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA row_7 + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 + +--- + + Code + . + Output + # A tibble: 8 x 7 + num char fctr time currency row group + + 1 1.111e-01 apricot one 13:35 49.950 row_1 grp_a + 2 2.222e+00 banana two 14:40 17.950 row_2 grp_a + 3 3.333e+01 coconut three 15:45 1.390 row_3 grp_a + 4 4.444e+02 durian four 16:50 65100.000 row_4 grp_a + 5 5.550e+03 five 17:55 1325.810 row_5 grp_b + 6 NA fig six 13.255 row_6 grp_b + 7 7.770e+05 grapefruit seven 19:10 NA row_7 grp_b + 8 8.880e+06 honeydew eight 20:20 0.440 row_8 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 5 + num char fctr time currency + + 1 1.111e-01 apricot one 13:35 49.950 + 2 2.222e+00 banana two 14:40 17.950 + 3 3.333e+01 coconut three 15:45 1.390 + 4 4.444e+02 durian four 16:50 65100.000 + 5 5.550e+03 five 17:55 1325.810 + 6 NA fig six 13.255 + 7 7.770e+05 grapefruit seven 19:10 NA + 8 8.880e+06 honeydew eight 20:20 0.440 + +--- + + Code + . + Output + # A tibble: 8 x 6 + num char fctr time currency group + + 1 1.111e-01 apricot one 13:35 49.950 grp_a + 2 2.222e+00 banana two 14:40 17.950 grp_a + 3 3.333e+01 coconut three 15:45 1.390 grp_a + 4 4.444e+02 durian four 16:50 65100.000 grp_a + 5 5.550e+03 five 17:55 1325.810 grp_b + 6 NA fig six 13.255 grp_b + 7 7.770e+05 grapefruit seven 19:10 NA grp_b + 8 8.880e+06 honeydew eight 20:20 0.440 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 6 + num char fctr time currency row + + 1 1.111e-01 apricot one 13:35 49.950 row_1 + 2 2.222e+00 banana two 14:40 17.950 row_2 + 3 3.333e+01 coconut three 15:45 1.390 row_3 + 4 4.444e+02 durian four 16:50 65100.000 row_4 + 5 5.550e+03 five 17:55 1325.810 row_5 + 6 NA fig six 13.255 row_6 + 7 7.770e+05 grapefruit seven 19:10 NA row_7 + 8 8.880e+06 honeydew eight 20:20 0.440 row_8 + +--- + + Code + . + Output + # A tibble: 8 x 9 + num char fctr date time datetime currency row group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 0~ 49.950 row_1 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 1~ 17.950 row_2 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 0~ 1.390 row_3 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 1~ 65100.0~ row_4 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 0~ 1325.810 row_5 grp_b + 6 NA fig six 2015-06-15 2018-06-06 1~ 13.255 row_6 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 0~ NA row_7 grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::group_id::` `::rowname::` num char fctr date time datetime currency + + 1 grp_a row_1 1.111e~ apri~ one 2015~ 13:35 2018-01~ 49.950 + 2 grp_a row_2 2.222e~ bana~ two 2015~ 14:40 2018-02~ 17.950 + 3 grp_a row_3 3.333e~ coco~ three 2015~ 15:45 2018-03~ 1.390 + 4 grp_a row_4 4.444e~ duri~ four 2015~ 16:50 2018-04~ 65100.0~ + 5 grp_b row_5 5.550e~ five 2015~ 17:55 2018-05~ 1325.810 + 6 grp_b row_6 NA fig six 2015~ 2018-06~ 13.255 + 7 grp_b row_7 7.770e~ grap~ seven 19:10 2018-07~ NA + 8 grp_b row_8 8.880e~ hone~ eight 2015~ 20:20 0.440 + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::rowname::` num char fctr date time datetime currency group + + 1 row_1 1.111e-01 apricot one 2015-0~ 13:35 2018-01~ 49.950 grp_a + 2 row_2 2.222e+00 banana two 2015-0~ 14:40 2018-02~ 17.950 grp_a + 3 row_3 3.333e+01 coconut three 2015-0~ 15:45 2018-03~ 1.390 grp_a + 4 row_4 4.444e+02 durian four 2015-0~ 16:50 2018-04~ 65100.0~ grp_a + 5 row_5 5.550e+03 five 2015-0~ 17:55 2018-05~ 1325.810 grp_b + 6 row_6 NA fig six 2015-0~ 2018-06~ 13.255 grp_b + 7 row_7 7.770e+05 grapefruit seven 19:10 2018-07~ NA grp_b + 8 row_8 8.880e+06 honeydew eight 2015-0~ 20:20 0.440 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::group_id::` num char fctr date time datetime currency row + + 1 grp_a 1.111e-01 apricot one 2015-~ 13:35 2018-01~ 49.950 row_1 + 2 grp_a 2.222e+00 banana two 2015-~ 14:40 2018-02~ 17.950 row_2 + 3 grp_a 3.333e+01 coconut three 2015-~ 15:45 2018-03~ 1.390 row_3 + 4 grp_a 4.444e+02 durian four 2015-~ 16:50 2018-04~ 65100.0~ row_4 + 5 grp_b 5.550e+03 five 2015-~ 17:55 2018-05~ 1325.810 row_5 + 6 grp_b NA fig six 2015-~ 2018-06~ 13.255 row_6 + 7 grp_b 7.770e+05 grapefruit seven 19:10 2018-07~ NA row_7 + 8 grp_b 8.880e+06 honeydew eight 2015-~ 20:20 0.440 row_8 + +--- + + Code + . + Output + # A tibble: 8 x 9 + num char fctr date time datetime currency row group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 0~ 49.950 row_1 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 1~ 17.950 row_2 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 0~ 1.390 row_3 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 1~ 65100.0~ row_4 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 0~ 1325.810 row_5 grp_b + 6 NA fig six 2015-06-15 2018-06-06 1~ 13.255 row_6 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 0~ NA row_7 grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::group_id::` `::rowname::` num char fctr date time datetime currency + + 1 grp_a row_1 1.111e~ apri~ one 2015~ 13:35 2018-01~ 49.950 + 2 grp_a row_2 2.222e~ bana~ two 2015~ 14:40 2018-02~ 17.950 + 3 grp_a row_3 3.333e~ coco~ three 2015~ 15:45 2018-03~ 1.390 + 4 grp_a row_4 4.444e~ duri~ four 2015~ 16:50 2018-04~ 65100.0~ + 5 grp_b row_5 5.550e~ five 2015~ 17:55 2018-05~ 1325.810 + 6 grp_b row_6 NA fig six 2015~ 2018-06~ 13.255 + 7 grp_b row_7 7.770e~ grap~ seven 19:10 2018-07~ NA + 8 grp_b row_8 8.880e~ hone~ eight 2015~ 20:20 0.440 + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::rowname::` num char fctr date time datetime currency group + + 1 row_1 1.111e-01 apricot one 2015-0~ 13:35 2018-01~ 49.950 grp_a + 2 row_2 2.222e+00 banana two 2015-0~ 14:40 2018-02~ 17.950 grp_a + 3 row_3 3.333e+01 coconut three 2015-0~ 15:45 2018-03~ 1.390 grp_a + 4 row_4 4.444e+02 durian four 2015-0~ 16:50 2018-04~ 65100.0~ grp_a + 5 row_5 5.550e+03 five 2015-0~ 17:55 2018-05~ 1325.810 grp_b + 6 row_6 NA fig six 2015-0~ 2018-06~ 13.255 grp_b + 7 row_7 7.770e+05 grapefruit seven 19:10 2018-07~ NA grp_b + 8 row_8 8.880e+06 honeydew eight 2015-0~ 20:20 0.440 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 9 + `::group_id::` num char fctr date time datetime currency row + + 1 grp_a 1.111e-01 apricot one 2015-~ 13:35 2018-01~ 49.950 row_1 + 2 grp_a 2.222e+00 banana two 2015-~ 14:40 2018-02~ 17.950 row_2 + 3 grp_a 3.333e+01 coconut three 2015-~ 15:45 2018-03~ 1.390 row_3 + 4 grp_a 4.444e+02 durian four 2015-~ 16:50 2018-04~ 65100.0~ row_4 + 5 grp_b 5.550e+03 five 2015-~ 17:55 2018-05~ 1325.810 row_5 + 6 grp_b NA fig six 2015-~ 2018-06~ 13.255 row_6 + 7 grp_b 7.770e+05 grapefruit seven 19:10 2018-07~ NA row_7 + 8 grp_b 8.880e+06 honeydew eight 2015-~ 20:20 0.440 row_8 + +--- + + Code + . + Output + # A tibble: 8 x 9 + num char fctr date time datetime currency row group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 0~ 49.950 row_1 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 1~ 17.950 row_2 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 0~ 1.390 row_3 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 1~ 65100.0~ row_4 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 0~ 1325.810 row_5 grp_b + 6 NA fig six 2015-06-15 2018-06-06 1~ 13.255 row_6 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 0~ NA row_7 grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 7 + num char fctr date time datetime currency + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 + +--- + + Code + . + Output + # A tibble: 8 x 8 + num char fctr date time datetime currency group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 grp_b + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 8 + num char fctr date time datetime currency row + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 row_1 + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 row_2 + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 row_3 + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 row_4 + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 row_5 + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 row_6 + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA row_7 + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 + +--- + + Code + . + Output + # A tibble: 8 x 9 + num char fctr date time datetime currency row group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 0~ 49.950 row_1 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 1~ 17.950 row_2 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 0~ 1.390 row_3 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 1~ 65100.0~ row_4 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 0~ 1325.810 row_5 grp_b + 6 NA fig six 2015-06-15 2018-06-06 1~ 13.255 row_6 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 0~ NA row_7 grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 7 + num char fctr date time datetime currency + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 + +--- + + Code + . + Output + # A tibble: 8 x 8 + num char fctr date time datetime currency group + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 grp_a + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 grp_a + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 grp_a + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 grp_a + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 grp_b + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 grp_b + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA grp_b + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 grp_b + +--- + + Code + . + Output + # A tibble: 8 x 8 + num char fctr date time datetime currency row + + 1 1.111e-01 apricot one 2015-01-15 13:35 2018-01-01 02:22 49.950 row_1 + 2 2.222e+00 banana two 2015-02-15 14:40 2018-02-02 14:33 17.950 row_2 + 3 3.333e+01 coconut three 2015-03-15 15:45 2018-03-03 03:44 1.390 row_3 + 4 4.444e+02 durian four 2015-04-15 16:50 2018-04-04 15:55 65100.000 row_4 + 5 5.550e+03 five 2015-05-15 17:55 2018-05-05 04:00 1325.810 row_5 + 6 NA fig six 2015-06-15 2018-06-06 16:11 13.255 row_6 + 7 7.770e+05 grapefruit seven 19:10 2018-07-07 05:22 NA row_7 + 8 8.880e+06 honeydew eight 2015-08-15 20:20 0.440 row_8 + diff --git a/tests/testthat/test-extract_body.R b/tests/testthat/test-extract_body.R index db65f0babe..61ee5eccea 100644 --- a/tests/testthat/test-extract_body.R +++ b/tests/testthat/test-extract_body.R @@ -56,8 +56,10 @@ test_that("Extraction of the table body works well", { expect_true(all(is.na(tbl_body_1_1 %>% unlist() %>% unname()))) expect_named( tbl_body_1_1, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) tbl_body_1_2 <- gt_tbl_1 %>% extract_body(build_stage = "fmt_applied") @@ -103,16 +105,16 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_1_2, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) tbl_body_1_3 <- gt_tbl_1 %>% extract_body(build_stage = "sub_applied") expect_true(all(is.na(tbl_body_1_3[["labels"]]))) expect_true(all(is.na(tbl_body_1_3[["num_2"]]))) expect_true(all(is.na(tbl_body_1_3[["ltr_1"]]))) - expect_true(all(is.na(tbl_body_1_3[["ltr_2"]]))) - expect_true(all(is.na(tbl_body_1_3[["ltr_3"]]))) expect_true(all(is.na(tbl_body_1_3[["group"]]))) expect_equal( tbl_body_1_3[["num_1"]], @@ -151,15 +153,15 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_1_3, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) tbl_body_1_4 <- gt_tbl_1 %>% extract_body(build_stage = "unfmt_included") expect_equal(tbl_body_1_4[["labels"]], tbl[["labels"]]) expect_equal(tbl_body_1_4[["ltr_1"]], tbl[["ltr_1"]]) - expect_equal(tbl_body_1_4[["ltr_2"]], tbl[["ltr_2"]]) - expect_equal(tbl_body_1_4[["ltr_3"]], tbl[["ltr_3"]]) expect_equal( tbl_body_1_4[["num_1"]], c("int:0", "int:74", "NA", "int:0", "big", "int:0", "int:84") @@ -201,14 +203,14 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_1_4, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) tbl_body_1_5 <- gt_tbl_1 %>% extract_body(build_stage = "cols_merged") expect_equal(tbl_body_1_5[["labels"]], tbl[["labels"]]) - expect_equal(tbl_body_1_5[["ltr_2"]], tbl[["ltr_2"]]) - expect_equal(tbl_body_1_5[["ltr_3"]], tbl[["ltr_3"]]) expect_equal( tbl_body_1_5[["num_1"]], c("int:0", "int:74", "NA", "int:0", "big", "int:0", "int:84") @@ -254,14 +256,14 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_1_5, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) tbl_body_1_6 <- gt_tbl_1 %>% extract_body(build_stage = "body_reassembled") expect_equal(tbl_body_1_6[["labels"]], tbl[["labels"]]) - expect_equal(tbl_body_1_6[["ltr_2"]], tbl[["ltr_2"]]) - expect_equal(tbl_body_1_6[["ltr_3"]], tbl[["ltr_3"]]) expect_equal( tbl_body_1_6[["num_1"]], c("int:0", "int:74", "NA", "int:0", "big", "int:0", "int:84") @@ -307,14 +309,14 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_1_6, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) tbl_body_1_7 <- gt_tbl_1 %>% extract_body(build_stage = "text_transformed") expect_equal(tbl_body_1_7[["labels"]], tbl[["labels"]]) - expect_equal(tbl_body_1_7[["ltr_2"]], tbl[["ltr_2"]]) - expect_equal(tbl_body_1_7[["ltr_3"]], tbl[["ltr_3"]]) expect_equal( tbl_body_1_7[["num_1"]], c("int:0", "int:74", "NA", "int:0", "big", "int:0", "int:84 _84") @@ -360,8 +362,10 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_1_7, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) tbl_body_1_8 <- gt_tbl_1 %>% extract_body(build_stage = "footnotes_attached") @@ -373,8 +377,6 @@ test_that("Extraction of the table body works well", { "C", "D", "E", "F", "G" ) ) - expect_equal(tbl_body_1_8[["ltr_2"]], tbl[["ltr_2"]]) - expect_equal(tbl_body_1_8[["ltr_3"]], tbl[["ltr_3"]]) expect_equal( tbl_body_1_8[["num_1"]], c("int:0", "int:74", "NA", "int:0", "big", "int:0", "int:84 _84") @@ -427,8 +429,10 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_1_8, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) tbl_body_1_8_b <- gt_tbl_1 %>% extract_body() @@ -440,8 +444,6 @@ test_that("Extraction of the table body works well", { "C", "D", "E", "F", "G" ) ) - expect_equal(tbl_body_1_8_b[["ltr_2"]], tbl[["ltr_2"]]) - expect_equal(tbl_body_1_8_b[["ltr_3"]], tbl[["ltr_3"]]) expect_equal( tbl_body_1_8_b[["num_1"]], c("int:0", "int:74", "NA", "int:0", "big", "int:0", "int:84 _84") @@ -494,12 +496,14 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_1_8_b, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "labels", "num_1", "num_2", "int_1", "int_2", + "sci_2", "ltr_1", "group", "sci_1" + ) ) - # Create a similar gt table to the first, this time using row groups - # and a stub + # Create a similar gt table to the first, this time using + # row groups and a stub gt_tbl_2 <- tbl %>% gt(rowname_col = "labels", groupname_col = "group") %>% @@ -539,17 +543,15 @@ test_that("Extraction of the table body works well", { expect_true(all(is.na(tbl_body_2_1 %>% unlist() %>% unname()))) expect_named( tbl_body_2_1, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "::group_id::", "::rowname::", "num_1", "num_2", + "int_1", "int_2", "sci_2", "ltr_1", "sci_1" + ) ) tbl_body_2_2 <- gt_tbl_2 %>% extract_body(build_stage = "fmt_applied") - expect_true(all(is.na(tbl_body_2_2[["labels"]]))) expect_true(all(is.na(tbl_body_2_2[["num_2"]]))) expect_true(all(is.na(tbl_body_2_2[["ltr_1"]]))) - expect_true(all(is.na(tbl_body_2_2[["ltr_2"]]))) - expect_true(all(is.na(tbl_body_2_2[["ltr_3"]]))) - expect_true(all(is.na(tbl_body_2_2[["group"]]))) expect_equal( tbl_body_2_2[["num_1"]], c("int:0", "int:74", NA, "int:0", "int:500", "int:0", "int:84") @@ -586,17 +588,15 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_2_2, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "::group_id::", "::rowname::", "num_1", "num_2", + "int_1", "int_2", "sci_2", "ltr_1", "sci_1" + ) ) tbl_body_2_3 <- gt_tbl_2 %>% extract_body(build_stage = "sub_applied") - expect_true(all(is.na(tbl_body_2_3[["labels"]]))) expect_true(all(is.na(tbl_body_2_3[["num_2"]]))) expect_true(all(is.na(tbl_body_2_3[["ltr_1"]]))) - expect_true(all(is.na(tbl_body_2_3[["ltr_2"]]))) - expect_true(all(is.na(tbl_body_2_3[["ltr_3"]]))) - expect_true(all(is.na(tbl_body_2_3[["group"]]))) expect_equal( tbl_body_2_3[["num_1"]], c("int:0", "int:74", NA, "int:0", "big", "int:0", "int:84") @@ -634,15 +634,14 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_2_3, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "::group_id::", "::rowname::", "num_1", "num_2", + "int_1", "int_2", "sci_2", "ltr_1", "sci_1" + ) ) tbl_body_2_4 <- gt_tbl_2 %>% extract_body(build_stage = "unfmt_included") - expect_equal(tbl_body_2_4[["labels"]], tbl[["labels"]]) expect_equal(tbl_body_2_4[["ltr_1"]], tbl[["ltr_1"]]) - expect_equal(tbl_body_2_4[["ltr_2"]], tbl[["ltr_2"]]) - expect_equal(tbl_body_2_4[["ltr_3"]], tbl[["ltr_3"]]) expect_equal( tbl_body_2_4[["num_1"]], c("int:0", "int:74", "NA", "int:0", "big", "int:0", "int:84") @@ -684,14 +683,13 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_2_4, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "::group_id::", "::rowname::", "num_1", "num_2", + "int_1", "int_2", "sci_2", "ltr_1", "sci_1" + ) ) tbl_body_2_5 <- gt_tbl_2 %>% extract_body(build_stage = "cols_merged") - expect_equal(tbl_body_2_5[["labels"]], tbl[["labels"]]) - expect_equal(tbl_body_2_5[["ltr_2"]], tbl[["ltr_2"]]) - expect_equal(tbl_body_2_5[["ltr_3"]], tbl[["ltr_3"]]) expect_equal( tbl_body_2_5[["num_1"]], c("int:0", "int:74", "NA", "int:0", "big", "int:0", "int:84") @@ -737,23 +735,13 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_2_5, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "::group_id::", "::rowname::", "num_1", "num_2", + "int_1", "int_2", "sci_2", "ltr_1", "sci_1" + ) ) tbl_body_2_6 <- gt_tbl_2 %>% extract_body(build_stage = "body_reassembled") - expect_equal( - tbl_body_2_6[["labels"]], - c("A", "B", "E", "G", "C", "D", "F") - ) - expect_equal( - tbl_body_2_6[["ltr_2"]], - c("a", "b", "e", "g", "c", "d", "f") - ) - expect_equal( - tbl_body_2_6[["ltr_3"]], - c("a", "b", "e", "g", "c", "d", "f") - ) expect_equal( tbl_body_2_6[["num_1"]], c("int:0", "int:74", "big", "int:84", "NA", "int:0", "int:0") @@ -798,23 +786,13 @@ test_that("Extraction of the table body works well", { ) expect_equal( colnames(tbl_body_2_6), - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "::group_id::", "::rowname::", "num_1", "num_2", + "int_1", "int_2", "sci_2", "ltr_1", "sci_1" + ) ) tbl_body_2_7 <- gt_tbl_2 %>% extract_body(build_stage = "text_transformed") - expect_equal( - tbl_body_2_7[["labels"]], - c("A", "B", "E", "G", "C", "D", "F") - ) - expect_equal( - tbl_body_2_7[["ltr_2"]], - c("a", "b", "e", "g", "c", "d", "f") - ) - expect_equal( - tbl_body_2_7[["ltr_3"]], - c("a", "b", "e", "g", "c", "d", "f") - ) expect_equal( tbl_body_2_7[["num_1"]], c("int:0", "int:74", "big", "int:84 _84", "NA", "int:0", "int:0") @@ -859,23 +837,13 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_2_7, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "::group_id::", "::rowname::", "num_1", "num_2", + "int_1", "int_2", "sci_2", "ltr_1", "sci_1" + ) ) tbl_body_2_8 <- gt_tbl_2 %>% extract_body(build_stage = "footnotes_attached") - expect_equal( - tbl_body_2_8[["labels"]], - c("A", "B", "E", "G", "C", "D", "F") - ) - expect_equal( - tbl_body_2_8[["ltr_2"]], - c("a", "b", "e", "g", "c", "d", "f") - ) - expect_equal( - tbl_body_2_8[["ltr_3"]], - c("a", "b", "e", "g", "c", "d", "f") - ) expect_equal( tbl_body_2_8[["num_1"]], c("int:0", "int:74", "big", "int:84 _84", "NA", "int:0", "int:0") @@ -927,7 +895,236 @@ test_that("Extraction of the table body works well", { ) expect_named( tbl_body_2_8, - c("labels", "num_1", "num_2", "int_1", "int_2", "sci_2", "ltr_1", - "ltr_2", "ltr_3", "group", "sci_1") + c( + "::group_id::", "::rowname::", "num_1", "num_2", + "int_1", "int_2", "sci_2", "ltr_1", "sci_1" + ) ) }) + +test_that("Extraction of the table body works with variation in arguments", { + + # + # Inclusion of stub, don't show hidden columns + # + + # Extract body from simple table + exibble %>% + gt() %>% + extract_body() %>% + expect_snapshot() + + # Extract body from table with row labels and row groups + exibble %>% + gt(rowname_col = "row", groupname_col = "group") %>% + extract_body() %>% + expect_snapshot() + + # Extract body from table with row labels + exibble %>% + gt(rowname_col = "row") %>% + extract_body() %>% + expect_snapshot() + + # Extract body from table with row groups + exibble %>% + gt(groupname_col = "group") %>% + extract_body() %>% + expect_snapshot() + + # w/ hidden columns: Extract body from simple table with hidden columns + exibble %>% + gt() %>% + cols_hide(columns = matches("date")) %>% + extract_body() %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row labels and row groups + exibble %>% + gt(rowname_col = "row", groupname_col = "group") %>% + cols_hide(columns = matches("date")) %>% + extract_body() %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row labels + exibble %>% + gt(rowname_col = "row") %>% + cols_hide(columns = matches("date")) %>% + extract_body() %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row groups + exibble %>% + gt(groupname_col = "group") %>% + cols_hide(columns = matches("date")) %>% + extract_body() %>% + expect_snapshot() + + # + # Exclude display of stub columns, don't show hidden columns + # + + # Extract body from simple table + exibble %>% + gt() %>% + extract_body(incl_stub_cols = FALSE) %>% + expect_snapshot() + + # Extract body from table with row labels and row groups (don't include stub) + exibble %>% + gt(rowname_col = "row", groupname_col = "group") %>% + extract_body(incl_stub_cols = FALSE) %>% + expect_snapshot() + + # Extract body from table with row labels (don't include stub) + exibble %>% + gt(rowname_col = "row") %>% + extract_body(incl_stub_cols = FALSE) %>% + expect_snapshot() + + # Extract body from table with row groups (don't include stub) + exibble %>% + gt(groupname_col = "group") %>% + extract_body(incl_stub_cols = FALSE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from simple table with hidden columns + exibble %>% + gt() %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_stub_cols = FALSE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row labels and row groups + exibble %>% + gt(rowname_col = "row", groupname_col = "group") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_stub_cols = FALSE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row labels + exibble %>% + gt(rowname_col = "row") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_stub_cols = FALSE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row groups + exibble %>% + gt(groupname_col = "group") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_stub_cols = FALSE) %>% + expect_snapshot() + + # + # Inclusion of stub, *show all* hidden columns + # + + # Extract body from simple table + exibble %>% + gt() %>% + extract_body(incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # Extract body from table with row labels and row groups + exibble %>% + gt(rowname_col = "row", groupname_col = "group") %>% + extract_body(incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # Extract body from table with row labels + exibble %>% + gt(rowname_col = "row") %>% + extract_body(incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # Extract body from table with row groups + exibble %>% + gt(groupname_col = "group") %>% + extract_body(incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from simple table with hidden columns + exibble %>% + gt() %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row labels and row groups + exibble %>% + gt(rowname_col = "row", groupname_col = "group") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row labels + exibble %>% + gt(rowname_col = "row") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row groups + exibble %>% + gt(groupname_col = "group") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # + # Exclude display of stub columns, *show all* hidden columns + # + + # Extract body from simple table + exibble %>% + gt() %>% + extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # Extract body from table with row labels and row groups (don't include stub) + exibble %>% + gt(rowname_col = "row", groupname_col = "group") %>% + extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # Extract body from table with row labels (don't include stub) + exibble %>% + gt(rowname_col = "row") %>% + extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # Extract body from table with row groups (don't include stub) + exibble %>% + gt(groupname_col = "group") %>% + extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from simple table with hidden columns + exibble %>% + gt() %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row labels and row groups + exibble %>% + gt(rowname_col = "row", groupname_col = "group") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row labels + exibble %>% + gt(rowname_col = "row") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>% + expect_snapshot() + + # w/ hidden columns: Extract body from table with row groups + exibble %>% + gt(groupname_col = "group") %>% + cols_hide(columns = matches("date")) %>% + extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>% + expect_snapshot() +}) \ No newline at end of file