From e8c90106170155b8787fdb2c2be4ac37641c1daf Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 19 Jul 2024 12:23:38 -0400 Subject: [PATCH 01/16] Refactor test of footnotes --- tests/testthat/test-tab_footnote.R | 553 +++++++++++++---------------- 1 file changed, 253 insertions(+), 300 deletions(-) diff --git a/tests/testthat/test-tab_footnote.R b/tests/testthat/test-tab_footnote.R index 657fee30c8..241cae4692 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( + 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 7d3cbe723f6453364ee8b917da7ee3ee09f20613 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 19 Jul 2024 12:24:37 -0400 Subject: [PATCH 02/16] Store footnote information in data.frame --- 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 241cae4692..cb1feffafb 100644 --- a/tests/testthat/test-tab_footnote.R +++ b/tests/testthat/test-tab_footnote.R @@ -548,7 +548,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 @@ -609,7 +609,7 @@ test_that("tab_footnote() produces the correct output.", { # 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 3c4fde2ed8f511ea795ff0897942c1835d9885d4 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 19 Jul 2024 12:27:08 -0400 Subject: [PATCH 03/16] Refactor footnote resolve to use less dplyr and less group_by() and take advantage of faster `.by --- R/z_utils_render_footnotes.R | 77 +++++++++++++++++++----------------- 1 file changed, 40 insertions(+), 37 deletions(-) diff --git a/R/z_utils_render_footnotes.R b/R/z_utils_render_footnotes.R index edb67a8056..0fa13f840f 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(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) @@ -569,9 +564,10 @@ apply_footnotes_to_output <- function(data, context = "html") { footnotes_data_marks <- footnotes_tbl_data %>% - dplyr::group_by(rownum, colnum) %>% - dplyr::mutate(fs_id_coalesced = paste(fs_id, collapse = ",")) %>% - dplyr::ungroup() %>% + dplyr::mutate( + fs_id_coalesced = paste(fs_id, collapse = ","), + .by = c("rownum", "colnum") + ) %>% dplyr::distinct(colname, rownum, locname, placement, fs_id_coalesced) for (i in seq_len(nrow(footnotes_data_marks))) { @@ -579,9 +575,9 @@ apply_footnotes_to_output <- function(data, context = "html") { 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" && grepl("

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

\n", "", text, fixed = TRUE), @@ -692,23 +688,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))) { @@ -733,12 +735,13 @@ apply_footnotes_to_summary <- function(data, context = "html") { 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))) { From 2530e20f1b42dc2a772a943daf3eba6ef181d176 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 19 Jul 2024 12:39:05 -0400 Subject: [PATCH 04/16] Refactor the rendering of footnotes to use `.by` instead of `group_by()` --- R/z_utils_render_footnotes.R | 29 +++++++++++++++++------------ 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/R/z_utils_render_footnotes.R b/R/z_utils_render_footnotes.R index 0fa13f840f..8dcc8d3a74 100644 --- a/R/z_utils_render_footnotes.R +++ b/R/z_utils_render_footnotes.R @@ -557,18 +557,18 @@ 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::mutate( + footnotes_tbl_data, fs_id_coalesced = paste(fs_id, collapse = ","), .by = c("rownum", "colnum") - ) %>% - dplyr::distinct(colname, rownum, locname, placement, fs_id_coalesced) + ) + footnotes_data_marks <- + dplyr::distinct(footnotes_data_marks, colname, rownum, locname, placement, fs_id_coalesced) for (i in seq_len(nrow(footnotes_data_marks))) { @@ -653,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))) { @@ -732,7 +734,10 @@ 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 <- dplyr::mutate( From 0fadc00982148c382f7c72a51d5651228f1f1143 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 19 Jul 2024 12:44:07 -0400 Subject: [PATCH 05/16] Fix typo + avoid superseded dplyr fns in vignette --- R/tab_options.R | 2 +- man/grp_options.Rd | 2 +- man/tab_options.Rd | 2 +- vignettes/gt-datasets.Rmd | 4 +--- 4 files changed, 4 insertions(+), 6 deletions(-) diff --git a/R/tab_options.R b/R/tab_options.R index a97ea3bcb5..95055a58ee 100644 --- a/R/tab_options.R +++ b/R/tab_options.R @@ -105,7 +105,7 @@ #' elements: `heading.title`, `heading.subtitle`, `column_labels`, #' `row_group`, `footnotes`, and `source_notes`. Can be specified as a #' single-length character vector with units of pixels (e.g., `12px`) or as a -#' percentage (e.g., `80\%`). If provided as a single-length numeric vector, +#' percentage (e.g., `80%`). If provided as a single-length numeric vector, #' it is assumed that the value is given in units of pixels. The [px()] and #' [pct()] helper functions can also be used to pass in numeric values and #' obtain values as pixel or percentage units. diff --git a/man/grp_options.Rd b/man/grp_options.Rd index f131b996b4..7fc360c78b 100644 --- a/man/grp_options.Rd +++ b/man/grp_options.Rd @@ -257,7 +257,7 @@ The font sizes for the parent text element \code{table} and the following child elements: \code{heading.title}, \code{heading.subtitle}, \code{column_labels}, \code{row_group}, \code{footnotes}, and \code{source_notes}. Can be specified as a single-length character vector with units of pixels (e.g., \verb{12px}) or as a -percentage (e.g., \verb{80\\\%}). If provided as a single-length numeric vector, +percentage (e.g., \verb{80\%}). If provided as a single-length numeric vector, it is assumed that the value is given in units of pixels. The \code{\link[=px]{px()}} and \code{\link[=pct]{pct()}} helper functions can also be used to pass in numeric values and obtain values as pixel or percentage units.} diff --git a/man/tab_options.Rd b/man/tab_options.Rd index bb7f2337c8..eedce1f8f6 100644 --- a/man/tab_options.Rd +++ b/man/tab_options.Rd @@ -261,7 +261,7 @@ The font sizes for the parent text element \code{table} and the following child elements: \code{heading.title}, \code{heading.subtitle}, \code{column_labels}, \code{row_group}, \code{footnotes}, and \code{source_notes}. Can be specified as a single-length character vector with units of pixels (e.g., \verb{12px}) or as a -percentage (e.g., \verb{80\\\%}). If provided as a single-length numeric vector, +percentage (e.g., \verb{80\%}). If provided as a single-length numeric vector, it is assumed that the value is given in units of pixels. The \code{\link[=px]{px()}} and \code{\link[=pct]{pct()}} helper functions can also be used to pass in numeric values and obtain values as pixel or percentage units.} diff --git a/vignettes/gt-datasets.Rmd b/vignettes/gt-datasets.Rmd index 5dfcb9cb62..c780e8ae29 100644 --- a/vignettes/gt-datasets.Rmd +++ b/vignettes/gt-datasets.Rmd @@ -235,9 +235,7 @@ The table that we'll create from `gtcars` will meet these requirements: # Create a gt table based on a preprocessed `gtcars` gtcars |> filter(ctry_origin == "Germany") |> - group_by(mfr) |> - top_n(n = 2, msrp) |> - ungroup() |> + slice_max(n = 2, msrp, by = mfr) |> select(mfr, model, drivetrain, msrp) |> gt() |> tab_header(title = "Select German Automobiles") |> From 62ba432337e13ea8000407af9f3dbe61ab1a48d7 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 19 Jul 2024 12:55:50 -0400 Subject: [PATCH 06/16] Add seed to vignette + update visual tests --- pkgdown/assets/gt-latex.pdf | Bin 25198 -> 25445 bytes pkgdown/assets/gt-latex.tex | 40 +++++++++++++++++++++++++++++------ vignettes/gt-interactive.qmd | 13 ++++++++---- vignettes/gt-visual.qmd | 2 ++ 4 files changed, 45 insertions(+), 10 deletions(-) diff --git a/pkgdown/assets/gt-latex.pdf b/pkgdown/assets/gt-latex.pdf index ee24ce62e478f879a20781d7a172d28b7814dc5f..042fda515b50f3a73c743e582337fd14796dfeb8 100644 GIT binary patch delta 9559 zcmai)MNpj$u(U~Vhv4q+4ncxD1b27WaB$ur!Tk{21Hs+hA-KD{9NeAzE&j#5tA96B z)isN$>dn)A-v4QT@KZbwz{kraB7)@p!_Csv5y@-iOncmEl^vz?g5mb_G<9M=HTk7! zx0Xp0S_`V+oMY`Q+Sv=4w7iz%&_s2;Eg!a&J!A;!DdPE&%H6r$_4-f==E?KmJ|((x z@5vkVVrwlDa0QoX8EOK8-xW@ep@U4Fo_9KD{W;3)@`zPW>4?SzGNYCp<8`ICr90P- zBhj*=mxsZY8%;Q0XEv)vT3%{i>_jdOpr*pbsY5^itSiJHr+ZU~sLP=)$&MQYH8%XNmZj>~@YX_%d4mI*T#|tWN%${f}%e!HR zLL3y#FuaFFkVMu6T-aArcYacdHeFGA>T6w{{{}i6vbp*kK z)zWI#^c^#yZcI&PS8GCq9az11`XJcE3YUW6RpS>?J5TA&?q1kqri|kxTlV2{`7R)f zbx6Nag)(sVZ}kgB@!h1!vErMc!scg%!{}ClVYLj)mUie9Afqg3V6RVr>4Ju&+Ts&N zfNwQHdmgc4qF=w3TafosMsSOW%!AEm&7g z1LFFpUKI+ZNyRc6mT%S0O!BUra5s4O+K5CPI|HwGa(kpoxC0gubVmA2O(z{I+Pg`9 zUif<2QA#}K!x@tYXtk)HpYTVeyx4jOKeJg}tmfH&04xieSJAPufmn16U~XD~j1p$THu1?d+Ltb%W?GVX|q=23K%{Utt|hs+MR z5Sg(BG$~T&Av#F|;1QMbIg!5Z_Veu*fa8BV!Z1PAKA0V2X!8yGp_wCcP|Hy)MEMwF z0W@}R>1^u;5?2zhM}NEL5;*SrjQD!p)wZ@zmh7Qf<`i-{YB#-w;8;{JAhuZ{+Pu}E z{wYcfWR^LclYdByFe=Okzd;oe7H6*h*6x2!R0)U6vT>)xI#C3WD2SOUBou{-gGq;a8m-Qe1u#PV5ei>ZvUO7L6o<>WM9n zJrU)M7R_`zcYcT@=2>`S_7@+v7$M7BBYB=W8ca<&ElHvotJ3h|y69Hrg@8S8UcPqs zQ`^*LeL?@crumHB_Zs!b9~(BiwXg5cjzuXUUW-lnKM=Ku%mbq3@hf8;wAchj0$TD!mgKTl zJ6-R;t{FJa4;!tBgk#Ou-%;;1YgOPg(3`hPnP#pAzp;H4xUDSAgDdki#qzAkzTEyL z%7@AeaT| z`mG;3#CCH?J;M;( zbKmx7XZnRwNA8)CPgBX$`smBvW>cVch#py5WaSn8>Ti?86sBmmuEN-8m}2tIPZ>J> zjnPst_jSmZR4k2-N|F_k!@Zr(qTC_$Q{h=~xEN^&fTah&Es(!hg<1NCmMS!tit zNnN!&Cl8$v5QvT56IY}QdNK8;xN2HpczjX=Nx=u_f>Kr>d z3}4_oJP5oBK9zAzOK)t-sS`olbsPP7|1`S()D0FUkORI){b!AVi-1VtHfE_9pcR?2 zUQf)%Q^AqVx9)4JcnrmgMAw_0(UB=MQdhh8u!Yqr^>_Dar7@9`JVqNcB|1B)-Afgm z8lr}*YJ-WB%5;=tU_NE07HrPYHIkkB<}Q?Z-}caVC3IWpl69B1GSr~~fzY^1XsHJu zjjDgy1wwD?y<)NMT5RBOrEtyf9Uy~p!pnC0=zKo<_nn$brC2QbhG6jvY;=Z;IdE#K z`9O`xgp|*`$}Ih8qy~dtEv2;)M^vr%0B*!{&V+zN)8A*7`7h_R?#;U)PVE>EqQv#{ zd%n3O+!B}G`YLeai+iprP@J7HwBKOPM9FetG%YCARghNfkqlJedQnMh(fpK%;6u0s z{PLht*^u&J|8c#BSRqv1U3Ox$cnyXb@CLG$mTahPSh5kKh`ySqkqMz4t}i`t z!-)LYFFZutI9 zmjS-b#$hhYd_`I;xDje~R}If!Z$0m-OIOSvd4*rrwezYn>U_L5iFd$#6%dhL8t!0u z@IGhgXf@L+qd{9fivM(`M6K+QeF<*cl^$(gNoVw`Ko!aN{jU6+zt#{}pY(%e&KX)D z5o<;2`WvNfUur0`InfbAqM?Ml4RXal6Y^^Tit99-`j`S5+GRu1VGGHccq>JEI;5v) z>oKuZg0zUVgw&lKidv#hQ2T)2_xNT}??}2QH`g=?wEQmutOCYKyE`HMQnCirw5(_; z#CQ^L3N&kIlx=zD$)wBJ`K(6av9_H+&rS&qZFV}Nt`N^Mic-o3)3aX|cT+erhV2;3F_NYoIzl9@MhJKchMCRPNbSuCa-i}KjfhsSlbw>N zp|LuVjvvf1`U>|`^}~Prwr?Eho&CQ#&3gs)OPH)wd0>g4r&XT)ZQ8l`R)dN8$*>NY z#FYVthh2aV{8JhmfJ!4LN9dzhT1nG@%#_MHHZ%uoVz229pyI(GhVT%6MhwaN*)0iL ze(+a~{N1`UqsOD+OjO|mu|Mlz)T*dxd|2`Q`*!SmfgY9D)a1_w)BAe!!FBlU@MYp@ zLQ+&m7xQyqx9eRxPbB>S#EENhRNRd6bJE|Q->*@x3YjE*02j<8l2-}rM=i~_X?bTl zQRGwR7?2ipM#7c#0GrRY0u05Jz*ZM-a;%9nALhqHFGriUV&6X}PE$uQ1O%eqz*Nz8 zSs~i^ZZ-CUr!1jh>_E;7a@{0G4IIAJ`SG*yCLG_Lq&y0@-#;2NR*AS2fkU~JR(b!= zpfIMn>FvB3;Ab&;NnF{Fn6e)g;xRH3g|pbIGoooi^`Ia+j zT!k|>X^M>6CHG@FJPJ5iJEbb2V@QMU`PNb>N|D)?fF9qh{kq;}T3N@YQ75R+P5ZYr z4XPG>p%|y8sEuSjq^k|I=T#w2K!72(l>*cDi-r~x9AVpE)^Fec!wilCoGR6>JVv`g zy+OGa;obk)46`OxN8AfT0g=rNwkGkCRtwWUyrI9X-^UDkTfu>v7c(P*rJvUfz6N|r z2g3XWNRm^~iAT6l28C1SBf!>#seECiOrFAUP3EV4Y>3yfiHya`qj}fgV)}3I?Ois@ zlB(L*8Qo7tO#Y~itZAh!2qE02a{Kd7pE;QZwWYF&NeZnx&0YO%ATDYb;Pe$5GvA)*Bh+Y_CrzJF zx5%;FhUI*LOUlRpEI``WXb?x?-G|qVAS&6KBCKL|KqGRIPUIWt0SA<6K_3_XtS%5n zQ*mbi-?{tE1_zG_dq~CdibAmE$8b8(EphR%aU44AT`qh9?Rh*BBJU_KZ50};DtSIn zE3Y;ir2t;4rS>o^wuloasxq5LRON6rbNtm6rFMRoFzA7cbyrfHBr z&9e{y`6_Ou?H{tKL+dIQY z;HzTX5Hd?~JECc+FI{&zo-f1hX>6`pm?EYo69WF60&UnfqFjFlsMQqMwDme%ugt@ zFdeJ{PerQ^ZS3{*?kF#a40PiWz{o_qU~cL_BOeD(8_1_eMvYh*&5y^SB{h#fAsPj1 zU%bx&$A3s}MwcJg-c~?zc-q>dpP5Sc(kXX2)jiS_??qSz zda#dJgTZ%M?=R)Ulg9Wki!m7M&cpD*Kb>NBIO|K6?MT2$dCTVvX)pKl&dLoz2-F@I z?zZIy#^5D-+wwBIHj#+c2%&{MyiHM19BnXGby#PW*_nU~jI#@NH^`+vM86$pon)Dq zRb5&Vrs?8LXl-t~Cl`p)>LTK*;HpS7L;Rj@BQf>z-lmzbUCX=Q6D0ojE>3GY4syH} zfy|XRD>m@wQFfNz459Y~5m0tp(-!cHaW(r8bac-zXUp$IabVrMMT{wT{(L3Tm~yCP zVXk&dfkFH`DT=MIpYQr${BryX&*E5t(!d*{Ak=F>$CRPCp7EOV5Z>GWRj^pqmYPJ`?jl(>dm^6SP z&xx{D*k$zDIvBue2ty}CGcfQ;mL775SWf*L@8y-*`Nwh_MOVAe1G?qJmz#81IVX}> zr<7>B~Ua86`T60EM{}PVXxx} z{a68+|14-gaKnOE2?zDO81do=evWUTUEhY9$t4!DG)hygo{N4e!!iC&?F~_{%v#na zp3_`aSspRT7Y+M#fDiK!9Ut8CS!V*n4kH6@^;}R<p?$2gNt>kkzy|Yr3kUrvo$jFSs>dMOsYS`k)xBQy|ubFq_!y(7<1=v)CglLb(vX za}HuT^ZehGT$@?gzZYG6s#F_c+?{m?f#Zr{*tB8y$Jk0-ISg%7JS)OIJ>b z<3aE9J*|T9Lm_?SiLKZ2iwl%}hO=0~j>2CIib%zPVQr@3_nrHqIz$2kZ%zdzMLCAa zl0%^1`(^Y7jeWT#OtT{qe(~Fdb;&a6nXThhg`%OYxl!7N&v&ul^PdH!dG#?;ObIj{ z8=Jt*;7{-&{)zni&`@mF+hy=s20l4P{+lpJDeJ`bR>#BD+L}duS!2vF5!aVwXxus>Cd_OJs_2zZ=*`Sqok7 z-3hAAC#+!*uYp^##aQDBB9@>m@~0P-7pbwuPIef#Z9+VgbX$5_t(%0N=Z-HX#^Ke! zVW#O1A|7Crp>bK=UYkUh{)3HCA=c!u3$!wp8lR%r>J0+rK z@!w44VR`%29HMv*D~}pn01+>WdQ2KZQ}!+DEOHsteVaF^P5v9qT{1j99`A#Nz(bhZDgS$7ipU^P?%I!DcNOaGY1Tfte%(sn`W3Xf*Vtebn0t z5ggOZcbdM9=~3Vi^ns>Wz&B3HKRj;7}?Sf5oKKj2|q#8MaG*OvsPZQ2`73GbrO!uU^sN$glj8kWY!5hN zZ(Mt1oGIAjCKw(D(xM&C53rRQ8+hq>^(nNpthMHDv57?nQN}#6(!lE30&nHKq6;R^ z!-FXrSERQRlP|LUR~xe0N7p;@uD9=v z&_+;9SF?THL61a#YYW(`#0`>k+xU>q#952+m$SV(?3wCr*Tzv}5)WQiC^M-y`+{Bx zloL(bb~|6W-TlEsPc{*p5?R?Q`JP^+?uNSpCE)O%M!p6Tf)veTVfyp`A2sdb_lWf>IB##lDn0~I1g)L7Z;kHcy z|JIisRJgkvsroMIgv@eV;RW?|BP}hGh=%c=PqRk=snCkssg9C@t?fAJ$06kkb^A*| zRhx{Nr+IaoP4|RQh+o*&!4M#eCO7LvFxyC1?cD*Rt28)+ALDyVsN)C9Z_A67+76&} zCp2Pb*0Z|VJ-!RLIq-fq==j(wy&BCJ!t>qL@rR{@6&f}E`~4skmqw0TmEpa`f#4dC z_Q)MD*QZf>n%DHfZRxB0mc{;qr1{^&G}&G$qf7Ce9Zj3DVWi(Ly$+E^rJ27~Wpn63 zB4f9p-d~%m_$K8%Uq7;*ldHUCJ$KF-GzX*(*pHWcu8_|ATfR5v*Td1aC~2nXm?;Ur zD0s%?$@p0hJ6iPR?tgTxkb$DgZ4a@tnC}z-e`Y)^^80N{``)yFrCMhc!*nr#K=j+^ zkK8v;S_`~rU{#;*cpyJ*VEuxq$)GqQ@ z%Ypx|=YzP?pZk9pi)juR??(Pa#hEf=RaB|*$(`6U>4&z-7S(C{MbpJ}6IyB)BQVDU zhqEaXBC@RJpW{v$3^athR%miH7ChAa{yxm{RF|X@sCM`7C0op)@qt-`$1Q$X`B{9O z#c8hjQ3Rvw!<^Z69rCa^%^ZG@P!hQiT{Z6<$#>yno!84&Wyyy%ReKSfX$L9I%sg?4 zC_yw!h>{&;ScM>u2u7v-qk=oLMAQL*fGVKi;dKpa9!_C{jQAL!Y-JV7(N$%P9?@5Q z?rd(U+g+_1rFuBvyn24SB9YJ{2#a1xDIT>td3_UzfniY@M^3wAeix%$&3Lz*p>=g} zNnO21rD;l1^f>5D?2rJp^V&$e7IwBJAs!2-tTP5KXBp=ZmYn7gl5LS$dx`+y$y^yi z4n%_FY|=qi9AW3_i5_I=hzyzO?pc(maX-rDXuCs2qE{4qIO3D#R0pD-h{}VLJyU_2 ztFiRVyAsA>vvUV5WZNx~((kTaN+QnWhaI-(N#}XYZqL>fi_U%?^+2_q#rEZW@C?3X zLG5EWX{&d0%N#v^lC;_`Yc}BRcXNbkf3i(?_}$=L4F#m`MCof$=d!W3wUAWW8d|zA zGgezKejqt892-a7)U|Xq=+@=g;jdedSAp}l(At7Fk}93w;OKh$lbr51fIpCFREer! zi$wFPNl^*(IruKNr8-xpV9xjEKuN^!fx^FVdbjY-)%HP63i7@6y~Mi5eG>8*m?<8@wQa&0|NU^uXQ^^V_@ZZ0L%0 zlm=k~;~`CjP$ECy`flpXgwY&?!&^4*!k!XBtv_u;g&uW-iTvEi{0@KZ+HbZYw#$m5J%rN&H_zHZKtQBZ*C%ho;oO@TV{BZcv$ zVAwaUV6yvGC!jfNNr}=r6`EQRiZ3o+LL6CTo&A#iX#q*OieibW_8Jm&rH~-=W;#N0q!XwXw3iJ)Pvlp zw(~7=YL%XwfuBkl&ooF+&f3vAN?@80bMn7>$+2n|W-fNf`Yk7Xs5Eebj@kc{_zShF)M% zYy_j7tF5D5Hd*n7EOMJ0#fLv>50nZv;5x<2V=C6hFPj*S#0y(+=Rvs;UBGi`z}eY8 z1Q*3z0wSFO*ao?#XBMeHnd9f@df=n&0ZFXty#^m7vrE%i@cAEjBnXiXOYq!U;(k_E(@sIP0^t7l}=?w77WA#mnNLFS;}VtLa}y#vj-iPEr&uLW@j67nnZT?W)NmbT_M`H8 ztS*ScFyAGJMn;ptRmNsc==`bg26rPUIK6zv9CaU=U;bzNZZX{|%=^l7j_HsY?2xSj z>rL1Z2R9u+nLbRKjQYoOUzgxc|LzFF4T+Vh`^pwo>2Pr_U9{W`uF%H^q&B6y1&~^A zov1I6E{x~fT60=z4Y95dL_anDg($s_WNUlFZ(=&g>x#}!iMG@@#_hS+ zo9H$whH2Om)sXmn8T4+e^?UKgRZCTZc6Qq$Gk4>WYcewZEA7<-@Cin-OfrN;E@M_* zwad|9or8AZCR(m@Eun4njw_`sW}oQ{32Cu_RvDbRwf>{F1`3yups|>nOzb zo~;qZYl52-K2*OPKnLNqDo^ugHVohKXEZs{Zr&{K?VN=A+sd)>EUx+6Hf3A}KD-xC z=)D;S|3i!;TB2XvenvfXUQzlxR9C))Y;7BO9NexfffzR;hwEQny9@a*U@NxaZ}>5s zs7HV8#wEV|AaiGqS%`qFkTEa6aDOL!;KW1n(=3zf<@Fmspyx3V}4!Hp?!J|2!3rmL?njv0x>E znw|nXF(glp`k6Cye2z}C9H~{FH_)u%&yiubOzH{see6K<*znB^yPJ+qFV)}|!5DMB zxJpV1Wm#SwAeQCJwt{1{Qhddsh$PgmtVW`<3P~aoTAz^9qgz&Nywba^y8i|?%zR;x ztdHv!$?lE{ic1N`l=MP@yub**2PXxNbt3-0M-1&5TG1g!;v6a+nq5+o@hJu|eS3Lw zBn6@kuOJM4H57b}IBWvBERXTX1t4B5`8pDm5NJLI9Hhs?gyTH0OyhoWMfX#Q4J`i? zHP9%k73By1sjV;Z*Q|WVsVy79Cl@4^fh8f>Iwz-%8pFCZPh<&96$v1E%@Jwp#s_$L z3Z3SBxOs6C)HsPrv+qAVdgmn+P0Z$dGD=z_00y%S=sjgp_PE>u*ZANuvcIFVRuN-js38$gP zX~`~dQf8yCj!eF`_Ww35WG7y5o_6w_%8#rCMnI3(bO)XRAiO74ec$!~YTvm>a~e(qqB~gkvF`_I#>qxVKOirFVoGGq+N_>NUYP5A?2?+ds7pacRM8r zq+$Qa4liQSL@48DukADtmOl|!7X5i*>XzILj(EdN)v3dw8F9>qQ7VQG>;65I!s6!% z_!85Am_*00pqBMIP~%et$z9o?hIt`uu#vt{*bi>GnPeo{?PnE1+f@ijkE|*v9~8Nd z6{6DtSoDnbSkHVgtoI*;^!jB@pRl_Sv8jxpk{lO|k+46Y=&wctXNZWi-|rE7h<{5x zrSo%KlPcfVx$GFU4@M+ib7aO(5YlCGIq$#-&Z=(b$$Xf6xpz%%rZd@T>b1~6TcGDS zL6aXtR;e9$R1l*)g-&{u`tR(m^G^`?#DrN~K!DG}jMGfOjKkc*(#nFJgVWrC%iM~G zor|B-l--I~MCkvg0PC1a0le)0JKZq>Er=wJ7mUA~XYef|I@l z%0sz%h9U+biC}@ub3YyQPQuTS0tHG=8j1ewH?iw_%>riy(2TFb9(o1LfQ)?%=Tv&1 zK|P3loL6eTokg{y9=AE*Z2IN<9(wsHMhlXqlg0n*Nc}fCo7w%>m@;+y;pJv&g~Z9j P&c}&FLnHNF8tH!knnj@h delta 9312 zcmai&Q(Ps0gN2){$>wC^X4{r3z52Zs!h}X?7kaGK1ZHsTLV;Wc?_M-GhZl4IYT~0LD!cISmfvS1fV|ra zW{N|SJ);0ZHaP|c+VHS#FHfntPhDm0Em*Rd!ybVsJ(w(#)mFy9_(rpNV1S^l-l4xi z9+iJ+)4}ENVa0Q28nhS{ay$Vt)Ksz=R|P@Uk*32j4Pea@WNxDoUCEu<#bUE zA`1c*HbA%7&x$(w8=Q~kUMFI-;{r+U6jb7U8KFm6^LCcAYLi>J*dNH0Rf_)?=vfIo zk_iw`v91g3v9|GkwJ)ypVl|AG>aPCAJ(>28Q(ywT?3b`y=kpgjP~%aXnYn5E$5!P;&qC$7=$;8CAE>gq92(P%;oU% z^`^zTw^P5Wp%N6-8`>CCCzu(p&C;h+i1cF^2~{TcCAXKo_01NPKTy>r!g}!qBvU~K z`&y{D2>0+=s?1}Dwfl9~`SH1rvUPMbW|p)$M=Q?O2NDp^;7}=^p6}3OU&y{K2%Pw> zH(Je6!g@MNGpG$wy`#%kk&v+tQ`oH{_aXE>u>OfviKNzaCYGu4J5%JnsBl(LuXHhr zusr^&yZd5#^KHDjNRhrf_|f%;_H4x4_hCVhfDCL*OZ$7)>?v2brQdbH8B^1%*4{yZ_tL=khdLtK;e~OgD}h;7U+NZ*eG7j zzK9&%au!gi+*BpO&?->G-conEW$p@u%Lr-|dAeBMk3fgVdO84kwvCH2S2z}} zed%+qkdB7os!G7~^>2XQiAvFiV}@UiFr@@V#AJM9M&IzeL8ExvJl~FeU5=HU)SAwJ z&gdF@K4}G+Gsrp6-+1vNLIxI_yB=XYlI*zly`eBZqJm$0w@jPkU!vG9FUJ)ctJ-_c zHJ3h$y9nI|(H5c9zT#SUqSbrI`e<|e2LDAHeSgo!#C@i7fw z(<|uh&>Le6X5#_WBoZ-;vXjBhw3Lo|SXFXV3Ivj~F*bV)d5?1=8ZuW!nw$n0YDpII zjkJ#WESSJ#wdK*VSfR*&25cug|wT29s#ocmk!3I2^mOv-<17obGupc->V8=(FA#2FRZw4Syr;+cIIAYgAABhy>e9*5 zid+`0FbUl@>Hgb!4>CGPxcivQt|3qA7VUJ#t|Ic?y?b@6WyIZbd}tZB>Bthiw`+?^ z)K^+w8$WhFby~cWeYG@x-61|R@YMDUy%(uGuj#)w6+Dx{m9-@7qbbyRjQ)$N<>-Gf z#iKtouTy^D@iI2je%Sp^dAJ7A{H%KO6Y@@v8FtA|3|I=_0wr2~N3P;a6W^GZ*cjKI zp`B?Yuo)i}`i|E?msqbOc5I0rXR0cRem*)XE0-_F3Xdh6zn|X{Aa#W~H-jBytg^)K zqc7K~h%<}b=lg-WV}v3Mrt^{R+rpzviPFdSVl$&hw+I@cp|J{hOswSoKoy>&$8nb~ z_z@JArdCw8Zxm2kOG}536i+${Z12T z&~LyoXUk|>*q%8cSTM`^}GxY zA(RK1*ax!X3~s;Uc%KstetN)Q>SukcTra(lA)ogGNZI%>qS5TMW+qKZ|1a2S}LY?_5~tu>Ga?df*sXiR;a*jgca6y=m}9PjfE4 zYmMw6<|en-64j&E1j4Y{c-EshL6DX%gAOr@-HSiW{e0kmg=A z80(lAG-n=AE^Cwb@p6AnQE5sbyXC&?-<{hgH;SmN15*jKz_u*?Hfb)QHLg`_MAcf($&N1ma8i^lV9f`565|{ zlm4rp?Z0r|``6EC-O7<=dAhgSa~rQc{&pLM{M_Oh)}A~HS8sqczi`~~0$VEABwKT; z-%l%MmM7&m|5iOf#y-}7?fIzwvzZbcs>9O~le~M@@j=Be z&YM0?f+XYJ(xQ&j*~1sM>DG}Txe7TI8|+a~bm3QfqWa3J++n!~LZ3fNGgxpic}GDr zoQgK2@`}m}Mr5NFnssqj%Je13K0^(M-!chT8BWP0rhj%p*cgQ*^3e_$roN9zzazO~ zSWl}>^Gn9GV^iW&Q5zT18j~2ib`sz)TYC~C0wrUajp`Vru#CgVY^Q#JAZ10gBHV4d zes&90cL6E}oi-c|`(}D>`@6x{wkK8nCHM(+K~4e**AmpGg~-!EgK7Pd_ zjreR5`7!ovZE-<#NUB(5*4frGim`KiA{=z{-;~*YPd~HO_>0Dv`za2H=UCM{^&LeP z+IO5(KfNP#+@nGvTRK@Z7?CXaE9u*=BEnvQ?#Y+ zDw_0}ba{W;<37TvL7PU0h(Vif!_wA|TZrK>hpo!Z(0=LiAJA?Zd6>HtPzNvadG)BV5V}#H3xVDP3j^N$--u#KOib zZAN3o&c@C@GSUs8fmNX%kws(+3x=S<<71{DQ8u^o-8qXT)0O9ZO*lf5NCd3CJc~O0 zJLMqzJaE}OkUoQIRiY-5#h~m9Cr}oW6p|JC7AMC{^n9lxB3_<_y!}l&kyaC%cYc2S ztf@t-V{ai3M4=GvSDdn3F<+VEJc92t_73eCT+ukYlXufo`mHUe#ILBtFG(R%R`NhY zQ|%@T+46@}tsyS+qmD!3uoTn6>WY39BM~xQc7eTSg+7M_`QP zNRUXjONhg1ABnE7Z1vgu$n0pG728nV=tUO9LXdPh);{Gq=`PIYvw5sx4n4f#W^iof zTC!=rd8Ia`i3PNFpj4h89`cStfhE`3dQ)w<{-eEsT0!1pR~NS`lVW|L%KGD$!~6*r zJ{rr8I&==}E2dInwoajojV7pyTCM-c!j&N{txUdtgtjZu<#JrJ=BFnxON3SpPhtBljvtg%Q&Yq7N{rt z?LM08IIF$7B;Ul83dZ|}*_Q3CLr6iNkxSQg;x5cuWaRZ(s@B?7@}?GP=f!#LFwQF(~eifg79hCY+K)jQee|^UZcGUKIY;HP+_VhB?~W zb7-@_M$RXUw-w%`uLLT&Mb?#PSClzaagJUO{VOM=wwm?Cqi+lgh7HR#y_*1CnXJ?c zvr;C)iQ4)eeth?!DAO^2(j}Lp0?b{Qr_FPiglA?xnz2eb3jkcCWzT-{n zZ1MLR$7hRr9)c^5@VbWD|2!lRsD#X@;>nFasT3vX&^B~4$I;%7O{sJ>L;^Fwx)_B`mC*+A?9%U;qdg~>658%;u#FdC2A3h|U6b++f2~q(4BIIX zdl|hEcZ1x)a+4Fz_7L-@K8(Y1Ij+>PdFPfE2D&K&PzJ4LO;Iw3d6#-K?gDH?Xq5Y9 z4{F&gC!)7Ty(V9fj6+hKJ{LT93LM>-TAw=oUwDeaHB~#m!9>qPBdwsyg(zkoYqlJ4 zp@##~x^_dnIG3v!$9`xs%twgJKd*`_R_ps)V8d|)T>k5T1bf(VGQEgKPI|%Q4=@MN zz&~}>+2rL#3PmoU%s*CjFEQkF0KPb{x%_?%_Lty|adfsXZrer<;$;u%TUUhJLGM?; zUS(K=US(8XScG<_dIpeTUQ8IG)B3ziY2Du}=_Ar#oK{BGMx64f=)|^eGrnIsxZ-yr zwC@A@DEqr8c}x$q{cnti7tULmtC;gRy2|&4(M@3mQ=ve0l!K({J#OKaNM13(qJ$u< zOeEhYDUXitav$)FHngim&GW5+;`wFs7=vowHWQmEAc5CkZuTG)#VX_-Z1e^lIr9SC zx9n>HWnlHD$WfJa1>2)=t2<<_MA-hluGcCIAo+WhlgM0t@*XK{a`No{xPh0P^Tmbnv|!7;D%?CG-Bc%-Ph3mn{_GghCRm%9Mvv5g6WnB-)c($7_%T;#45QaqFKk?MBxY#(ICF)4E1{A7aXD6-Z^n!$3Ix`bvdLdU>q!R%KBDk@e>yhI+kN zonBpn*VadJ<^!s$2*I|xG!_NqO5b2TrD8hB>s(uqQWs@f!B9z|=Kd0-{>>lv`E@n3 zQ!<_GFoP-Q(PcsDs=0CL39q@ilA?R#Uu#FLh`FeSmdVmso~4{p4HDu?E$j6YVRF0f zH3%|WP$KFFI`hFp3_6CoA_dd=lJna!o*b8&Mn}`U;TEG)zcEi-DDbJKl%y2n)g9x} zQ`3a6hH%N$C@vje+rT4)#wK*71v>Sqk>WhO}UpBsCBHhGP!BrDrY;P_>9_ z=!`51OQPP&pRfJb*2Ddi;#(4Xp$DO`_xWlbBEPX=p8M2{Z92cpwhSzkX#xO@T1HBW zibh5#_T!S)nW1i`<7*A}rsFF|LD1_glyY}im7%lWlHAvB(Y)8P)}`}TZPH=M(Ax*6 zFITcZ1}6JA&TY~A4%tT8s{e4Ng8-$5@Mim5Hncplas$m_%yG6=C))LuJN5tyJ9B`Z z6>_+B5$>d<#{`*`EXb_(UG8U{mcsgh`;$He&-XkRNxxYBEwW~p_wX<>55IYM6!B+n zqb$wLKM;R{6qdK-L_9q;gBqs!63e4v)60%<5BWKcs;43BN9)?3C=ArLAYAV@ny9+= z$}KzzP{V6l!#{_2(pQp2szmcZvu6yv`fI#^Ou{x!2Dw2prSEBdsn;U|sWve$^(?aE z!+@PYNY%mTK%TL!T;*3OPk6~cHNCy+42$#2{+%6Nlv}aV;p&?hbJg#5bL2{O2K;eQ z3w7J0P-AnwI+riNy7Tuy5NxjgXDm(+^}7t4yXlo~?#@vD_<}hF3F};3_&~C)oRBRV zQSgW$r|H1Syw>KhE*CBEBe6_LKdhHv`~V*ZM|+fL*Y2UT2@=0kES*Xv%x=8-gH!NR z;G)}UGPCVWw8Q81W_3EY(WX%*+4UTeah4@v)nalO&!*9=znpXvBt&lZW&a;PTpPvd zx-C1jjNdEN#wv|;L-J9z$;p`Aq5-^n3Hp_s=~OWPBlOknI``aWT8lwn&%lxZSPSWJ}vDS@arqwB~G zUtX{9`L7vzqc8&%$P}(M{-4*ur7*Mg@|7+}lK+=_5G6T@UVXNkv>oR}E!KvZSFFC6 zQ=ZU=5r+o4fg2-EcX4y_cJ#T*%_9xhfrygS>%YyX>H;Rto4v80cOP9}v*8d{3nY62 z&h3|U^%G4Pn5N2Cv4cInp=>h0MU+$n#R8ofT{VMJ1T@m zjrFeldD7La?dGu+IFal5Qv;=vY?5;vT-kRq_6BJSi>+x!=1`iVt7>6j@?jP4jS03< zR{yf+=`46RKc1^TvA_pk1N^Cu&yy!3JpUebw>(Hq=eaHG&IlJOBWbN2qmsr@+PzrT zSvcFNXoo0SgBEmnanclS^=y9CYbJDqOvK~Q-9J_D7XRI5@W6HN?akj$je?DiYU)c> z>5F09%l9pe#%G;047}SIu+E}k-j`-Ky&9j7XHO67>rXeos0LSQp+0_SqjdD8{4}Kg z*;jH0>73c6mcdWLiW^QUfRg`1!PXpX%gnAt$j61?0eagB>OJf6&P(|vs;UwGUb0x; z=D)_V&o)bpT34l1k+)<+AZC_&zf7uQZlai5G{o^hzR)6ZFWe5(LRdy5!jYmpjTEB; zAj-2usFZQa5E)U)S0ysoP z>IE{RL6vs1;1D~O&hc;nxreL_ zIu3rl--<6Oz_y!gJCC_i6~~RcF~+ z=5}Y~SBI_FU)7^^jJ(S@Q@R~+Xx?)7o$XcCwfO}>(LxSOpt0Y3N1iVs>5bEqKR6?vJ7+T)Gy`Ico-+b2 z)mxd7sA0%9wX5)n33XKp973qKqmhA+`1nQtZW z8w%?_-vTEfs}ja@ZD5(P-_?9?HL1;BoqNLI?L-D`?#C3nxabk>bK|_v9=ETe3xXwB z;}gsE;50?{1-?{>IJ5=51)_$>Xb^T>oZ(=Usxp|*l|bb7u@Go4izcZ4D8l~=>Mb!D z>9L&S-jB%K@-z4Nsi^SZ@KH-qPup7`^Hux+@(`PvvE1^v-Rria>w{!1P+NX(j*XOzHr5FQQ=sPsTA?L9Rzwio-r8}za?||t_kuJbw!3^kk9zTTY-9hL z_ZfzidErz0JRi%ooaRNr^YJ5@HF=H5sq{cOstVgf`nJ*z&-*PPUHMbud&Z`6Ewu7) zTu>nH0+7Pl<_bI1U4`xuPavn!xaFJqa6_Ag_R&^(V|7ZfwQwnERud08==+rtb(ya! z5Yy{UM;_-j+K*{Is$&&P=vyi^sJuyE3zvy6P5Nu?39SPb%4%OE4+Y=c6buVBR-U~a z>@qb=zfVNG$DAFNc*Lc=#CR=iGH?TKe4 z{p-NOGBiPBN5O{S;vF>bzo6n=fK9RmzC5=GX=r?)%78*r2VBAHj7>PBRoJ^M+6G*p zw6!tZ<(JkxKnHIxZR0sDbAWQ<`6J~W53(}yRMdD_twg>+6;Ht$Hir<=r(5fqJV9)> z+>OSwgYi&>iK_Y@NLye`l$wrWIi8K4Aw_K~+J#og%fi!dBfBTC!-tF%CU(vb%?i;V z8y?sL%qK%}-^0-Y&L5qtI^mS6AmiuBsvDS(R3wl_?EsnEdF5Q! MTUki^ZPvZyd z+#2>Q^MHQbOi{FF$j|8tX&2&K@+h65HRNzdHoDxH+2T~7xc>bBI+u!HQqw<3Pp=Uz z{tdG-6wTs@?sI{<$oYD4QZ2l_?#GH!W-OK#U#=nn(0d#w-e=}cXWdj?ZmJBpTdcv) zMbAalXZ!zZTnR@z_%gDXr$VEG;m;~^X}f0ziyAyke#Pgl)qeKFyc)?M0nI<9KiTS& zk6`|X!MTBl^yM)4{UJ>+4+xJsq)<@2%7_|ZG6O9T2j72Uxk+6|4Psu5k1dlt=eqSe z)hhuYffXtmlClkb+;`VD^ca6WUT#ma?f3xDwl(kfq&3l{L7v=u;D)xDDZVbpJ;$ncXi{BOzLUw2bIzX7l_hm}CRSUS3t zVx-mz0E*ThW51EF#T%^&kdROk%))w$`JyaR?IOaF>@kpvRfvmOb|s>olAzI|ha`wO z1LHESh#X49G1KuUdii$|B;}n`gPm=9LTQYG2=>sU++u$)XU0h*`Nyn`rfEA^(+PBB zS*g{~j|m9;{m`F3_cwmSy+~qdP~%Z7{Ua2;B@;UPi!xmveO#r0_dt*E-r)Y<8TA<& z!n^=mWVOT9r3~F_EjY`N03^OG)5DM4e(gkkg?weQ(9xdLR&RuTb0`+@<(~GJ>GXJK z;FaZ)ryqHuv@+~SzybJJ?2CXY)Cw<*>{Ab-Rjl>FHCF}rxD|wvWyuS4_u?k7e*L;? zKe8h{|7jiBjb2^PXnQ|ydelfZaoUV(rLS@9E^V;3sMPFYmdv@B4C)0|NEE3(s1pvwFs=^`KhI9=GCne)bJNkbkYsM0SK@UkiRJ7tdg>_B#tt&{uOGQ&N@D;Dm7(x>S}j_Dc40^X z-Jet`h7A1-kes;&9TxUHxAQ!KWWUBV_7U*Z@lT8R=^ku~C1a}!iJ@IJ;Gs7gBgBg# z3oaCsRew5=vr2;ndzf^-r*HrpCPz~+0hT66B7vO?$>}E%k46qg9pf?MDs04JOupwA za?^6~iXh$|2i-JE|A?s*QY?YuIaiFWaC-zQKgH?~5P!2=5L+XFN4z=x72``3m708) zI8cs}5B0WnXIx7_g6FwJ`QBRtLo)@L@?XQQ|Ha(D^*kf)g}2e_qtx6K7=}V^&BI&2byF63s>sTw?#jS?oXsVEQlhC z415d##H4~zti919u`W9xT&wyFS0BNQxBf?$^~TOVQ!`+3#c>&19DQNR)=kNV7+>I| zK619I!!Pxm{J~ZQn(X3hIkTMT{Z^-l@9p?&!MwQI&X21kFlJfymNw7>sB4&CbIc|ETBr!IU^q;6%4festSQhKxIpn>D>Ltszk57%B)H{SoEcr(nugxt%|JnahT2nRIat z8dROQdOM%GEii6w`$a80LPzMM;ufGL-atfZDY-WO)u(UD9S`oRGujxx-!(`%Y{^Tx zP6nox?Zk|8k_D*!i`mu2`bh<%3!6c4Gkmo5Jd6VCs&4!hnL_Y)|Gfpf@0ZkLU-mjt zXl(oDe5p2IV(zW`KaAF!C&o}VhYU3{Pz&^c5OiGCq5({J8w}PXYMevEhhc6jf|$!R z!dUNM$;aR`2f@c5vG6PC!E18ph;3w?i{*fP3BkNi;eR}zH39WaKK5deGcmv}q1dX` zdz%;p{WsPpN^a)o!{sgD4?kn%4ULQ0zHsI--OfOpS1>li0c~d76f#|A%^s{E+q~Ki zQ1(*`%Y##CgNhxpZdzaD!IVen(|q2i3t6F3b2xyG>Dt`KL?9t>MvIB zcZ`socPuQa0TZb{2(i;H4p*ZcWAN*~J`PdVno_2-_U%MR1E(MprPhHwHB~|a8NfmU z&q8L&LLN3H3lU|2N@O(wE8)0V=H(iO^vvS-Q-Qe{QK2;D9IY}I7!65YBBU_#ZbxLK zl1h}HF`{KFqmQ5p^+4G^=BAoEIes7Zx;F*qjuF Qi;sg3nTAGMRR;OL06VS|c>n+a diff --git a/pkgdown/assets/gt-latex.tex b/pkgdown/assets/gt-latex.tex index 31a97b8774..e274ee8b0d 100644 --- a/pkgdown/assets/gt-latex.tex +++ b/pkgdown/assets/gt-latex.tex @@ -44,14 +44,28 @@ \setlength{\emergencystretch}{3em} % prevent overfull lines \setcounter{secnumdepth}{-\maxdimen} % remove section numbering % Make \paragraph and \subparagraph free-standing +\makeatletter \ifx\paragraph\undefined\else \let\oldparagraph\paragraph - \renewcommand{\paragraph}[1]{\oldparagraph{#1}\mbox{}} + \renewcommand{\paragraph}{ + \@ifstar + \xxxParagraphStar + \xxxParagraphNoStar + } + \newcommand{\xxxParagraphStar}[1]{\oldparagraph*{#1}\mbox{}} + \newcommand{\xxxParagraphNoStar}[1]{\oldparagraph{#1}\mbox{}} \fi \ifx\subparagraph\undefined\else \let\oldsubparagraph\subparagraph - \renewcommand{\subparagraph}[1]{\oldsubparagraph{#1}\mbox{}} + \renewcommand{\subparagraph}{ + \@ifstar + \xxxSubParagraphStar + \xxxSubParagraphNoStar + } + \newcommand{\xxxSubParagraphStar}[1]{\oldsubparagraph*{#1}\mbox{}} + \newcommand{\xxxSubParagraphNoStar}[1]{\oldsubparagraph{#1}\mbox{}} \fi +\makeatother \usepackage{color} \usepackage{fancyvrb} @@ -71,7 +85,7 @@ \newcommand{\CommentTok}[1]{\textcolor[rgb]{0.37,0.37,0.37}{#1}} \newcommand{\CommentVarTok}[1]{\textcolor[rgb]{0.37,0.37,0.37}{\textit{#1}}} \newcommand{\ConstantTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{#1}} -\newcommand{\ControlFlowTok}[1]{\textcolor[rgb]{0.00,0.23,0.31}{#1}} +\newcommand{\ControlFlowTok}[1]{\textcolor[rgb]{0.00,0.23,0.31}{\textbf{#1}}} \newcommand{\DataTypeTok}[1]{\textcolor[rgb]{0.68,0.00,0.00}{#1}} \newcommand{\DecValTok}[1]{\textcolor[rgb]{0.68,0.00,0.00}{#1}} \newcommand{\DocumentationTok}[1]{\textcolor[rgb]{0.37,0.37,0.37}{\textit{#1}}} @@ -81,7 +95,7 @@ \newcommand{\FunctionTok}[1]{\textcolor[rgb]{0.28,0.35,0.67}{#1}} \newcommand{\ImportTok}[1]{\textcolor[rgb]{0.00,0.46,0.62}{#1}} \newcommand{\InformationTok}[1]{\textcolor[rgb]{0.37,0.37,0.37}{#1}} -\newcommand{\KeywordTok}[1]{\textcolor[rgb]{0.00,0.23,0.31}{#1}} +\newcommand{\KeywordTok}[1]{\textcolor[rgb]{0.00,0.23,0.31}{\textbf{#1}}} \newcommand{\NormalTok}[1]{\textcolor[rgb]{0.00,0.23,0.31}{#1}} \newcommand{\OperatorTok}[1]{\textcolor[rgb]{0.37,0.37,0.37}{#1}} \newcommand{\OtherTok}[1]{\textcolor[rgb]{0.00,0.23,0.31}{#1}} @@ -168,6 +182,7 @@ \@ifpackageloaded{caption}{}{\usepackage{caption}} \@ifpackageloaded{subcaption}{}{\usepackage{subcaption}} \makeatother + \ifLuaTeX \usepackage{selnolig} % disable illegal ligatures \fi @@ -184,17 +199,19 @@ urlcolor={Blue}, pdfcreator={LaTeX via pandoc}} + \title{LaTeX Quarto test} \author{} -\date{2024-07-18} +\date{2024-07-19} \begin{document} \maketitle \listoftables + \begin{Shaded} \begin{Highlighting}[] -\NormalTok{devtools}\SpecialCharTok{::}\FunctionTok{load\_all}\NormalTok{(}\StringTok{"."}\NormalTok{)} +\NormalTok{pkgload}\SpecialCharTok{::}\FunctionTok{load\_all}\NormalTok{(}\StringTok{"."}\NormalTok{)} \end{Highlighting} \end{Shaded} @@ -212,6 +229,16 @@ [1] '0.11.0.9000' \end{verbatim} +\begin{Shaded} +\begin{Highlighting}[] +\NormalTok{quarto}\SpecialCharTok{::}\FunctionTok{quarto\_version}\NormalTok{()} +\end{Highlighting} +\end{Shaded} + +\begin{verbatim} +[1] '1.5.54' +\end{verbatim} + \newpage{} \begin{Shaded} @@ -348,4 +375,5 @@ + \end{document} diff --git a/vignettes/gt-interactive.qmd b/vignettes/gt-interactive.qmd index 1697037523..c3594bf7c9 100644 --- a/vignettes/gt-interactive.qmd +++ b/vignettes/gt-interactive.qmd @@ -10,6 +10,8 @@ knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) +# generate the same table ID +set.seed(112) ``` gt provides an option to make interactive html tables via the [reactable](https://glin.github.io/reactable/index.html) package. @@ -35,11 +37,14 @@ gt_tbl |> opt_interactive() ``` -# Current limitations +## Examples + +![](images/clipboard-2210070624.png) -* Some features like `tab_style()` may not be fully supported. +# Current limitations -* `summary_rows()` and `grand_summary_rows()` have yet to be implemented. +- Some features like `tab_style()` may not be fully supported. -* Your interactive table may be visually different from your non-interactive table. +- `summary_rows()` and `grand_summary_rows()` have yet to be implemented. +- Your interactive table may be visually different from your non-interactive table. diff --git a/vignettes/gt-visual.qmd b/vignettes/gt-visual.qmd index b6bbbf5f56..a855c14186 100644 --- a/vignettes/gt-visual.qmd +++ b/vignettes/gt-visual.qmd @@ -28,6 +28,8 @@ if (isTRUE(as.logical(Sys.getenv("CI", "false"))) || identical(Sys.getenv("IN_PK } # All tables are generated in vignettes/visual_tests.R # When updating this file, update also pkgdown/assets/gt-latex.qmd +# generate the same table ID +set.seed(112) ``` ```{r} From 8275fc5c6c47f909ec25a1fcdfba597599b1edc3 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 19 Jul 2024 13:02:46 -0400 Subject: [PATCH 07/16] Support fully bordered tables --- NEWS.md | 2 +- R/render_as_i_html.R | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8edfc5ff2d..34ea725b00 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,7 +6,7 @@ ## Interactive table support -* Interactive tables will show no border if `opt_table_lines(extent = "none")` is specified (#1307). +* Interactive tables respect`opt_table_lines(extent = "none")` and `opt_table_lines(extent = "all")` is specified (#1307). * Interactive tables now respect more styling options. diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index 19c07d3a98..14edb3d32d 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -189,8 +189,10 @@ render_as_ihtml <- function(data, id) { # apply all column labels formatting to both heading + groupCol styling (nothing specific for spanners styling in gt?) column_labels_background_color <- "transparent" } - # Part of #1307 - borderless_borders <- opt_val(data = data, option = "table_body_hlines_style") == "none" + horizontal_borders <- opt_val(data = data, option = "table_body_hlines_style") + veritcal_borders <- opt_val(data = data, option = "table_body_vlines_style") + borderless_borders <- horizontal_borders == "none" && veritcal_borders == "none" + all_borders <- horizontal_borders != "none" && veritcal_borders != "none" column_labels_font_weight <- opt_val(data = data, option = "column_labels_font_weight") # Apply font weight to groupname_col title @@ -654,7 +656,8 @@ render_as_ihtml <- function(data, id) { onClick = NULL, highlight = use_highlight, outlined = FALSE, - bordered = FALSE, + # equivalent to opt_table_lines(extent = "all") + bordered = all_borders, # equivalent to opt_table_lines(extent = "none") borderless = borderless_borders, striped = use_row_striping, From fea6d5fc0182b2d11da0cd5de5bc6890488f51ff Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 24 Jul 2024 12:56:20 -0400 Subject: [PATCH 08/16] Commit to reset mix --- NEWS.md | 2 +- R/datasets.R | 34 +++++++++++ R/render_as_i_html.R | 110 +++++++++++++++++++++++++++-------- man/constants.Rd | 3 + man/exibble.Rd | 3 + man/films.Rd | 3 + man/gibraltar.Rd | 3 + man/gtcars.Rd | 3 + man/illness.Rd | 3 + man/metro.Rd | 3 + man/nuclides.Rd | 3 + man/peeps.Rd | 3 + man/photolysis.Rd | 3 + man/pizzaplace.Rd | 3 + man/reactions.Rd | 3 + man/rx_addv.Rd | 3 + man/rx_adsl.Rd | 3 + man/sp500.Rd | 3 + man/sza.Rd | 3 + man/towny.Rd | 3 + pkgdown/_pkgdown.yml | 2 + vignettes/gt-interactive.qmd | 32 +++++++++- vignettes/gt.Rmd | 2 +- 23 files changed, 203 insertions(+), 30 deletions(-) diff --git a/NEWS.md b/NEWS.md index 34ea725b00..4eda1c0ea4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,7 +11,7 @@ * Interactive tables now respect more styling options. * `column_labels.background.color`, `row_group.background.color`, `row_group.font.weight`, `table_body.hlines.style`, - `table.font.weight`, `table.font.size`, `stub.font.weight` (#1693). + `table.font.weight`, `table.font.size`, `stub.font.weight`, `stub_background.color` (#1693). * `opt_interactive()` now works when columns are merged with `cols_merge()` (@olivroy, #1785). diff --git a/R/datasets.R b/R/datasets.R index 679fc99dda..1cbd22001d 100644 --- a/R/datasets.R +++ b/R/datasets.R @@ -107,6 +107,8 @@ #' @section Dataset Introduced: #' `v0.2.0.5` (March 31, 2020) #' +#' @examples +#' dplyr::glimpse(sza) "sza" #' Deluxe automobiles from the 2014-2017 period @@ -163,6 +165,8 @@ #' @section Dataset Introduced: #' `v0.2.0.5` (March 31, 2020) #' +#' @examples +#' dplyr::glimpse(gtcars) "gtcars" #' Daily S&P 500 Index data from 1950 to 2015 @@ -194,6 +198,8 @@ #' @section Dataset Introduced: #' `v0.2.0.5` (March 31, 2020) #' +#' @examples +#' dplyr::glimpse(sp500) "sp500" #' A year of pizza sales from a pizza place @@ -324,6 +330,8 @@ #' @section Dataset Introduced: #' `v0.2.0.5` (March 31, 2020) #' +#' @examples +#' dplyr::glimpse(pizzaplace) "pizzaplace" #' A toy example tibble for testing with gt: exibble @@ -366,6 +374,8 @@ #' @section Dataset Introduced: #' `v0.2.0.5` (March 31, 2020) #' +#' @examples +#' exibble "exibble" #' Populations of all municipalities in Ontario from 1996 to 2021 @@ -432,6 +442,8 @@ #' @section Dataset Introduced: #' `v0.9.0` (Mar 31, 2023) #' +#' @examples +#' dplyr::glimpse(towny) "towny" #' A table of personal information for people all over the world @@ -482,6 +494,8 @@ #' @section Dataset Introduced: #' `v0.11.0` (July 9, 2024) #' +#' @examples +#' dplyr::glimpse(peeps) "peeps" @@ -528,6 +542,8 @@ #' @section Dataset Introduced: #' `v0.11.0` (July 9, 2024) #' +#' @examples +#' dplyr::glimpse(films) "films" #' The stations of the Paris Metro @@ -595,6 +611,8 @@ #' @section Dataset Introduced: #' `v0.9.0` (Mar 31, 2023) #' +#' @examples +#' dplyr::glimpse(metro) "metro" #' Weather conditions in Gibraltar, May 2023 @@ -633,6 +651,8 @@ #' @section Dataset Introduced: #' `v0.11.0` (July 9, 2024) #' +#' @examples +#' dplyr::glimpse(gibraltar) "gibraltar" #' The fundamental physical constants @@ -674,6 +694,8 @@ #' @section Dataset Introduced: #' `v0.10.0` (October 7, 2023) #' +#' @examples +#' dplyr::glimpse(constants) "constants" #' Lab tests for one suffering from an illness @@ -759,6 +781,8 @@ #' @section Dataset Introduced: #' `v0.10.0` (October 7, 2023) #' +#' @examples +#' dplyr::glimpse(illness) "illness" #' Reaction rates for gas-phase atmospheric reactions of organic compounds @@ -855,6 +879,8 @@ #' @section Dataset Introduced: #' `v0.11.0` (July 9, 2024) #' +#' @examples +#' dplyr::glimpse(reactions) "reactions" #' Data on photolysis rates for gas-phase organic compounds @@ -906,6 +932,8 @@ #' @section Dataset Introduced: #' `v0.11.0` (July 9, 2024) #' +#' @examples +#' dplyr::glimpse(photolysis) "photolysis" #' Nuclide data @@ -959,6 +987,8 @@ #' @section Dataset Introduced: #' `v0.11.0` (July 9, 2024) #' +#' @examples +#' dplyr::glimpse(nuclides) "nuclides" #' An ADSL-flavored clinical trial toy dataset @@ -1021,6 +1051,8 @@ #' @section Dataset Introduced: #' `v0.9.0` (Mar 31, 2023) #' +#' @examples +#' dplyr::glimpse(rx_adsl) "rx_adsl" #' An ADDV-flavored clinical trial toy dataset @@ -1086,4 +1118,6 @@ #' @section Dataset Introduced: #' `v0.9.0` (Mar 31, 2023) #' +#' @examples +#' dplyr::glimpse(rx_addv) "rx_addv" diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index 14edb3d32d..3be089e9ba 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -171,8 +171,16 @@ render_as_ihtml <- function(data, id) { table_width <- opt_val(data = data, option = "table_width") table_background_color <- opt_val(data = data, option = "table_background_color") + table_font_size <- opt_val(data = data, "table_font_size") table_font_names <- opt_val(data = data, option = "table_font_names") table_font_color <- opt_val(data = data, option = "table_font_color") + table_border_right_style <- opt_val(data, "table_border_right_style") + table_border_right_color <- opt_val(data, "table_border_right_color") + table_border_left_style <- opt_val(data, "table_border_left_style") + table_border_left_color <- opt_val(data, "table_border_left_color") + table_border_top_color <- opt_val(data, "table_border_top_color") + + heading_border_bottom_color <- opt_val(data, "heading_border_bottom_color") column_labels_border_top_style <- opt_val(data = data, option = "column_labels_border_top_style") column_labels_border_top_width <- opt_val(data = data, option = "column_labels_border_top_width") @@ -180,28 +188,39 @@ render_as_ihtml <- function(data, id) { column_labels_border_bottom_style <- opt_val(data = data, option = "column_labels_border_bottom_style") column_labels_border_bottom_width <- opt_val(data = data, option = "column_labels_border_bottom_width") column_labels_border_bottom_color <- opt_val(data = data, option = "column_labels_border_bottom_color") + # Don't allow NA column_labels_background_color = opt_val(data = data, option = "column_labels_background_color") - # Apply stub font weight to - stub_font_weight <- opt_val(data = data, option = "stub_font_weight") - if (is.na(column_labels_background_color)) { # apply all column labels formatting to both heading + groupCol styling (nothing specific for spanners styling in gt?) column_labels_background_color <- "transparent" } + + column_labels_font_weight <- opt_val(data = data, option = "column_labels_font_weight") + # Apply font weight to groupname_col title + row_group_font_weight <- opt_val(data = data, "row_group_font_weight") + row_group_background_color <- opt_val(data = data, "row_group_background_color") + + table_body_font_weight <- opt_val(data = data, "table_font_weight") + table_body_hlines_style <- opt_val(data = data, "table_body_hlines_style") + table_body_hlines_color <- opt_val(data = data, "table_body_hlines_color") + table_body_hlines_width <- opt_val(data = data, "table_body_hlines_width") + table_body_vlines_style <- opt_val(data = data, "table_body_vlines_style") + table_body_vlines_color <- opt_val(data = data, "table_body_vlines_color") + table_body_vlines_width <- opt_val(data = data, "table_body_vlines_width") + horizontal_borders <- opt_val(data = data, option = "table_body_hlines_style") veritcal_borders <- opt_val(data = data, option = "table_body_vlines_style") borderless_borders <- horizontal_borders == "none" && veritcal_borders == "none" all_borders <- horizontal_borders != "none" && veritcal_borders != "none" - column_labels_font_weight <- opt_val(data = data, option = "column_labels_font_weight") - # Apply font weight to groupname_col title - row_group_font_weight = opt_val(data = data, "row_group_font_weight") - table_body_font_weight = opt_val(data = data, "table_font_weight") # for row names + summary label stub_font_weight <- opt_val(data = data, "stub_font_weight") - # #1693 table font size - table_font_size <- opt_val(data = data, "table_font_size") + stub_border_color <- opt_val(data, "stub_border_color") + stub_border_style <- opt_val(data, "stub_border_style") + # Apply stub font weight to + stub_font_weight <- opt_val(data = data, option = "stub_font_weight") + stub_background_color <- opt_val(data = data, option = "stub_background_color") emoji_symbol_fonts <- c( @@ -224,7 +243,13 @@ render_as_ihtml <- function(data, id) { row_name_col_def <- list(reactable::colDef( name = rowname_label, style = list( - fontWeight = stub_font_weight + fontWeight = stub_font_weight, + color = if (!is.na(stub_background_color)) unname(ideal_fgnd_color(stub_background_color)) else NULL, + borderRight = stub_border_color, + borderRightStyle = stub_border_style, + backgroundColor = stub_background_color#, + + # borderLeft, borderRight are possible ) # TODO pass on other attributes of row names column if necessary. )) @@ -349,7 +374,13 @@ render_as_ihtml <- function(data, id) { reactable::colDef( name = group_label, style = list( - `font-weight` = row_group_font_weight + `font-weight` = row_group_font_weight, + color = if (is.na(row_group_background_color)) NULL else unname(ideal_fgnd_color(row_group_background_colorfgggee )), + backgroundColor = row_group_background_color, + borderStyle = "none", + borderColor = "transparent", + borderTopColor = "transparent", + borderBottomColor = "transparent" ), # The total number of rows is wrong in colGroup, possibly due to the JS fn grouped = grp_fn, @@ -384,7 +415,7 @@ render_as_ihtml <- function(data, id) { styles_tbl <- dt_styles_get(data = data) body_styles_tbl <- dplyr::filter(styles_tbl, locname %in% c("data", "stub")) body_styles_tbl <- dplyr::arrange(body_styles_tbl, colnum, rownum) - body_styles_tbl <- dplyr::select(body_styles_tbl, colname, rownum, html_style) + body_styles_tbl <- dplyr::select(body_styles_tbl, "colname", "rownum", "html_style") # Generate styling rule per combination of `colname` and # `rownum` in `body_styles_tbl` @@ -433,13 +464,17 @@ render_as_ihtml <- function(data, id) { # Generate the table header if there are any heading components if (has_header_section) { + # These don't work in non-interactive context. + heading_title_font_weight <- opt_val(data, "heading_title_font_weight") + heading_subtitle_font_weight <- opt_val(data, "heading_subtitle_font_weight") + heading_background_color <- opt_val(data, "heading_background_color") tbl_heading <- dt_heading_get(data = data) - heading_component <- htmltools::div( style = htmltools::css( `font-family` = font_family_str, + `background-color` = heading_background_color, `border-top-style` = "solid", `border-top-width` = "2px", `border-top-color` = "#D3D3D3", @@ -447,7 +482,10 @@ render_as_ihtml <- function(data, id) { ), htmltools::div( class = "gt_heading gt_title gt_font_normal", - style = htmltools::css(`text-size` = "bigger"), + style = htmltools::css( + `text-size` = "bigger", + `font-weight` = heading_title_font_weight + ), htmltools::HTML(tbl_heading$title) ), htmltools::div( @@ -455,6 +493,9 @@ render_as_ihtml <- function(data, id) { "gt_heading", "gt_subtitle", if (use_search) "gt_bottom_border" else NULL ), + style = htmltools::css( + `font-weight` = heading_subtitle_font_weight + ), htmltools::HTML(tbl_heading$subtitle) ) ) @@ -478,6 +519,8 @@ render_as_ihtml <- function(data, id) { footnotes_component <- NULL } + table_border_bottom_style <- opt_val(data, "table_border_bottom_style") + footer_component <- htmltools::div( style = htmltools::css( @@ -485,7 +528,7 @@ render_as_ihtml <- function(data, id) { `border-top-style` = "solid", `border-top-width` = "2px", `border-top-color` = "#D3D3D3", - `border-bottom-style` = "solid", + `border-bottom-style` = table_border_bottom_style, `border-bottom-width` = "2px", `border-bottom-color` = "#D3D3D3", `padding-top` = "6px", @@ -544,6 +587,7 @@ render_as_ihtml <- function(data, id) { headerClass = NULL, headerStyle = list( fontWeight = "normal", + color = if (is.na(column_labels_background_color)) NULL else unname(ideal_fgnd_color(column_labels_background_color)), backgroundColor = column_labels_background_color, borderBottomStyle = column_labels_border_bottom_style, borderBottomWidth = column_labels_border_bottom_width, @@ -575,10 +619,15 @@ render_as_ihtml <- function(data, id) { #1693 fontSize = table_font_size ), - tableStyle = list( - borderTopStyle = column_labels_border_top_style, - borderTopWidth = column_labels_border_top_width, - borderTopColor = column_labels_border_top_color + # borders in the body + rowStyle = list( + fontWeight = table_body_font_weight, + borderTopStyle = table_body_hlines_style, + borderTopColor = table_body_hlines_color, + borderTopWidth = table_body_hlines_width, + BorderRightStyle = table_body_vlines_style, + BorderRightColor = table_body_vlines_color, + BorderRightWidth = table_body_vlines_width ), # cells_column_labels() headerStyle = list( @@ -597,19 +646,30 @@ render_as_ihtml <- function(data, id) { borderBottomWidth = column_labels_border_bottom_width, borderBottomColor = column_labels_border_bottom_color ), - tableBodyStyle = NULL, + # body = table + tableStyle = list( + borderRightStyle = table_border_right_style, + borderRightColor = table_border_right_color, + borderLeftStyle = table_border_left_style, + borderLeftColor = table_border_right_style, + borderBttomColor = heading_border_bottom_color + ), # stub styling? # rowGroupStyle = list( + # backgroundColor = row_group_background_color, # fontWeight = row_group_font_weight # ), - rowStyle = NULL, + # exclude pagination and search + tableBodyStyle = NULL, rowStripedStyle = NULL, rowHighlightStyle = NULL, rowSelectedStyle = NULL, # cells_body styling - cellStyle = list( - fontWeight = table_body_font_weight - ), + # cellStyle = list( + # fontWeight = table_body_font_weight, + # backgroundColor = table_background_color + # ), + # grand_summary style footerStyle = NULL, inputStyle = NULL, filterInputStyle = NULL, @@ -647,7 +707,7 @@ render_as_ihtml <- function(data, id) { showPagination = use_pagination, showPageInfo = use_pagination_info, minRows = 1, - paginateSubRows = FALSE, + paginateSubRows = TRUE, details = NULL, defaultExpanded = expand_groupname_col, selection = NULL, diff --git a/man/constants.Rd b/man/constants.Rd index 21804e0296..a55df465a7 100644 --- a/man/constants.Rd +++ b/man/constants.Rd @@ -47,6 +47,9 @@ DATA-12 \code{v0.10.0} (October 7, 2023) } +\examples{ +dplyr::glimpse(constants) +} \seealso{ Other datasets: \code{\link{countrypops}}, diff --git a/man/exibble.Rd b/man/exibble.Rd index d3e0f4550a..affb088933 100644 --- a/man/exibble.Rd +++ b/man/exibble.Rd @@ -48,6 +48,9 @@ DATA-6 \code{v0.2.0.5} (March 31, 2020) } +\examples{ +exibble +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/films.Rd b/man/films.Rd index cca7ed4123..900da6a2d1 100644 --- a/man/films.Rd +++ b/man/films.Rd @@ -51,6 +51,9 @@ DATA-9 \code{v0.11.0} (July 9, 2024) } +\examples{ +dplyr::glimpse(films) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/gibraltar.Rd b/man/gibraltar.Rd index 3d3fb96c78..bb81cdb4ce 100644 --- a/man/gibraltar.Rd +++ b/man/gibraltar.Rd @@ -44,6 +44,9 @@ DATA-11 \code{v0.11.0} (July 9, 2024) } +\examples{ +dplyr::glimpse(gibraltar) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/gtcars.Rd b/man/gtcars.Rd index 41b0b429ad..45a995de93 100644 --- a/man/gtcars.Rd +++ b/man/gtcars.Rd @@ -61,6 +61,9 @@ DATA-3 \code{v0.2.0.5} (March 31, 2020) } +\examples{ +dplyr::glimpse(gtcars) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/illness.Rd b/man/illness.Rd index 18f7e209f6..cf6f62e34c 100644 --- a/man/illness.Rd +++ b/man/illness.Rd @@ -90,6 +90,9 @@ DATA-13 \code{v0.10.0} (October 7, 2023) } +\examples{ +dplyr::glimpse(illness) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/metro.Rd b/man/metro.Rd index 0b31c6ce9f..0d9e8555c2 100644 --- a/man/metro.Rd +++ b/man/metro.Rd @@ -73,6 +73,9 @@ DATA-10 \code{v0.9.0} (Mar 31, 2023) } +\examples{ +dplyr::glimpse(metro) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/nuclides.Rd b/man/nuclides.Rd index ac30f1e189..a40cf5b62e 100644 --- a/man/nuclides.Rd +++ b/man/nuclides.Rd @@ -59,6 +59,9 @@ DATA-16 \code{v0.11.0} (July 9, 2024) } +\examples{ +dplyr::glimpse(nuclides) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/peeps.Rd b/man/peeps.Rd index f6d97ee2db..167b4e6478 100644 --- a/man/peeps.Rd +++ b/man/peeps.Rd @@ -56,6 +56,9 @@ DATA-8 \code{v0.11.0} (July 9, 2024) } +\examples{ +dplyr::glimpse(peeps) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/photolysis.Rd b/man/photolysis.Rd index 0b829bc1e7..2d0b949410 100644 --- a/man/photolysis.Rd +++ b/man/photolysis.Rd @@ -57,6 +57,9 @@ DATA-15 \code{v0.11.0} (July 9, 2024) } +\examples{ +dplyr::glimpse(photolysis) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/pizzaplace.Rd b/man/pizzaplace.Rd index 425f43fe1b..3fedce7d7f 100644 --- a/man/pizzaplace.Rd +++ b/man/pizzaplace.Rd @@ -135,6 +135,9 @@ DATA-5 \code{v0.2.0.5} (March 31, 2020) } +\examples{ +dplyr::glimpse(pizzaplace) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/reactions.Rd b/man/reactions.Rd index 1bd838741c..b8e2b76923 100644 --- a/man/reactions.Rd +++ b/man/reactions.Rd @@ -102,6 +102,9 @@ DATA-14 \code{v0.11.0} (July 9, 2024) } +\examples{ +dplyr::glimpse(reactions) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/rx_addv.Rd b/man/rx_addv.Rd index 22df88e8f5..7626d4b986 100644 --- a/man/rx_addv.Rd +++ b/man/rx_addv.Rd @@ -71,6 +71,9 @@ DATA-18 \code{v0.9.0} (Mar 31, 2023) } +\examples{ +dplyr::glimpse(rx_addv) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/rx_adsl.Rd b/man/rx_adsl.Rd index 4e87536248..42aca7786a 100644 --- a/man/rx_adsl.Rd +++ b/man/rx_adsl.Rd @@ -68,6 +68,9 @@ DATA-17 \code{v0.9.0} (Mar 31, 2023) } +\examples{ +dplyr::glimpse(rx_adsl) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/sp500.Rd b/man/sp500.Rd index 9108bbe783..d002c30c95 100644 --- a/man/sp500.Rd +++ b/man/sp500.Rd @@ -37,6 +37,9 @@ DATA-4 \code{v0.2.0.5} (March 31, 2020) } +\examples{ +dplyr::glimpse(sp500) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/sza.Rd b/man/sza.Rd index 20764e3379..91b79a22e8 100644 --- a/man/sza.Rd +++ b/man/sza.Rd @@ -58,6 +58,9 @@ DATA-2 \code{v0.2.0.5} (March 31, 2020) } +\examples{ +dplyr::glimpse(sza) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/man/towny.Rd b/man/towny.Rd index 8d126483dc..3ea361ac01 100644 --- a/man/towny.Rd +++ b/man/towny.Rd @@ -72,6 +72,9 @@ DATA-7 \code{v0.9.0} (Mar 31, 2023) } +\examples{ +dplyr::glimpse(towny) +} \seealso{ Other datasets: \code{\link{constants}}, diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 0b99d01b20..d3db85ecc1 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -391,6 +391,7 @@ articles: - title: Get started navbar: ~ contents: + - gt - creating-summary-lines - title: Case studies navbar: Case studies @@ -399,6 +400,7 @@ articles: - case-study-clinical-tables - title: Datasets + navbar: Datasets contents: - gt-datasets - title: Visual tests diff --git a/vignettes/gt-interactive.qmd b/vignettes/gt-interactive.qmd index c3594bf7c9..1a9ea153cf 100644 --- a/vignettes/gt-interactive.qmd +++ b/vignettes/gt-interactive.qmd @@ -1,6 +1,7 @@ --- title: "gt interactive tables" format: html +html-table-processing: none description: > An overview of interactive tables with gt --- @@ -21,9 +22,20 @@ It also provides an interactive to creating gt tables as plots. Let's use the following base for our gt table. ```{r} -library(gt) + devtools::load_all("~/rrr-forks/gt") +#library(gt) gt_tbl <- exibble |> - gt() + gt(groupname_col = "group", rowname_col = "row") |> + tab_header( + "Title" + ) |> + tab_footnote( + "A footnote" + ) |> + tab_spanner( + "Spanner", + columns = c(date, time) + ) ``` To create an interactive table, you have simply have to pipe `opt_interactive()` to your existing gt pipeline. @@ -39,7 +51,21 @@ gt_tbl |> ## Examples -![](images/clipboard-2210070624.png) +Some styling is respected in `opt_interactive()` + +```{r} +styled <- gt_tbl |> + tab_options( + heading.title.font.weight = "bold", + stub.background.color = "lightblue", + table.border.bottom.style = "dotted" + ) +styled +``` + +```{r} +styled %>% opt_interactive() +``` # Current limitations diff --git a/vignettes/gt.Rmd b/vignettes/gt.Rmd index bdb5067675..de2c9db64f 100644 --- a/vignettes/gt.Rmd +++ b/vignettes/gt.Rmd @@ -122,7 +122,7 @@ gt_tbl <- gt_tbl ``` -Footnotes live inside the **Footer** part and their footnote marks are attached to cell data. Footnotes are added with `tab_footnote()`. The helper function `cells_body()` can be used with the `location` argument to specify which data cells should be the target of the footnote. `cells_body()` has the two arguments `columns` and `rows`. For each of these, we can supply (1) a vector of colnames or rownames, (2) a vector of column/row indices, (3) bare column names wrapped in `c()` or row labels within `c()`, or (4) a select helper function (`starts_with()`, `ends_with()`, `contains()`, `matches()`, `one_of()`, and `everything()`). For `rows` specifically, we can use a conditional statement with column names as variables (e.g., `size > 15000`). +Footnotes live inside the **Footer** part and their footnote marks are attached to cell data. Footnotes are added with `tab_footnote()`. The helper function `cells_body()` can be used with the `location` argument to specify which data cells should be the target of the footnote. `cells_body()` has the two arguments `columns` and `rows`. For each of these, we can supply (1) a vector of colnames or rownames, (2) a vector of column/row indices, (3) bare column names wrapped in `c()` or row labels within `c()`, or (4) a select helper function (`starts_with()`, `ends_with()`, `contains()`, `matches()`, `all_of()`, and `everything()`). For `rows` specifically, we can use a conditional statement with column names as variables (e.g., `size > 15000`). Here is a simple example on how a footnotes can be added to a table cell. Let's add a footnote that references the `North America` and `South America` cells in the `name` column: From 27e99131214a1882a2d7933477500f93f4c65654 Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 5 Aug 2024 09:16:35 -0400 Subject: [PATCH 09/16] Test for title border and subtitle border --- R/render_as_i_html.R | 10 +++++++--- vignettes/gt-interactive.qmd | 33 +++++++++++++++++++++++++++++++-- 2 files changed, 38 insertions(+), 5 deletions(-) diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index 3be089e9ba..3e5a839c70 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -380,7 +380,7 @@ render_as_ihtml <- function(data, id) { borderStyle = "none", borderColor = "transparent", borderTopColor = "transparent", - borderBottomColor = "transparent" + borderBottomColor = "gray38" ), # The total number of rows is wrong in colGroup, possibly due to the JS fn grouped = grp_fn, @@ -478,6 +478,7 @@ render_as_ihtml <- function(data, id) { `border-top-style` = "solid", `border-top-width` = "2px", `border-top-color` = "#D3D3D3", + `border-bottom-color` = "#D3D3D3", `padding-bottom` = if (use_search) "8px" else NULL ), htmltools::div( @@ -494,7 +495,8 @@ render_as_ihtml <- function(data, id) { if (use_search) "gt_bottom_border" else NULL ), style = htmltools::css( - `font-weight` = heading_subtitle_font_weight + `font-weight` = heading_subtitle_font_weight, + `border-bottom-color` = "#D3D3D3" ), htmltools::HTML(tbl_heading$subtitle) ) @@ -635,7 +637,9 @@ render_as_ihtml <- function(data, id) { backgroundColor = column_labels_background_color, borderBottomStyle = column_labels_border_bottom_style, borderBottomWidth = column_labels_border_bottom_width, - borderBottomColor = column_labels_border_bottom_color + borderBottomColor = column_labels_border_bottom_color, + borderTopColor = "transparent", + borderTopStyle = "none" ), # individually defined for the margins left+right # cells_spanner_labels() styling diff --git a/vignettes/gt-interactive.qmd b/vignettes/gt-interactive.qmd index 1a9ea153cf..a65cb454fe 100644 --- a/vignettes/gt-interactive.qmd +++ b/vignettes/gt-interactive.qmd @@ -27,7 +27,8 @@ Let's use the following base for our gt table. gt_tbl <- exibble |> gt(groupname_col = "group", rowname_col = "row") |> tab_header( - "Title" + "Title", + "Subtitle" ) |> tab_footnote( "A footnote" @@ -40,15 +41,23 @@ gt_tbl <- exibble |> To create an interactive table, you have simply have to pipe `opt_interactive()` to your existing gt pipeline. +::: {.panel-tabset} + +## Html + ```{r} gt_tbl ``` +## Interactive + ```{r} gt_tbl |> opt_interactive() ``` +::: + ## Examples Some styling is respected in `opt_interactive()` @@ -58,15 +67,35 @@ styled <- gt_tbl |> tab_options( heading.title.font.weight = "bold", stub.background.color = "lightblue", - table.border.bottom.style = "dotted" + table.border.bottom.style = "dotted", + column_labels.background.color = "pink", + table.font.weight = "italic", + stub.font.weight = "bolder", + table_body.vlines.color = "brown", + table_body.vlines.style = "dashed" ) +``` + +::: {.panel-tabset} +## Html + +```{r} +#| echo: false styled ``` +## Interactive + ```{r} +#| echo: false styled %>% opt_interactive() ``` +::: + + + + # Current limitations - Some features like `tab_style()` may not be fully supported. From 8578da7416a34ef58ba5c02cd79702e7e7803edd Mon Sep 17 00:00:00 2001 From: olivroy Date: Wed, 7 Aug 2024 06:46:04 -0400 Subject: [PATCH 10/16] Add styling for interactive tables --- NEWS.md | 4 +- R/render_as_i_html.R | 124 +++++++++++++++++++++++++++-------- vignettes/gt-interactive.qmd | 72 ++++++++++++++++++-- 3 files changed, 164 insertions(+), 36 deletions(-) diff --git a/NEWS.md b/NEWS.md index 7517dd7524..99c1729954 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,12 +6,12 @@ ## Interactive table support -* Interactive tables will show no border if `opt_table_lines(extent = "none")` is specified (#1307). +* Interactive tables respect`opt_table_lines(extent = "none")` and `opt_table_lines(extent = "all")` is specified (#1307). * Interactive tables now respect more styling options. * `column_labels.background.color`, `row_group.background.color`, `row_group.font.weight`, `table_body.hlines.style`, - `table.font.weight`, `table.font.size`, `stub.font.weight` (#1693). + `table.font.weight`, `table.font.size`, `stub.font.weight`, `stub_background.color` (#1693). * `opt_interactive()` now works when columns are merged with `cols_merge()` (@olivroy, #1785). diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index ca711f43dc..a09f92f53c 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -171,8 +171,16 @@ render_as_ihtml <- function(data, id) { table_width <- opt_val(data = data, option = "table_width") table_background_color <- opt_val(data = data, option = "table_background_color") + table_font_size <- opt_val(data = data, "table_font_size") table_font_names <- opt_val(data = data, option = "table_font_names") table_font_color <- opt_val(data = data, option = "table_font_color") + table_border_right_style <- opt_val(data, "table_border_right_style") + table_border_right_color <- opt_val(data, "table_border_right_color") + table_border_left_style <- opt_val(data, "table_border_left_style") + table_border_left_color <- opt_val(data, "table_border_left_color") + table_border_top_color <- opt_val(data, "table_border_top_color") + + heading_border_bottom_color <- opt_val(data, "heading_border_bottom_color") column_labels_border_top_style <- opt_val(data = data, option = "column_labels_border_top_style") column_labels_border_top_width <- opt_val(data = data, option = "column_labels_border_top_width") @@ -180,26 +188,40 @@ render_as_ihtml <- function(data, id) { column_labels_border_bottom_style <- opt_val(data = data, option = "column_labels_border_bottom_style") column_labels_border_bottom_width <- opt_val(data = data, option = "column_labels_border_bottom_width") column_labels_border_bottom_color <- opt_val(data = data, option = "column_labels_border_bottom_color") + # Don't allow NA column_labels_background_color <- opt_val(data = data, option = "column_labels_background_color") - # Apply stub font weight to - stub_font_weight <- opt_val(data = data, option = "stub_font_weight") - if (is.na(column_labels_background_color)) { # apply all column labels formatting to both heading + groupCol styling (nothing specific for spanners styling in gt?) column_labels_background_color <- "transparent" } - # Part of #1307 - borderless_borders <- opt_val(data = data, option = "table_body_hlines_style") == "none" column_labels_font_weight <- opt_val(data = data, option = "column_labels_font_weight") + # Apply stub font weight to + stub_font_weight <- opt_val(data = data, option = "stub_font_weight") # Apply font weight to groupname_col title - row_group_font_weight <- opt_val(data = data, "row_group_font_weight") - table_body_font_weight <- opt_val(data = data, "table_font_weight") + row_group_font_weight <- opt_val(data = data, "row_group_font_weight") + row_group_background_color <- opt_val(data = data, "row_group_background_color") + + table_body_font_weight <- opt_val(data = data, "table_font_weight") + table_body_hlines_style <- opt_val(data = data, "table_body_hlines_style") + table_body_hlines_color <- opt_val(data = data, "table_body_hlines_color") + table_body_hlines_width <- opt_val(data = data, "table_body_hlines_width") + table_body_vlines_style <- opt_val(data = data, "table_body_vlines_style") + table_body_vlines_color <- opt_val(data = data, "table_body_vlines_color") + table_body_vlines_width <- opt_val(data = data, "table_body_vlines_width") + + horizontal_borders <- opt_val(data = data, option = "table_body_hlines_style") + veritcal_borders <- opt_val(data = data, option = "table_body_vlines_style") + borderless_borders <- horizontal_borders == "none" && veritcal_borders == "none" + all_borders <- horizontal_borders != "none" && veritcal_borders != "none" + # for row names + summary label - stub_font_weight <- opt_val(data = data, "stub_font_weight") - # #1693 table font size - table_font_size <- opt_val(data = data, "table_font_size") + stub_border_color <- opt_val(data, "stub_border_color") + stub_border_style <- opt_val(data, "stub_border_style") + # Apply stub font weight to + stub_font_weight <- opt_val(data = data, option = "stub_font_weight") + stub_background_color <- opt_val(data = data, option = "stub_background_color") emoji_symbol_fonts <- c( @@ -222,7 +244,13 @@ render_as_ihtml <- function(data, id) { row_name_col_def <- list(reactable::colDef( name = rowname_label, style = list( - fontWeight = stub_font_weight + fontWeight = stub_font_weight, + color = if (!is.na(stub_background_color)) unname(ideal_fgnd_color(stub_background_color)) else NULL, + borderRight = stub_border_color, + borderRightStyle = stub_border_style, + backgroundColor = stub_background_color#, + + # borderLeft, borderRight are possible ) # TODO pass on other attributes of row names column if necessary. )) @@ -347,7 +375,13 @@ render_as_ihtml <- function(data, id) { reactable::colDef( name = group_label, style = list( - `font-weight` = row_group_font_weight + `font-weight` = row_group_font_weight, + color = if (is.na(row_group_background_color)) NULL else unname(ideal_fgnd_color(row_group_background_colorfgggee )), + backgroundColor = row_group_background_color, + borderStyle = "none", + borderColor = "transparent", + borderTopColor = "transparent", + borderBottomColor = "gray38" ), # The total number of rows is wrong in colGroup, possibly due to the JS fn grouped = grp_fn, @@ -382,7 +416,7 @@ render_as_ihtml <- function(data, id) { styles_tbl <- dt_styles_get(data = data) body_styles_tbl <- dplyr::filter(styles_tbl, locname %in% c("data", "stub")) body_styles_tbl <- dplyr::arrange(body_styles_tbl, colnum, rownum) - body_styles_tbl <- dplyr::select(body_styles_tbl, colname, rownum, html_style) + body_styles_tbl <- dplyr::select(body_styles_tbl, "colname", "rownum", "html_style") # Generate styling rule per combination of `colname` and # `rownum` in `body_styles_tbl` @@ -431,21 +465,29 @@ render_as_ihtml <- function(data, id) { # Generate the table header if there are any heading components if (has_header_section) { + # These don't work in non-interactive context. + heading_title_font_weight <- opt_val(data, "heading_title_font_weight") + heading_subtitle_font_weight <- opt_val(data, "heading_subtitle_font_weight") + heading_background_color <- opt_val(data, "heading_background_color") tbl_heading <- dt_heading_get(data = data) - heading_component <- htmltools::div( style = htmltools::css( `font-family` = font_family_str, + `background-color` = heading_background_color, `border-top-style` = "solid", `border-top-width` = "2px", `border-top-color` = "#D3D3D3", + `border-bottom-color` = "#D3D3D3", `padding-bottom` = if (use_search) "8px" else NULL ), htmltools::div( class = "gt_heading gt_title gt_font_normal", - style = htmltools::css(`text-size` = "bigger"), + style = htmltools::css( + `text-size` = "bigger", + `font-weight` = heading_title_font_weight + ), htmltools::HTML(tbl_heading$title) ), htmltools::div( @@ -453,6 +495,10 @@ render_as_ihtml <- function(data, id) { "gt_heading", "gt_subtitle", if (use_search) "gt_bottom_border" else NULL ), + style = htmltools::css( + `font-weight` = heading_subtitle_font_weight, + `border-bottom-color` = "#D3D3D3" + ), htmltools::HTML(tbl_heading$subtitle) ) ) @@ -476,6 +522,8 @@ render_as_ihtml <- function(data, id) { footnotes_component <- NULL } + table_border_bottom_style <- opt_val(data, "table_border_bottom_style") + footer_component <- htmltools::div( style = htmltools::css( @@ -483,7 +531,7 @@ render_as_ihtml <- function(data, id) { `border-top-style` = "solid", `border-top-width` = "2px", `border-top-color` = "#D3D3D3", - `border-bottom-style` = "solid", + `border-bottom-style` = table_border_bottom_style, `border-bottom-width` = "2px", `border-bottom-color` = "#D3D3D3", `padding-top` = "6px", @@ -542,6 +590,7 @@ render_as_ihtml <- function(data, id) { headerClass = NULL, headerStyle = list( fontWeight = "normal", + color = if (is.na(column_labels_background_color)) NULL else unname(ideal_fgnd_color(column_labels_background_color)), backgroundColor = column_labels_background_color, borderBottomStyle = column_labels_border_bottom_style, borderBottomWidth = column_labels_border_bottom_width, @@ -573,10 +622,15 @@ render_as_ihtml <- function(data, id) { #1693 fontSize = table_font_size ), - tableStyle = list( - borderTopStyle = column_labels_border_top_style, - borderTopWidth = column_labels_border_top_width, - borderTopColor = column_labels_border_top_color + # borders in the body + rowStyle = list( + fontWeight = table_body_font_weight, + borderTopStyle = table_body_hlines_style, + borderTopColor = table_body_hlines_color, + borderTopWidth = table_body_hlines_width, + BorderRightStyle = table_body_vlines_style, + BorderRightColor = table_body_vlines_color, + BorderRightWidth = table_body_vlines_width ), # cells_column_labels() headerStyle = list( @@ -584,7 +638,9 @@ render_as_ihtml <- function(data, id) { backgroundColor = column_labels_background_color, borderBottomStyle = column_labels_border_bottom_style, borderBottomWidth = column_labels_border_bottom_width, - borderBottomColor = column_labels_border_bottom_color + borderBottomColor = column_labels_border_bottom_color, + borderTopColor = "transparent", + borderTopStyle = "none" ), # individually defined for the margins left+right # cells_spanner_labels() styling @@ -595,19 +651,30 @@ render_as_ihtml <- function(data, id) { borderBottomWidth = column_labels_border_bottom_width, borderBottomColor = column_labels_border_bottom_color ), - tableBodyStyle = NULL, + # body = table + tableStyle = list( + borderRightStyle = table_border_right_style, + borderRightColor = table_border_right_color, + borderLeftStyle = table_border_left_style, + borderLeftColor = table_border_right_style, + borderBttomColor = heading_border_bottom_color + ), # stub styling? # rowGroupStyle = list( + # backgroundColor = row_group_background_color, # fontWeight = row_group_font_weight # ), - rowStyle = NULL, + # exclude pagination and search + tableBodyStyle = NULL, rowStripedStyle = NULL, rowHighlightStyle = NULL, rowSelectedStyle = NULL, # cells_body styling - cellStyle = list( - fontWeight = table_body_font_weight - ), + # cellStyle = list( + # fontWeight = table_body_font_weight, + # backgroundColor = table_background_color + # ), + # grand_summary style footerStyle = NULL, inputStyle = NULL, filterInputStyle = NULL, @@ -645,7 +712,7 @@ render_as_ihtml <- function(data, id) { showPagination = use_pagination, showPageInfo = use_pagination_info, minRows = 1, - paginateSubRows = FALSE, + paginateSubRows = TRUE, details = NULL, defaultExpanded = expand_groupname_col, selection = NULL, @@ -654,7 +721,8 @@ render_as_ihtml <- function(data, id) { onClick = NULL, highlight = use_highlight, outlined = FALSE, - bordered = FALSE, + # equivalent to opt_table_lines(extent = "all") + bordered = all_borders, # equivalent to opt_table_lines(extent = "none") borderless = borderless_borders, striped = use_row_striping, diff --git a/vignettes/gt-interactive.qmd b/vignettes/gt-interactive.qmd index 1697037523..a65cb454fe 100644 --- a/vignettes/gt-interactive.qmd +++ b/vignettes/gt-interactive.qmd @@ -1,6 +1,7 @@ --- title: "gt interactive tables" format: html +html-table-processing: none description: > An overview of interactive tables with gt --- @@ -10,6 +11,8 @@ knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) +# generate the same table ID +set.seed(112) ``` gt provides an option to make interactive html tables via the [reactable](https://glin.github.io/reactable/index.html) package. @@ -19,27 +22,84 @@ It also provides an interactive to creating gt tables as plots. Let's use the following base for our gt table. ```{r} -library(gt) + devtools::load_all("~/rrr-forks/gt") +#library(gt) gt_tbl <- exibble |> - gt() + gt(groupname_col = "group", rowname_col = "row") |> + tab_header( + "Title", + "Subtitle" + ) |> + tab_footnote( + "A footnote" + ) |> + tab_spanner( + "Spanner", + columns = c(date, time) + ) ``` To create an interactive table, you have simply have to pipe `opt_interactive()` to your existing gt pipeline. +::: {.panel-tabset} + +## Html + ```{r} gt_tbl ``` +## Interactive + ```{r} gt_tbl |> opt_interactive() ``` -# Current limitations +::: + +## Examples + +Some styling is respected in `opt_interactive()` + +```{r} +styled <- gt_tbl |> + tab_options( + heading.title.font.weight = "bold", + stub.background.color = "lightblue", + table.border.bottom.style = "dotted", + column_labels.background.color = "pink", + table.font.weight = "italic", + stub.font.weight = "bolder", + table_body.vlines.color = "brown", + table_body.vlines.style = "dashed" + ) +``` + +::: {.panel-tabset} +## Html + +```{r} +#| echo: false +styled +``` + +## Interactive + +```{r} +#| echo: false +styled %>% opt_interactive() +``` -* Some features like `tab_style()` may not be fully supported. +::: + + + + +# Current limitations -* `summary_rows()` and `grand_summary_rows()` have yet to be implemented. +- Some features like `tab_style()` may not be fully supported. -* Your interactive table may be visually different from your non-interactive table. +- `summary_rows()` and `grand_summary_rows()` have yet to be implemented. +- Your interactive table may be visually different from your non-interactive table. From d0e9dea16cb8f16daf2a05ca9ab7be53108f0330 Mon Sep 17 00:00:00 2001 From: olivroy Date: Mon, 26 Aug 2024 10:26:19 -0400 Subject: [PATCH 11/16] fix path [ci skip] --- vignettes/gt-interactive.qmd | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/vignettes/gt-interactive.qmd b/vignettes/gt-interactive.qmd index 6c2806caaf..608e1e1c47 100644 --- a/vignettes/gt-interactive.qmd +++ b/vignettes/gt-interactive.qmd @@ -12,6 +12,15 @@ knitr::opts_chunk$set( comment = "#>" ) set.seed(123) + +# for easier testing +if (isTRUE(as.logical(Sys.getenv("CI", "false"))) || identical(Sys.getenv("IN_PKGDOWN"), "true") +) { + library(gt) +} else { + # allow easier testing with the render button. + devtools::load_all(".") +} ``` gt provides an option to make interactive html tables via the [reactable](https://glin.github.io/reactable/index.html) package. @@ -21,8 +30,7 @@ It also provides an interactive to creating gt tables as plots. Let's use the following base for our gt table. ```{r} - devtools::load_all("~/rrr-forks/gt") -#library(gt) + gt_tbl <- exibble |> gt(groupname_col = "group", rowname_col = "row") |> tab_header( From dc2abc91c7ddf3289cf620926d917ec4f4f6659c Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 30 Aug 2024 11:09:58 -0400 Subject: [PATCH 12/16] Refactor accessing options --- R/dt_options.R | 7 +++ R/render_as_i_html.R | 118 ++++++++++++++++++++++--------------------- 2 files changed, 67 insertions(+), 58 deletions(-) diff --git a/R/dt_options.R b/R/dt_options.R index fedf835ea0..859629dc0a 100644 --- a/R/dt_options.R +++ b/R/dt_options.R @@ -49,6 +49,13 @@ dt_options_get_value <- function(data, option) { dt_options$value[[which(dt_options$parameter == option)]] } +# Get a list of option values +dt_options_get_values <- function(data) { + dt_options <- dt_options_get(data = data)[c(1, 2)] + # Similar to tibble::deframe + vctrs::vec_set_names(dt_options$value, dt_options$parameter) +} + default_fonts_vec <- c( "system-ui", "Segoe UI", "Roboto", "Helvetica", "Arial", "sans-serif", diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index 554d0cc1c5..7f4bfeab69 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -171,78 +171,80 @@ render_as_ihtml <- function(data, id) { } # Get options settable in `tab_options()` - opt_val <- dt_options_get_value - height <- opt_val(data = data, option = "ihtml_height") - use_pagination <- opt_val(data = data, option = "ihtml_use_pagination") - use_pagination_info <- opt_val(data = data, option = "ihtml_use_pagination_info") - use_search <- opt_val(data = data, option = "ihtml_use_search") - use_sorting <- opt_val(data = data, option = "ihtml_use_sorting") - use_filters <- opt_val(data = data, option = "ihtml_use_filters") - use_resizers <- opt_val(data = data, option = "ihtml_use_resizers") - use_highlight <- opt_val(data = data, option = "ihtml_use_highlight") - use_compact_mode <- opt_val(data = data, option = "ihtml_use_compact_mode") - use_text_wrapping <- opt_val(data = data, option = "ihtml_use_text_wrapping") - use_page_size_select <- opt_val(data = data, option = "ihtml_use_page_size_select") - page_size_default <- opt_val(data = data, option = "ihtml_page_size_default") - page_size_values <- opt_val(data = data, option = "ihtml_page_size_values") - pagination_type <- opt_val(data = data, option = "ihtml_pagination_type") - - use_row_striping <- opt_val(data = data, option = "row_striping_include_table_body") - row_striping_color <- opt_val(data = data, option = "row_striping_background_color") - - table_width <- opt_val(data = data, option = "table_width") - table_background_color <- opt_val(data = data, option = "table_background_color") - table_font_size <- opt_val(data = data, "table_font_size") - table_font_names <- opt_val(data = data, option = "table_font_names") - table_font_color <- opt_val(data = data, option = "table_font_color") - table_border_right_style <- opt_val(data, "table_border_right_style") - table_border_right_color <- opt_val(data, "table_border_right_color") - table_border_left_style <- opt_val(data, "table_border_left_style") - table_border_left_color <- opt_val(data, "table_border_left_color") - table_border_top_color <- opt_val(data, "table_border_top_color") - - heading_border_bottom_color <- opt_val(data, "heading_border_bottom_color") - - column_labels_border_top_style <- opt_val(data = data, option = "column_labels_border_top_style") - column_labels_border_top_width <- opt_val(data = data, option = "column_labels_border_top_width") - column_labels_border_top_color <- opt_val(data = data, option = "column_labels_border_top_color") - column_labels_border_bottom_style <- opt_val(data = data, option = "column_labels_border_bottom_style") - column_labels_border_bottom_width <- opt_val(data = data, option = "column_labels_border_bottom_width") - column_labels_border_bottom_color <- opt_val(data = data, option = "column_labels_border_bottom_color") + tbl_opts <- dt_options_get_values(data) + + # get some options + height <- tbl_opts$ihtml_height + use_pagination <- tbl_opts$ihtml_use_pagination + use_pagination_info <- tbl_opts$ihtml_use_pagination_info + use_search <- tbl_opts$ihtml_use_search + use_sorting <- tbl_opts$ihtml_use_sorting + use_filters <- tbl_opts$ihtml_use_filters + use_resizers <- tbl_opts$ihtml_use_resizers + use_highlight <- tbl_opts$ihtml_use_highlight + use_compact_mode <- tbl_opts$ihtml_use_compact_mode + use_text_wrapping <- tbl_opts$ihtml_use_text_wrapping + use_page_size_select <- tbl_opts$ihtml_use_page_size_select + page_size_default <- tbl_opts$ihtml_page_size_default + page_size_values <- tbl_opts$ihtml_page_size_values + pagination_type <- tbl_opts$ihtml_pagination_type + + use_row_striping <- tbl_opts$row_striping_include_table_body + row_striping_color <- tbl_opts$row_striping_background_color + + table_width <- tbl_opts$table_width + table_background_color <- tbl_opts$table_background_color + table_font_size <- tbl_opts$table_font_size + table_font_names <- tbl_opts$table_font_names + table_font_color <- tbl_opts$table_font_color + table_border_right_style <- tbl_opts$table_border_right_style + table_border_right_color <- tbl_opts$table_border_right_color + table_border_left_style <- tbl_opts$table_border_left_style + table_border_left_color <- tbl_opts$table_border_left_color + table_border_top_color <- tbl_opts$table_border_top_color + + heading_border_bottom_color <- tbl_opts$heading_border_bottom_color + + column_labels_border_top_style <- tbl_opts$column_labels_border_top_style + column_labels_border_top_width <- tbl_opts$column_labels_border_top_width + column_labels_border_top_color <- tbl_opts$column_labels_border_top_color + column_labels_border_bottom_style <- tbl_opts$column_labels_border_bottom_style + column_labels_border_bottom_width <- tbl_opts$column_labels_border_bottom_width + column_labels_border_bottom_color <- tbl_opts$column_labels_border_bottom_color # Don't allow NA - column_labels_background_color <- opt_val(data = data, option = "column_labels_background_color") + column_labels_background_color <- tbl_opts$column_labels_background_color if (is.na(column_labels_background_color)) { # apply all column labels formatting to both heading + groupCol styling (nothing specific for spanners styling in gt?) column_labels_background_color <- "transparent" } - column_labels_font_weight <- opt_val(data = data, option = "column_labels_font_weight") + column_labels_font_weight <- tbl_opts$column_labels_font_weight # Apply stub font weight to - stub_font_weight <- opt_val(data = data, option = "stub_font_weight") + stub_font_weight <- tbl_opts$stub_font_weight # Apply font weight to groupname_col title - row_group_font_weight <- opt_val(data = data, "row_group_font_weight") - row_group_background_color <- opt_val(data = data, "row_group_background_color") - - table_body_font_weight <- opt_val(data = data, "table_font_weight") - table_body_hlines_style <- opt_val(data = data, "table_body_hlines_style") - table_body_hlines_color <- opt_val(data = data, "table_body_hlines_color") - table_body_hlines_width <- opt_val(data = data, "table_body_hlines_width") - table_body_vlines_style <- opt_val(data = data, "table_body_vlines_style") - table_body_vlines_color <- opt_val(data = data, "table_body_vlines_color") - table_body_vlines_width <- opt_val(data = data, "table_body_vlines_width") - - horizontal_borders <- opt_val(data = data, option = "table_body_hlines_style") - veritcal_borders <- opt_val(data = data, option = "table_body_vlines_style") + row_group_font_weight <- tbl_opts$row_group_font_weight + row_group_background_color <- tbl_opts$row_group_background_color + + table_body_font_weight <- tbl_opts$table_font_weight + table_body_hlines_style <- tbl_opts$table_body_hlines_style + table_body_hlines_color <- tbl_opts$table_body_hlines_color + table_body_hlines_width <- tbl_opts$table_body_hlines_width + table_body_vlines_style <- tbl_opts$table_body_vlines_style + table_body_vlines_color <- tbl_opts$table_body_vlines_color + table_body_vlines_width <- tbl_opts$table_body_vlines_width + + horizontal_borders <- tbl_opts$table_body_hlines_style + veritcal_borders <- tbl_opts$table_body_vlines_style borderless_borders <- horizontal_borders == "none" && veritcal_borders == "none" all_borders <- horizontal_borders != "none" && veritcal_borders != "none" # for row names + summary label - stub_border_color <- opt_val(data, "stub_border_color") - stub_border_style <- opt_val(data, "stub_border_style") + stub_border_color <- tbl_opts$stub_border_color + stub_border_style <- tbl_opts$stub_border_style # Apply stub font weight to - stub_font_weight <- opt_val(data = data, option = "stub_font_weight") - stub_background_color <- opt_val(data = data, option = "stub_background_color") + stub_font_weight <- tbl_opts$stub_font_weight + stub_background_color <- tbl_opts$stub_background_color emoji_symbol_fonts <- c( From 1dccf70acc86f8795cead6ed58610a6eaec8686c Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 30 Aug 2024 14:38:41 -0400 Subject: [PATCH 13/16] Be more strict when subsetting the options to make sure no typos occur (dev only) --- R/dt_options.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/R/dt_options.R b/R/dt_options.R index 859629dc0a..aabff9521f 100644 --- a/R/dt_options.R +++ b/R/dt_options.R @@ -53,7 +53,18 @@ dt_options_get_value <- function(data, option) { dt_options_get_values <- function(data) { dt_options <- dt_options_get(data = data)[c(1, 2)] # Similar to tibble::deframe - vctrs::vec_set_names(dt_options$value, dt_options$parameter) + res <- vctrs::vec_set_names(dt_options$value, dt_options$parameter) + class(res) <- c("gt_option", class(res)) + res +} + +#' @export +`$.gt_option` <- function(x, name) { + out <- .subset2(x, name) + if (is.null(out)) { + cli::cli_abort("Can't find option {.val {name}}.") + } + out } default_fonts_vec <- From b02144d650a94008d6ac1407ba340e0b6014f23d Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 30 Aug 2024 14:39:16 -0400 Subject: [PATCH 14/16] Some progress --- R/render_as_i_html.R | 70 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 55 insertions(+), 15 deletions(-) diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index 7f4bfeab69..605f5a2176 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -451,6 +451,7 @@ render_as_ihtml <- function(data, id) { # Generate styling rule per combination of `colname` and # `rownum` in `body_styles_tbl` + # TODO combine with table_body_hlines_width body_style_rules <- vapply( seq_len(nrow(body_styles_tbl)), FUN.VALUE = character(1L), USE.NAMES = FALSE, @@ -474,7 +475,6 @@ render_as_ihtml <- function(data, id) { ) body_style_rules <- paste(body_style_rules, collapse = "") - body_style_js_str <- paste0( "function(rowInfo, colInfo) {\n", @@ -487,7 +487,14 @@ render_as_ihtml <- function(data, id) { # TODO if `sub_missing()` is enabled gloablly, just use `na = ` here! default_col_def <- reactable::colDef( + style = reactable::JS(body_style_js_str), + # style = list( + # borderLeftStyle = tbl_opts$table_body_vlines_style, + # borderLeftColor = tbl_opts$table_body_vlines_color, + # borderLeftWidth = tbl_opts$table_body_vlines_width + # + # ), minWidth = 125, # Has no effect with sub_missing() na = "NA", @@ -497,9 +504,9 @@ render_as_ihtml <- function(data, id) { # Generate the table header if there are any heading components if (has_header_section) { # These don't work in non-interactive context. - heading_title_font_weight <- opt_val(data, "heading_title_font_weight") - heading_subtitle_font_weight <- opt_val(data, "heading_subtitle_font_weight") - heading_background_color <- opt_val(data, "heading_background_color") + heading_title_font_weight <- tbl_opts$heading_title_font_weight + heading_subtitle_font_weight <- tbl_opts$heading_subtitle_font_weight + heading_background_color <- tbl_opts$heading_background_color tbl_heading <- dt_heading_get(data = data) heading_component <- @@ -659,9 +666,15 @@ render_as_ihtml <- function(data, id) { borderTopStyle = table_body_hlines_style, borderTopColor = table_body_hlines_color, borderTopWidth = table_body_hlines_width, + borderBottomStyle = table_body_hlines_style, + borderBottomColor = table_body_hlines_color, + borderBottomWidth = table_body_hlines_width, BorderRightStyle = table_body_vlines_style, BorderRightColor = table_body_vlines_color, - BorderRightWidth = table_body_vlines_width + BorderRightWidth = table_body_vlines_width, + BorderLeftStyle = table_body_vlines_style, + BorderLeftColor = table_body_vlines_color, + BorderLeftWidth = table_body_vlines_width ), # cells_column_labels() headerStyle = list( @@ -670,8 +683,10 @@ render_as_ihtml <- function(data, id) { borderBottomStyle = column_labels_border_bottom_style, borderBottomWidth = column_labels_border_bottom_width, borderBottomColor = column_labels_border_bottom_color, - borderTopColor = "transparent", - borderTopStyle = "none" + borderTopColor = tbl_opts$column_labels_border_top_color + # + #borderTopColor = "transparent", + #borderTopStyle = "none" ), # individually defined for the margins left+right # cells_spanner_labels() styling @@ -680,23 +695,48 @@ render_as_ihtml <- function(data, id) { backgroundColor = column_labels_background_color, borderBottomStyle = column_labels_border_bottom_style, borderBottomWidth = column_labels_border_bottom_width, - borderBottomColor = column_labels_border_bottom_color + borderBottomColor = column_labels_border_bottom_color, + borderTopColor = tbl_opts$column_labels_border_top_color ), # body = table tableStyle = list( - borderRightStyle = table_border_right_style, - borderRightColor = table_border_right_color, - borderLeftStyle = table_border_left_style, - borderLeftColor = table_border_right_style, - borderBttomColor = heading_border_bottom_color + borderRightStyle = tbl_opts$table_body_vlines_style, + borderRightColor = tbl_opts$table_body_vlines_color, + borderRightWidth = tbl_opts$table_body_vlines_width, + borderLeftStyle = tbl_opts$table_body_vlines_style, + borderLeftColor = tbl_opts$table_body_vlines_color, + borderLeftWidth = tbl_opts$table_body_vlines_width, + # borderRightStyle = tbl_opts$table_border_right_style, + # borderRightColor = tbl_opts$table_border_right_color, + # borderRightWidth = tbl_opts$table_border_right_width, + # borderLeftStyle = tbl_opts$table_border_left_style, + # borderLeftColor = tbl_opts$table_border_left_color, + # borderLeftWidth = tbl_opts$table_border_left_width, + borderTopStyle = tbl_opts$table_border_top_style, + borderTopColor = tbl_opts$table_border_top_color, + borderTopWidth = tbl_opts$table_border_top_width, + borderBottomStyle = tbl_opts$table_border_bottom_style, + borderBottomColor = tbl_opts$table_border_bottom_color, + borderBottomWidth = tbl_opts$table_border_bottom_width ), # stub styling? + # Also, rowGroupStyle isn't named or documented well I've realized. "Row group" in that context means a single row including the expandable details. + # rowStyle does the same thing, but does not include expandable details. + # I don't really use expandable details + # rowGroupStyle = list( # backgroundColor = row_group_background_color, # fontWeight = row_group_font_weight # ), # exclude pagination and search - tableBodyStyle = NULL, + tableBodyStyle = list( + borderTopStyle = tbl_opts$table_body_border_top_style, + borderTopColor = tbl_opts$table_body_border_top_color, + borderTopWidth = tbl_opts$table_body_border_top_width, + borderBottomStyle = tbl_opts$table_body_border_bottom_style, + borderBottomColor = tbl_opts$table_body_border_bottom_color, + borderBottomWidth = tbl_opts$table_body_border_bottom_width + ), rowStripedStyle = NULL, rowHighlightStyle = NULL, rowSelectedStyle = NULL, @@ -761,7 +801,7 @@ render_as_ihtml <- function(data, id) { wrap = use_text_wrapping, showSortIcon = TRUE, showSortable = FALSE, - class = NULL, + class = "gt_table", style = NULL, rowClass = NULL, rowStyle = NULL, From 96bb20b33cb42e8e37561a15af0a8cc857ab734b Mon Sep 17 00:00:00 2001 From: olivroy Date: Sun, 29 Sep 2024 13:34:10 -0400 Subject: [PATCH 15/16] fix --- R/render_as_i_html.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index 3fc900ac99..7aaddd17f9 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -572,7 +572,7 @@ render_as_ihtml <- function(data, id) { footnotes_component <- NULL } - table_border_bottom_style <- opt_val(data, "table_border_bottom_style") + table_border_bottom_style <- tbl_opts$table_border_bottom_style footer_component <- htmltools::div( From 731de7a71ddf6fa4e616638fd74bb1f270076296 Mon Sep 17 00:00:00 2001 From: olivroy Date: Sun, 29 Sep 2024 17:53:44 -0400 Subject: [PATCH 16/16] add styling to body cells --- R/render_as_i_html.R | 31 ++++++++++++++++++++++++++----- 1 file changed, 26 insertions(+), 5 deletions(-) diff --git a/R/render_as_i_html.R b/R/render_as_i_html.R index 7aaddd17f9..6f2478da0e 100644 --- a/R/render_as_i_html.R +++ b/R/render_as_i_html.R @@ -457,13 +457,30 @@ render_as_ihtml <- function(data, id) { col_defs <- c(col_defs, group_col_defs, row_name_col_def) styles_tbl <- dt_styles_get(data = data) - body_styles_tbl <- dplyr::filter(styles_tbl, locname %in% c("data", "stub")) + body_styles_tbl <- vctrs::vec_slice(styles_tbl, styles_tbl$locname %in% c("data", "stub")) body_styles_tbl <- dplyr::arrange(body_styles_tbl, colnum, rownum) - body_styles_tbl <- dplyr::select(body_styles_tbl, "colname", "rownum", "html_style") + body_styles_tbl <- body_styles_tbl[c("colname", "rownum", "html_style")] + + # Generate some options for global body style + # They will end up being added inside the JS() function, + # So, they need to have this format. + global_body_style <- + paste0( + "borderLeftColor: '", tbl_opts$table_body_vlines_color, "', ", + "borderLeftStyle: '", tbl_opts$table_body_vlines_style, "', ", + "borderLeftWidth: '", tbl_opts$table_body_vlines_width, "', ", + "borderRightColor: '", tbl_opts$table_body_vlines_color, "', ", + "borderRightStyle: '", tbl_opts$table_body_vlines_style, "', ", + "borderRightWidth: '", tbl_opts$table_body_vlines_width, "', ", + "borderTopColor: '", tbl_opts$table_body_hlines_color, "', ", + "borderTopStyle: '", tbl_opts$table_body_hlines_style, "', ", + "borderTopWidth: '", tbl_opts$table_body_hlines_width, "' " + ) + + # Generate styling rule per combination of `colname` and # `rownum` in `body_styles_tbl` - # TODO combine with table_body_hlines_width body_style_rules <- vapply( seq_len(nrow(body_styles_tbl)), FUN.VALUE = character(1L), USE.NAMES = FALSE, @@ -477,11 +494,15 @@ render_as_ihtml <- function(data, id) { html_style <- gsub("(:)\\s*(.*)", ": '\\2'", html_style, perl = TRUE) html_style <- paste(html_style, collapse = ", ") html_style <- gsub(";'$", "'", html_style) - + + # Add the global body style afterwards. (Specific styling will have precedence) + html_style <- paste0(html_style, ", ", global_body_style) paste0( "if (colInfo.id === '", colname, "' & rowIndex === ", rownum, ") {\n", " return { ", html_style , " }\n", - "}\n\n" + "}\n", + "return { ", global_body_style, "}", + "\n" ) } )