rstudio · rich-iannone · Jul 9, 2021 · Jul 7, 2021 · Jul 7, 2021 · Jul 7, 2021
diff --git a/R/utils_render_common.R b/R/utils_render_common.R
@@ -243,22 +243,21 @@ reorder_styles <- function(data) {
   stub_df <- dt_stub_df_get(data = data)
   styles_tbl <- dt_styles_get(data = data)
 
-  rownum_final <-
-    stub_df %>%
-    dplyr::pull(rownum_i) %>%
-    as.numeric()
+  rownum_final <- as.numeric(stub_df[, "rownum_i", drop = TRUE])
 
   for (i in seq_len(nrow(styles_tbl))) {
-    if (!is.na(styles_tbl[i, ][["rownum"]])) {
+
+    if (
+      !is.na(styles_tbl[i, ][["rownum"]]) &&
+      !grepl("summary_cells", styles_tbl[i, ][["locname"]])
+    ) {
 
       styles_tbl[i, ][["rownum"]] <-
         which(rownum_final == styles_tbl[i, ][["rownum"]])
     }
   }
 
-  data <- dt_styles_set(data = data, styles = styles_tbl)
-
-  data
+  dt_styles_set(data = data, styles = styles_tbl)
 }
 
 #' Perform merging of column contents

diff --git a/tests/testthat/test-row_group_order.R b/tests/testthat/test-row_group_order.R
@@ -1,22 +1,37 @@
-context("Ensuring that the `row_group_order()` function works as expected")
 
-test_that("the `row_group_order()` function works correctly", {
+# Create a table with group names, rownames, and four columns of values
+tbl <-
+  dplyr::tribble(
+    ~dates,        ~rows, ~col_1, ~col_2, ~col_3, ~col_4,
+    "2018-02-10",  "1",   767.6,  928.1,  382.0,  674.5,
+    "2018-02-10",  "2",   403.3,  461.5,   15.1,  242.8,
+    "2018-02-10",  "3",   686.4,   54.1,  282.7,   56.3,
+    "2018-02-10",  "4",   662.6,  148.8,  984.6,  928.1,
+    "2018-02-11",  "5",   198.5,   65.1,  127.4,  219.3,
+    "2018-02-11",  "6",   132.1,  118.1,   91.2,  874.3,
+    "2018-02-11",  "7",   349.7,  307.1,  566.7,  542.9,
+    "2018-02-11",  "8",    63.7,  504.3,  152.0,  724.5,
+    "2018-02-11",  "9",   105.4,  729.8,  962.4,  336.4,
+    "2018-02-11",  "10",  924.2,  424.6,  740.8,  104.2
+  )
 
-  # Create a table with group names, rownames, and four columns of values
-  tbl <-
-    dplyr::tribble(
-      ~dates,        ~rows, ~col_1, ~col_2, ~col_3, ~col_4,
-      "2018-02-10",  "1",   767.6,  928.1,  382.0,  674.5,
-      "2018-02-10",  "2",   403.3,  461.5,   15.1,  242.8,
-      "2018-02-10",  "3",   686.4,   54.1,  282.7,   56.3,
-      "2018-02-10",  "4",   662.6,  148.8,  984.6,  928.1,
-      "2018-02-11",  "5",   198.5,   65.1,  127.4,  219.3,
-      "2018-02-11",  "6",   132.1,  118.1,   91.2,  874.3,
-      "2018-02-11",  "7",   349.7,  307.1,  566.7,  542.9,
-      "2018-02-11",  "8",    63.7,  504.3,  152.0,  724.5,
-      "2018-02-11",  "9",   105.4,  729.8,  962.4,  336.4,
-      "2018-02-11",  "10",  924.2,  424.6,  740.8,  104.2
-    )
+# Function to skip tests if Suggested packages not available on system
+check_suggests <- function() {
+  skip_if_not_installed("rvest")
+  skip_if_not_installed("xml2")
+}
+
+# Gets the HTML attr value from a single key
+selection_value <- function(html, key) {
+
+  selection <- paste0("[", key, "]")
+
+  html %>%
+    rvest::html_nodes(selection) %>%
+    rvest::html_attr(key)
+}
+
+test_that("the `row_group_order()` function works correctly", {
 
   # Create a `tbl_html` that arranges the groups by the
   # latter calendar date first
@@ -45,3 +60,58 @@ test_that("the `row_group_order()` function works correctly", {
       row_group_order(groups = c("2018-02-13", "2018-02-10"))
   )
 })
+
+test_that("styling at various locations is kept when using `row_group_order()`", {
+
+  # Generate a summary table from `tbl`
+  summary_tbl <-
+    tbl %>%
+    gt(rowname_col = "rows", groupname_col = "dates") %>%
+    summary_rows(
+      groups = TRUE,
+      columns = everything(),
+      fns = list("sum")
+    ) %>%
+    grand_summary_rows(
+      columns = everything(),
+      fns = list("sum")
+    )
+
+  # Apply text styling to all summary and grand summary cells
+  # (plus their labels in the stub)
+  summary_tbl_styled_1 <-
+    summary_tbl %>%
+    tab_style(
+      style = cell_text(style = "italic", weight = "bold"),
+      locations = list(
+        cells_summary(), cells_stub_summary(),
+        cells_grand_summary(), cells_stub_grand_summary()
+      )
+    ) %>%
+    render_as_html() %>%
+    xml2::read_html()
+
+  # Apply the same styling but additionally reverse the order of row groups
+  summary_tbl_styled_2 <-
+    summary_tbl %>%
+    tab_style(
+      style = cell_text(style = "italic", weight = "bold"),
+      locations = list(
+        cells_summary(), cells_stub_summary(),
+        cells_grand_summary(), cells_stub_grand_summary()
+      )
+    ) %>%
+    row_group_order(groups = c("2018-02-11", "2018-02-10")) %>%
+    render_as_html() %>%
+    xml2::read_html()
+
+  # Expect that all summary and grand summary cells (and their stub locations)
+  # have the same styles applied regardless of the use of `row_group_order()`
+  summary_tbl_styled_1 %>%
+    selection_value("style") %>%
+    expect_equal(rep("font-style: italic; font-weight: bold;", 15))
+
+  summary_tbl_styled_2 %>%
+    selection_value("style") %>%
+    expect_equal(rep("font-style: italic; font-weight: bold;", 15))
+})
diff --git a/tests/testthat/test-table_parts.R b/tests/testthat/test-table_parts.R
@@ -1,5 +1,3 @@
-context("Ensuring that the creation of tab components works as expected")
-
 testthat::local_edition(3)
 
 # Create a shorter version of `mtcars`