From d72a1c3038acf9c669c220b46e2212aac8f5db15 Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 6 Aug 2024 09:14:12 -0400 Subject: [PATCH 1/3] Don't use tibble for storing styles --- R/dt_footnotes.R | 4 ++-- R/dt_styles.R | 4 ++-- tests/testthat/test-tab_footnote.R | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/dt_footnotes.R b/R/dt_footnotes.R index 0d729f5bb8..fd470408d2 100644 --- a/R/dt_footnotes.R +++ b/R/dt_footnotes.R @@ -35,7 +35,7 @@ dt_footnotes_set <- function(data, footnotes) { dt_footnotes_init <- function(data) { footnotes_df <- - dplyr::tibble( + vctrs::data_frame( locname = character(0L), grpname = character(0L), colname = character(0L), @@ -69,7 +69,7 @@ dt_footnotes_add <- function( ) result <- - dplyr::tibble( + vctrs::data_frame( locname = locname, grpname = grid$grpname, colname = grid$colname, diff --git a/R/dt_styles.R b/R/dt_styles.R index b861c22d7e..cd59913e57 100644 --- a/R/dt_styles.R +++ b/R/dt_styles.R @@ -35,7 +35,7 @@ dt_styles_set <- function(data, styles) { dt_styles_init <- function(data) { styles_tbl <- - dplyr::tibble( + vctrs::data_frame( locname = character(0L), grpname = character(0L), colname = character(0L), @@ -67,7 +67,7 @@ dt_styles_add <- function( ) result <- - dplyr::tibble( + vctrs::data_frame( locname = locname, grpname = grid$grpname, colname = grid$colname, diff --git a/tests/testthat/test-tab_footnote.R b/tests/testthat/test-tab_footnote.R index 7a6c9419f1..b7d68cd6d2 100644 --- a/tests/testthat/test-tab_footnote.R +++ b/tests/testthat/test-tab_footnote.R @@ -619,7 +619,7 @@ test_that("The footnotes table is structured correctly", { # Expect that the `footnotes_resolved` object inherits # from `tbl_df` - expect_s3_class(footnotes_tbl, "tbl_df") + expect_s3_class(footnotes_tbl, "data.frame") # Expect that there are specific column names in # this tibble @@ -654,7 +654,7 @@ test_that("The footnotes table is structured correctly", { # Expect that the `footnotes_resolved` object inherits # from `tbl_df` - expect_s3_class(footnotes_tbl, "tbl_df") + expect_s3_class(footnotes_tbl, "data.frame") # Expect that there are specific column names in # this tibble From e21cde3c73c642f1c105972a835fe9a4c072725c Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 6 Aug 2024 09:14:44 -0400 Subject: [PATCH 2/3] Refactor tests for footnotes --- tests/testthat/test-tab_footnote.R | 561 +++++++++++++---------------- 1 file changed, 257 insertions(+), 304 deletions(-) diff --git a/tests/testthat/test-tab_footnote.R b/tests/testthat/test-tab_footnote.R index b7d68cd6d2..5719f5365e 100644 --- a/tests/testthat/test-tab_footnote.R +++ b/tests/testthat/test-tab_footnote.R @@ -46,124 +46,12 @@ data <- ) ) -# Create a table from `gtcars` that has footnotes -# in the column spanner labels and in the column labels -data_2 <- - gtcars %>% - dplyr::filter(ctry_origin == "Germany") %>% - dplyr::group_by(mfr) %>% - dplyr::top_n(n = 2, msrp) %>% - dplyr::ungroup() %>% - dplyr::select(mfr, model, drivetrain, msrp) %>% - gt() %>% - tab_spanner( - label = "make and model", - id = "mm", - columns = c(mfr, model) - ) %>% - tab_spanner( - label = "specs and pricing", - id = "sp", - columns = c(drivetrain, msrp) - ) %>% - tab_footnote( - footnote = "Prices in USD.", - locations = cells_column_labels(columns = msrp) - ) %>% - tab_footnote( - footnote = "AWD = All Wheel Drive, RWD = Rear Wheel Drive.", - locations = cells_column_labels(columns = drivetrain) - ) %>% - tab_footnote( - footnote = "The most important details.", - locations = cells_column_spanners(spanners = "sp") - ) %>% - tab_footnote( - footnote = "German cars only.", - locations = cells_column_spanners(spanners = "mm") - ) - -# Create a table from `gtcars` that has footnotes -# in group summary and grand summary cells -data_3 <- - gtcars %>% - dplyr::filter(ctry_origin == "Germany") %>% - dplyr::group_by(mfr) %>% - dplyr::top_n(3, msrp) %>% - dplyr::ungroup() %>% - dplyr::select(mfr, model, drivetrain, msrp) %>% - gt(rowname_col = "model", groupname_col = "mfr") %>% - summary_rows( - groups = c("BMW", "Audi"), - columns = "msrp", - fns = list( - ~mean(., na.rm = TRUE), - ~min(., na.rm = TRUE) - ) - ) %>% - grand_summary_rows( - columns = "msrp", - fns = list( - ~min(., na.rm = TRUE), - ~max(., na.rm = TRUE) - ) - ) %>% - tab_footnote( - footnote = "Average price for BMW and Audi.", - locations = cells_summary( - groups = c("BMW", "Audi"), - columns = "msrp", - rows = starts_with("me") - ) - ) %>% - tab_footnote( - footnote = "Maximum price across all cars.", - locations = cells_grand_summary( - columns = "msrp", - rows = starts_with("ma") - ) - ) %>% - tab_footnote( - footnote = "Minimum price across all cars.", - locations = cells_grand_summary( - columns = "msrp", - rows = starts_with("mi") - ) - ) - -# Create a table from `sp500` that has footnotes -# in the title and the subtitle cells -data_4 <- - sp500 %>% - dplyr::filter( - date >= "2015-01-05", - date <= "2015-01-10" - ) %>% - dplyr::select(-c(adj_close, volume, high, low)) %>% - gt() %>% - tab_header( - title = "S&P 500", - subtitle = "Open and Close Values" - ) %>% - tab_footnote( - footnote = "All values in USD.", - locations = list(cells_title(groups = "subtitle")) - ) %>% - tab_footnote( - footnote = "Standard and Poor 500.", - locations = list(cells_title(groups = "title")) - ) - # Function to skip tests if Suggested packages not available on system check_suggests <- function() { skip_if_not_installed("rvest") } -test_that("tab_footnote() works correctly", { - - # Check that specific suggested packages are available - check_suggests() - +test_that("tab_footnote() works correctly for in the stub and column labels", { # Apply a footnote to the column labels and stub cells tab <- tab_footnote( @@ -198,23 +86,22 @@ test_that("tab_footnote() works correctly", { locations = cells_stub(rows = "Merc 240D") ) - # Expect that the internal `footnotes_df` data frame will have - # a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_equal(nrow(footnotes_df), 1) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "stub", NA_character_, NA_character_, "5", "8", - NA_character_, "Stub cell footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "stub", NA_character_, NA_character_, "5", "8", + NA_character_, "Stub cell footnote.", "auto" ) + ) +}) + +test_that("tab_footnote() works with cells_title()", { # Apply a footnote to the table title tab <- @@ -224,23 +111,19 @@ test_that("tab_footnote() works correctly", { locations = cells_title(groups = "title") ) - # Expect that the internal `footnotes_df` data frame will have - # a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "title", NA_character_, NA_character_, "1", NA_character_, - NA_character_, "Title footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "title", NA_character_, NA_character_, "1", NA_character_, + NA_character_, "Title footnote.", "auto" ) + ) # Apply a footnote to the table subtitle tab <- @@ -250,23 +133,22 @@ test_that("tab_footnote() works correctly", { locations = cells_title(groups = "subtitle") ) - # Expect that the internal `footnotes_df` data frame will have - # a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "subtitle", NA_character_, NA_character_, "2", NA_character_, - NA_character_, "Subtitle footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "subtitle", NA_character_, NA_character_, "2", NA_character_, + NA_character_, "Subtitle footnote.", "auto" ) + ) +}) + +test_that("tab_footnote() works with in the stubhead", { # Apply a footnote to the stubhead label tab <- @@ -276,23 +158,23 @@ test_that("tab_footnote() works correctly", { locations = cells_stubhead() ) - # Expect that the internal `footnotes_df` data frame will have + # Expect that the internal `footnotes_df` data frame has 1 row # a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "stubhead", NA_character_, NA_character_, "2.5", NA_character_, - NA_character_, "Stubhead label footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "stubhead", NA_character_, NA_character_, "2.5", NA_character_, + NA_character_, "Stubhead label footnote.", "auto" ) + ) +}) + +test_that("tab_footnote() works for summary location", { # Apply a footnote to a single cell in a group summary section tab <- @@ -303,23 +185,19 @@ test_that("tab_footnote() works correctly", { groups = "Mercs", columns = "hp", rows = 2) ) - # Expect that the internal `footnotes_df` data frame will have - # a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "summary_cells", "Mercs", "hp", "5", "2", NA_character_, - "Summary cell footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "summary_cells", "Mercs", "hp", "5", "2", NA_character_, + "Summary cell footnote.", "auto" ) + ) # Apply a footnote to a single cell in a grand # summary section @@ -332,24 +210,19 @@ test_that("tab_footnote() works correctly", { ) ) - # Expect that the internal `footnotes_df` data frame - # will have a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "grand_summary_cells", "::GRAND_SUMMARY", "wt", "6", "2", - NA_character_, "Grand summary cell footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "grand_summary_cells", "::GRAND_SUMMARY", "wt", "6", "2", + NA_character_, "Grand summary cell footnote.", "auto" ) - + ) # Apply a footnote to a single cell in a group # summary section, and, to a single cell in a grand @@ -369,11 +242,9 @@ test_that("tab_footnote() works correctly", { ) ) - # Expect that the internal `footnotes_df` data frame - # will have two rows - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(2) + # Expect that the internal `footnotes_df` data frame has 2 rows + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 2L) # Expect certain values for each of the columns in the # double-row `footnotes_df` data frame @@ -388,6 +259,9 @@ test_that("tab_footnote() works correctly", { "auto", "auto" ) ) +}) + +test_that("tab_footnote() works in row groups", { # Apply a footnote to the `Mazdas` row group cell tab <- @@ -397,23 +271,22 @@ test_that("tab_footnote() works correctly", { locations = cells_row_groups(groups = "Mazdas") ) - # Expect that the internal `footnotes_df` data frame - # will have a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "row_groups", "Mazdas", NA_character_, "5", NA_character_, - NA_character_, "Group cell footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "row_groups", "Mazdas", NA_character_, "5", NA_character_, + NA_character_, "Group cell footnote.", "auto" ) + ) +}) + +test_that("tab_footnote() works with spanners", { # Apply a footnote to the `gear_carb_cyl` column spanner cell tab <- @@ -423,23 +296,22 @@ test_that("tab_footnote() works correctly", { locations = cells_column_spanners(spanners = "gcc") ) - # Expect that the internal `footnotes_df` data frame will have - # a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "columns_groups", "gcc", NA_character_, "3", NA_character_, - NA_character_, "Column group footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "columns_groups", "gcc", NA_character_, "3", NA_character_, + NA_character_, "Column group footnote.", "auto" ) + ) +}) + +test_that("tab_footnote() works with cells_column_labels()", { # Apply a footnote to a single column label tab <- @@ -449,23 +321,22 @@ test_that("tab_footnote() works correctly", { locations = cells_column_labels(columns = "gear") ) - # Expect that the internal `footnotes_df` data frame will have - # a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "columns_columns", NA_character_, "gear", "4", NA_character_, - NA_character_, "Single column label footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "columns_columns", NA_character_, "gear", "4", NA_character_, + NA_character_, "Single column label footnote.", "auto" ) + ) +}) + +test_that("tab_footnote() works with cells_body()", { # Apply a footnote to five rows of a single column tab <- @@ -475,35 +346,22 @@ test_that("tab_footnote() works correctly", { locations = cells_body(columns = "hp", rows = 1:5) ) - # Expect that the internal `footnotes_df` data frame will have five rows - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(5) + # Expect that the internal `footnotes_df` data frame has 5 rows + footnotes_df <- dt_footnotes_get(data = tab) + expect_equal(nrow(footnotes_df), 5) # Expect that the `rownum` values in `footnotes_df` will be 1:5 - dt_footnotes_get(data = tab) %>% - dplyr::pull(rownum) %>% - expect_equal(1:5) + expect_equal(footnotes_df$rownum, 1:5) # Expect that the `text` in `footnotes_df` will be the same for # all five rows - dt_footnotes_get(data = tab) %>% - dplyr::pull(footnotes) %>% - unlist() %>% - unique() %>% - expect_equal("Five rows footnote.") + expect_setequal(unlist(footnotes_df$footnotes), "Five rows footnote.") # Expect that the `location` in `footnotes_df` is 'data' for all five rows - dt_footnotes_get(data = tab) %>% - dplyr::pull(locname) %>% - unique() %>% - expect_equal("data") + expect_setequal(footnotes_df$locname, "data") # Expect that the `colname` in `footnotes_df` is 'hp' for all five rows - dt_footnotes_get(data = tab) %>% - dplyr::pull(colname) %>% - unique() %>% - expect_equal("hp") + expect_setequal(footnotes_df$colname, "hp") # Apply a footnote to a single data cell; this time, use `c()` # to specify the `rows` @@ -514,23 +372,19 @@ test_that("tab_footnote() works correctly", { locations = cells_body(columns = "disp", rows = c("Mazda RX4")) ) - # Expect that the internal `footnotes_df` data frame will have - # a single row - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(1) + # Expect that the internal `footnotes_df` data frame has 1 row + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 1L) # Expect certain values for each of the columns in the # single-row `footnotes_df` data frame - dt_footnotes_get(data = tab) %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "data", NA_character_, "disp", "5", "1", - NA_character_, "A footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df, use.names = FALSE), + c( + "data", NA_character_, "disp", "5", "1", + NA_character_, "A footnote.", "auto" ) + ) # Apply a footnote to a single data cell; this time, use `c()` # to specify the `columns` @@ -542,52 +396,82 @@ test_that("tab_footnote() works correctly", { ) # Expect that the internal `footnotes_df` data frame will have two rows - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(2) + footnotes_df <- dt_footnotes_get(data = tab) + expect_identical(nrow(footnotes_df), 2L) # Expect certain values for each of the columns in the two rows # of the `footnotes_df` data frame - dt_footnotes_get(data = tab)[1, ] %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "data", NA_character_, "disp", "5", "1", - NA_character_, "A footnote.", "auto" - ) + expect_equal( + unlist(footnotes_df[1, ], use.names = FALSE), + c( + "data", NA_character_, "disp", "5", "1", + NA_character_, "A footnote.", "auto" ) + ) + expect_equal( + unlist(footnotes_df[2, ], use.names = FALSE), + c( + "data", NA_character_, "hp", "5", "1", + NA_character_, "A footnote.", "auto" + ) + ) +}) - dt_footnotes_get(data = tab)[2, ] %>% - unlist() %>% - unname() %>% - expect_equal( - c( - "data", NA_character_, "hp", "5", "1", - NA_character_, "A footnote.", "auto" - ) +test_that("tab_footnote() produces the correct output.", { + # Create a table from `gtcars` that has footnotes + # in the column spanner labels and in the column labels + data_2 <- + gtcars %>% + dplyr::filter(ctry_origin == "Germany") %>% + dplyr::slice_max(n = 2, msrp, by = mfr) %>% + dplyr::select(mfr, model, drivetrain, msrp) %>% + gt() %>% + tab_spanner( + label = "make and model", + id = "mm", + columns = c(mfr, model) + ) %>% + tab_spanner( + label = "specs and pricing", + id = "sp", + columns = c(drivetrain, msrp) + ) %>% + tab_footnote( + footnote = "Prices in USD.", + locations = cells_column_labels(columns = msrp) + ) %>% + tab_footnote( + footnote = "AWD = All Wheel Drive, RWD = Rear Wheel Drive.", + locations = cells_column_labels(columns = drivetrain) + ) %>% + tab_footnote( + footnote = "The most important details.", + locations = cells_column_spanners(spanners = "sp") + ) %>% + tab_footnote( + footnote = "German cars only.", + locations = cells_column_spanners(spanners = "mm") ) - # Use the `data_2` gt table as `tab` - tab <- data_2 + # Check that specific suggested packages are available + check_suggests() # Expect that the internal `footnotes_df` data frame # will have four rows - dt_footnotes_get(data = tab) %>% - nrow() %>% - expect_equal(4) + footnotes_df <- dt_footnotes_get(data_2) + expect_identical(nrow(footnotes_df), 4L) # Expect that the internal `footnotes_df` data frame will have # its `locname` column entirely populated with `columns_columns` # and `columns_groups` - dt_footnotes_get(data = tab) %>% - dplyr::pull(locname) %>% - unique() %>% - expect_equal(c("columns_columns", "columns_groups")) + expect_setequal( + footnotes_df$locname, + c("columns_columns", "columns_groups") + ) # Create a `tbl_html` object from the `tab` object tbl_html <- - tab %>% + data_2 %>% render_as_html() %>% xml2::read_html() @@ -614,6 +498,51 @@ test_that("tab_footnote() works correctly", { test_that("The footnotes table is structured correctly", { + # Create a table from `gtcars` that has footnotes + # in group summary and grand summary cells + data_3 <- + gtcars %>% + dplyr::filter(ctry_origin == "Germany") %>% + dplyr::slice_max(n = 3, msrp, by = mfr) %>% + dplyr::select(mfr, model, drivetrain, msrp) %>% + gt(rowname_col = "model", groupname_col = "mfr") %>% + summary_rows( + groups = c("BMW", "Audi"), + columns = "msrp", + fns = list( + ~mean(., na.rm = TRUE), + ~min(., na.rm = TRUE) + ) + ) %>% + grand_summary_rows( + columns = "msrp", + fns = list( + ~min(., na.rm = TRUE), + ~max(., na.rm = TRUE) + ) + ) %>% + tab_footnote( + footnote = "Average price for BMW and Audi.", + locations = cells_summary( + groups = c("BMW", "Audi"), + columns = "msrp", + rows = starts_with("me") + ) + ) %>% + tab_footnote( + footnote = "Maximum price across all cars.", + locations = cells_grand_summary( + columns = "msrp", + rows = starts_with("ma") + ) + ) %>% + tab_footnote( + footnote = "Minimum price across all cars.", + locations = cells_grand_summary( + columns = "msrp", + rows = starts_with("mi") + ) + ) # Extract `footnotes_resolved` and `list_of_summaries` footnotes_tbl <- dt_footnotes_get(data = data_3) @@ -623,8 +552,8 @@ test_that("The footnotes table is structured correctly", { # Expect that there are specific column names in # this tibble - expect_equal( - colnames(footnotes_tbl), + expect_named( + footnotes_tbl, c("locname", "grpname", "colname", "locnum", "rownum", "colnum", "footnotes", "placement") ) @@ -649,6 +578,32 @@ test_that("The footnotes table is structured correctly", { ) expect_equal(footnotes_tbl$placement, rep("auto", 4)) +}) + +test_that("tab_footnote() produces the correct output.", { + # Create a table from `sp500` that has footnotes + # in the title and the subtitle cells + data_4 <- + sp500 %>% + dplyr::filter( + date >= "2015-01-05", + date <= "2015-01-10" + ) %>% + dplyr::select(-c(adj_close, volume, high, low)) %>% + gt() %>% + tab_header( + title = "S&P 500", + subtitle = "Open and Close Values" + ) %>% + tab_footnote( + footnote = "All values in USD.", + locations = list(cells_title(groups = "subtitle")) + ) %>% + tab_footnote( + footnote = "Standard and Poor 500.", + locations = list(cells_title(groups = "title")) + ) + # Extract `footnotes_resolved` footnotes_tbl <- dt_footnotes_get(data = data_4) @@ -658,8 +613,8 @@ test_that("The footnotes table is structured correctly", { # Expect that there are specific column names in # this tibble - expect_equal( - colnames(footnotes_tbl), + expect_named( + footnotes_tbl, c( "locname", "grpname", "colname", "locnum", "rownum", "colnum", "footnotes", "placement" @@ -704,9 +659,7 @@ test_that("The `list_of_summaries` table is structured correctly", { gtcars_built <- gtcars %>% dplyr::filter(ctry_origin == "Germany") %>% - dplyr::group_by(mfr) %>% - dplyr::top_n(3, msrp) %>% - dplyr::ungroup() %>% + dplyr::slice_max(n = 3, msrp, by = mfr) %>% dplyr::select(mfr, model, drivetrain, msrp) %>% gt(rowname_col = "model", groupname_col = "mfr") %>% summary_rows( From 007571cd5cba88899d405494b02cbd221c5451cf Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 6 Aug 2024 09:20:12 -0400 Subject: [PATCH 3/3] Refactor footnote creation to use `.by` inside `mutate()` --- NEWS.md | 2 + R/z_utils_render_footnotes.R | 104 +++++++++++++++++++---------------- 2 files changed, 58 insertions(+), 48 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8edfc5ff2d..7517dd7524 100644 --- a/NEWS.md +++ b/NEWS.md @@ -37,6 +37,8 @@ * Improve the centering of the stubhead label in Latex when `row_group_as_column = TRUE` and the width of the row name column is specified (@kbrevoort, #1804). +* Performance improvement for footnote rendering (@olivroy, #1818). + # gt 0.11.0 ## New features diff --git a/R/z_utils_render_footnotes.R b/R/z_utils_render_footnotes.R index 87c132b548..0a4a283bc0 100644 --- a/R/z_utils_render_footnotes.R +++ b/R/z_utils_render_footnotes.R @@ -307,9 +307,7 @@ resolve_footnotes_styles <- function(data, tbl_type) { if (nrow(spanner_label_df) > 0L) { tmp <- tbl - tmp$colnum <- NULL - tmp$colname <- NULL - tmp$rownum <- NULL + tmp[ c("colnum", "colname", "rownum")] <- NULL tmp <- tmp[tmp$locname == "columns_groups", ] tbl_column_spanner_cells <- @@ -375,8 +373,11 @@ resolve_footnotes_styles <- function(data, tbl_type) { if (tbl_type == "styles" && nrow(tbl) > 0L) { tbl <- - dplyr::group_by(tbl, locname, grpname, colname, locnum, rownum, colnum) %>% - dplyr::summarize(styles = list(as_style(styles)), .groups = "drop") + dplyr::summarize( + tbl, + styles = list(as_style(styles)), + .by = c("locname", "grpname", "colname", "locnum", "rownum", "colnum") + ) } if (tbl_type == "footnotes") { @@ -411,9 +412,7 @@ set_footnote_marks_columns <- function(data, context = "html") { footnotes_columns_group_marks <- footnotes_columns_groups_tbl %>% - dplyr::group_by(grpname) %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ",")) %>% - dplyr::ungroup() %>% + dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "grpname") %>% dplyr::distinct(grpname, fs_id_coalesced) for (i in seq_len(nrow(footnotes_columns_group_marks))) { @@ -467,9 +466,7 @@ set_footnote_marks_columns <- function(data, context = "html") { footnotes_columns_column_marks <- footnotes_columns_columns_tbl %>% dplyr::filter(locname == "columns_columns") %>% - dplyr::group_by(colname) %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ",")) %>% - dplyr::ungroup() %>% + dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "colname") %>% dplyr::distinct(colname, fs_id_coalesced) for (i in seq_len(nrow(footnotes_columns_column_marks))) { @@ -519,9 +516,7 @@ set_footnote_marks_stubhead <- function(data, context = "html") { footnotes_stubhead_marks <- footnotes_tbl %>% - dplyr::group_by(grpname) %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ",")) %>% - dplyr::ungroup() %>% + dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ","), .by = "grpname") %>% dplyr::distinct(grpname, fs_id_coalesced) %>% dplyr::pull(fs_id_coalesced) @@ -562,26 +557,27 @@ apply_footnotes_to_output <- function(data, context = "html") { boxhead_var_stub <- dt_boxhead_get_var_stub(data = data) - footnotes_tbl_data[ - which(is.na(footnotes_tbl_data$colname)), "colname" - ] <- boxhead_var_stub + footnotes_tbl_data$colname[is.na(footnotes_tbl_data$colname)] <- + boxhead_var_stub } footnotes_data_marks <- - footnotes_tbl_data %>% - dplyr::group_by(rownum, colnum) %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ",")) %>% - dplyr::ungroup() %>% - dplyr::distinct(colname, rownum, locname, placement, fs_id_coalesced) + dplyr::mutate( + footnotes_tbl_data, + fs_id_coalesced = paste(fs_id, collapse = ","), + .by = c("rownum", "colnum") + ) + footnotes_data_marks <- + dplyr::distinct(footnotes_data_marks, colname, rownum, locname, placement, fs_id_coalesced) for (i in seq_len(nrow(footnotes_data_marks))) { text <- body[[footnotes_data_marks$rownum[i], footnotes_data_marks$colname[i]]] - colname <- dplyr::pull(footnotes_data_marks[i, ], "colname") - rownum <- dplyr::pull(footnotes_data_marks[i, ], "rownum") - placement <- dplyr::pull(footnotes_data_marks[i, ], "placement") + colname <- footnotes_data_marks[i, "colname", drop = TRUE] + rownum <- footnotes_data_marks[i, "rownum", drop = TRUE] + placement <- footnotes_data_marks[i, "placement", drop = TRUE] footnote_placement <- resolve_footnote_placement( @@ -604,7 +600,7 @@ apply_footnotes_to_output <- function(data, context = "html") { # Footnote placement on the right of the cell text if (context == "html" && endsWith(text, "

\n")) { - + # FIXME possibly the place where we could fix #1773 text <- paste0( gsub("

\n", "", text, fixed = TRUE), @@ -657,11 +653,13 @@ set_footnote_marks_row_groups <- function(data, context = "html") { if (nrow(footnotes_row_groups_tbl) > 0) { footnotes_row_groups_marks <- - footnotes_row_groups_tbl %>% - dplyr::group_by(grpname) %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ",")) %>% - dplyr::ungroup() %>% - dplyr::distinct(grpname, fs_id_coalesced) + dplyr::mutate( + footnotes_row_groups_tbl, + fs_id_coalesced = paste(fs_id, collapse = ","), + .by = "grpname" + ) + # will only remain + footnotes_row_groups_marks <- dplyr::distinct(footnotes_row_groups_marks, fs_id_coalesced, grpname) for (i in seq_len(nrow(footnotes_row_groups_marks))) { @@ -692,23 +690,29 @@ apply_footnotes_to_summary <- function(data, context = "html") { list_of_summaries <- dt_summary_df_get(data = data) footnotes_tbl <- dt_footnotes_get(data = data) - + # dplyr::coalesce() + footnotes_tbl$colname[is.na(footnotes_tbl$colname)] <- "rowname" summary_df_list <- list_of_summaries$summary_df_display_list if ("summary_cells" %in% footnotes_tbl$locname) { - footnotes_tbl_data <- footnotes_tbl[footnotes_tbl$locname == "summary_cells", ] + footnotes_tbl_data <- vctrs::vec_slice( + footnotes_tbl, + footnotes_tbl$locname == "summary_cells" + ) + + footnotes_tbl_data$row <- round((footnotes_tbl_data$rownum - floor(footnotes_tbl_data$rownum)) * 100, 0) + footnotes_tbl_data$row <- as.integer(footnotes_tbl_data$row) footnotes_data_marks <- - footnotes_tbl_data %>% dplyr::mutate( - row = as.integer(round((rownum - floor(rownum)) * 100, 0)), - colname = ifelse(is.na(colname), "rowname", colname) - ) %>% - dplyr::group_by(grpname, row, colnum) %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ",")) %>% - dplyr::ungroup() %>% - dplyr::distinct(grpname, colname, row, fs_id_coalesced) + footnotes_tbl_data, + fs_id_coalesced = paste(fs_id, collapse = ","), + .by = c("grpname", "row", "colnum"), + ) + + footnotes_data_marks <- + dplyr::distinct(footnotes_data_marks, grpname, colname, row, fs_id_coalesced) for (i in seq_len(nrow(footnotes_data_marks))) { @@ -730,15 +734,19 @@ apply_footnotes_to_summary <- function(data, context = "html") { if ("grand_summary_cells" %in% footnotes_tbl$locname) { footnotes_tbl_data <- - footnotes_tbl[footnotes_tbl$locname == "grand_summary_cells", ] + vctrs::vec_slice( + footnotes_tbl, + footnotes_tbl$locname == "grand_summary_cells" + ) footnotes_data_marks <- - footnotes_tbl_data %>% - dplyr::mutate(colname = ifelse(is.na(colname), "rowname", colname)) %>% - dplyr::group_by(rownum, colnum) %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ",")) %>% - dplyr::ungroup() %>% - dplyr::distinct(colname, rownum, fs_id_coalesced) + dplyr::mutate( + footnotes_tbl_data, + fs_id_coalesced = paste(fs_id, collapse = ","), + .by = c("rownum", "colnum") + ) + + footnotes_data_marks <- dplyr::distinct(footnotes_data_marks, colname, rownum, fs_id_coalesced) for (i in seq_len(nrow(footnotes_data_marks))) {