Search code examples
rshinyreactable

how to create columngroups from data with changing/reactive column values in reactable (and shiny)?

Iam trying to create colGroups within a reactable but with changing values for the column by which i want to group. So in my example dataset the values for column group are red and blue but can change by user interaction since i want to embed the reactable in a shiny App.

The first code example provides an example with static coded colnames and this works ofc fine.

But im looking for a way to recreate the result from the first code example with not explicitly coding the colnames and i tried in the second code example.

But i cannot understand why it gives me the error Error in reactable(., columns = map(.x = seq_along(data_wider_colnames), : `columns` must be a named list of column definitions. Something must be wrong in the columns-definition; the columnGroups-definition seem to work.

library(reactable)
library(tidyr)

data = tibble(group = c("red","blue"), 
              month = rep("august", 2),
              valueOne = c(500,1000), 
              valueTwo = c(200, 2000), 
              valueThree = c(100, 5000))

      ### bring data into wider format and seperate new colnames with `.`
    data_wider = data %>%
      pivot_wider(names_from = group, names_glue = "{group}.{.value}", values_from = c("valueOne", "valueTwo", "valueThree"))
    
    
    ### pipe wider data into reactable
    data_wider %>%
      reactable(

        ### rename all new colnames
        columns = list(
          "red.valueOne" = colDef(name = "valueOne"),
          "blue.valueOne" = colDef(name = "valueOne"),
          "red.valueTwo" = colDef(name = "valueTwo"),
          "blue.valueTwo" = colDef(name = "valueTwo"),
          "red.valueThree" = colDef(name = "valueThree"),
          "blue.valueThree" = colDef(name = "valueThree")),

        ### create columngroups
        columnGroups = list(
          colGroup(name = "red", columns = c("red.valueOne", "red.valueTwo", "red.valueThree")),
          colGroup(name = "blue", columns = c("blue.valueOne", "blue.valueTwo", "blue.valueThree")))
        )

library(reactable)
library(tidyr)
library(purr)
library(stringr)

data = tibble(group = c("red","blue"), 
              month = rep("august", 2),
              valueOne = c(500,1000), 
              valueTwo = c(200, 2000), 
              valueThree = c(100, 5000))

      ### bring data into wider format and seperate new colnames with `.`
    data_wider = data %>%
      pivot_wider(names_from = group, names_glue = "{group}.{.value}", values_from = c("valueOne", "valueTwo", "valueThree"))

    ### asign new colnames into a help vector to extract/and change names attribute from it in colDef()
    data_wider_colnames = colnames(data_wider[,2:ncol(data_wider)])
    
    ### asign distinct values for column `group` into new vector
    distinct_group_values = data$group
    
    ### asign new colnames for each distinct value of `group` into a help vector to declare colGroups() and corresponding colums
    distinct_group_colnames = map(seq_along(names), .f = ~ str_subset(data_wider_colnames, distinct_group_values[.x]))

    data_wider %>%
      reactable(
        
        columns = map(.x = seq_along(data_wider_colnames),
                      .f = ~ set_names(list(colDef(name = str_extract(data_wider_colnames[.x], "(?<=\\.).*"))), data_wider_colnames[.x])),

        columnGroups = map(.x = seq_along(distinct_group_values),
                            .f = ~ colGroup(name = distinct_group_values[.x], columns = distinct_group_colnames[.x][[1]]))
      )
Solution

  • I have not tried to check out what's wrong with your code. But one option to achieve your desired result may look like so:

    library(reactable)
library(tidyr)

data = tibble(group = c("red","blue"), 
              month = rep("august", 2),
              valueOne = c(500,1000), 
              valueTwo = c(200, 2000), 
              valueThree = c(100, 5000))

### bring data into wider format and seperate new colnames with `.`
data_wider = data %>%
  pivot_wider(names_from = group, names_glue = "{group}.{.value}", 
              values_from = c("valueOne", "valueTwo", "valueThree"))

# Get column names
cols <- names(data_wider)[!names(data_wider) %in% c("month")]
cols <- setNames(cols, cols)
# Get colGroup names
col_groups <- as.character(unique(data$group))

# Make columns
columns <- lapply(cols, function(x) colDef(name = gsub("^.*?\\.(.*)$", "\\1", x)))
# Make columnGroups
columnGroups <- lapply(col_groups, function(x) {
  cols <- unlist(cols[grepl(x, names(cols))])
  colGroup(name = x, columns = unname(cols))
})

reactable(
  data_wider,
  columns = columns,
  columnGroups = columnGroups
)