Search code examples
rmarkdownkablekableextra

Match grouping variable with stripping/shading using kableExtra


I have a table with multiple records for each individual (ID1) and would like the row shading (i.e. kable_styling(c("striped")) to alternate by group (ID1) rather than by every other row. I was hoping I could add group_by(ID1) to the code below... Alas I am still in search of a solution. While there are lots of helpful tips are shown here, I have not been able to find a solution.

I am also wondering how to make a single outside border to the table rather than border every cell.

Below is a reproducible data set.

Many thanks in advance.

```{r echo=F, warning=F, message = FALSE}
library(tidyverse)
library(kableExtra)

set.seed(121)
Dat <- data.frame(
  ID1 = sample(c("AAA", "BBB", "CCC","DDD"), 100, replace = T),
  ID2 = sample(c("Cat", "Dog", "Bird"), 100, replace = T),
  First = rnorm(100),
  Two = sample.int(100)) 

ExTbl <- Dat %>%
  group_by(ID1, ID2) %>%
  summarize(One = mean(First),
            Max = max(Two)) %>%
  arrange(ID1) 


kable(ExTbl) %>%
  kable_styling(c("striped", "bordered"), full_width = F)


```

> head(as.data.frame(ExTbl) )
  ID1  ID2         One Max
1 AAA Bird  0.15324169  86
2 AAA  Cat -0.02726006  83
3 AAA  Dog -0.19618126  78
4 BBB Bird  0.62176633 100
5 BBB  Cat -0.35502912  77
6 BBB  Dog -0.29977145  87
>

Solution

  • Right now there is no direct approach in kableExtra but this is the method I used last time. Maybe I should pack this into this package.

    library(tidyverse)
    library(kableExtra)
    
    set.seed(121)
    Dat <- data.frame(
      ID1 = sample(c("AAA", "BBB", "CCC","DDD"), 100, replace = T),
      ID2 = sample(c("Cat", "Dog", "Bird"), 100, replace = T),
      First = rnorm(100),
      Two = sample.int(100)) 
    
    ExTbl <- Dat %>%
      group_by(ID1, ID2) %>%
      summarize(One = mean(First),
                Max = max(Two)) %>%
      arrange(ID1) 
    
    ind_end <- cumsum(rle(as.character(ExTbl$ID1))$lengths)
    ind_start <- c(1, ind_end[-length(ind_end)] + 1)
    pos <- purrr::map2(ind_start, ind_end, seq)
    pos <- unlist(pos[1:length(pos) %% 2 != 0])
    
    kable(ExTbl) %>%
      kable_styling(c("bordered"), full_width = F) %>%
      row_spec(pos, background = "#EEEEEE")