Update group_header_rows attribute with new position when adding multiple group_rows to HTML table
There is an issue when adding multiple group_rows to a kable HTML table. When adding the second group_rows statement the positions are wrong because the positions of the first group_header_rows are not updated after adding the new group_header_rows. This line should fix this.
Example .Rmd file:
---
output:
html_document: default
---
```{r include=FALSE}
# Load libraries
library(tidyverse)
library(kableExtra)
# Create test data
# Nested groups. "a" only contains "1" and "2",
# "b" only contains "3" and "4", "c" only "5" and "d" only "6"
test_data <- tribble(
~var1, ~var2, ~var3,
"a", "1", "x",
"b", "4", "y",
"b", "3", "x",
"a", "2", "z",
"c", "5", "y",
"d", "6", "x",
"d", "6", "z",
"a", "2", "y",
"d", "7", "b",
"d", "7", "b")
# Sort data on var1 and var2 so we're able to group rows based on these
test_data_sorted <- test_data %>%
arrange(var1, var2)
```
```{r kable_one_group}
# Create kable table and group rows based on var1 first
kable_one_group <- test_data_sorted %>%
kable() %>%
kable_styling(full_width = FALSE) %>%
group_rows(index = test_data_sorted$var1 %>% auto_index(),
group_label = test_data_sorted$var1)
# This works fine
kable_one_group
```
```{r kable_one_group_other_var}
# Create kable table and group rows based on var2 second
kable_one_group_other_var <- test_data_sorted %>%
kable() %>%
kable_styling(full_width = FALSE) %>%
group_rows(index = test_data_sorted$var2 %>% auto_index(),
group_label = test_data_sorted$var2)
#This works fine
kable_one_group_other_var
```
```{r kable_two_groups_both_vars}
# Then add another group of rows based on var2 to this table
kable_two_groups <- kable_one_group %>%
group_rows(index = test_data_sorted$var2 %>% auto_index(),
group_label = test_data_sorted$var2 %>% auto_index,
indent = FALSE)
#This doesn't work as intended
kable_two_groups
```diff --git a/R/group_rows.R b/R/group_rows.R
index c7d5178..33a517c 100644
--- a/R/group_rows.R
+++ b/R/group_rows.R
@@ -126,6 +126,10 @@
if (!is.null(group_header_rows)) {
group_seq <- positions_corrector(group_seq, group_header_rows,
length(xml_children(kable_tbody)))
+ # Update the old group_header_rows attribute with their new positions
+ kable_attrs$group_header_rows <- ifelse(kable_attrs$group_header_rows > group_seq[1],
+ kable_attrs$group_header_rows+1,
+ kable_attrs$group_header_rows)
}
# Insert a group header row