如何从具有 changing/reactive 列值的数据创建可反应(和闪亮)的列组?

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

我正在尝试在可反应的对象中创建 colGroups,但要更改我要分组的列的值。因此,在我的示例数据集中,列 group 的值是 redblue 但可以通过用户交互更改,因为我想将反应嵌入到闪亮的应用程序中。

第一个代码示例提供了一个使用静态编码的列名的示例,这个工作正常。

但我正在寻找一种方法来重新创建第一个代码示例的结果,但没有明确编码 colnames,我在第二个代码示例中尝试过。

但我不明白为什么它会给我错误 Error in reactable(., columns = map(.x = seq_along(data_wider_colnames), : `columns` must be a named list of column definitions。列定义中一定有问题; columnGroups 定义似乎有效。

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]]))
      )

我没有尝试检查您的代码有什么问题。但实现您想要的结果的一种选择可能如下所示:

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
)

Stefan 回答的小补充。如果列组具有相似的名称,例如

data = tibble(group = c("red","red month"))

Stefan 的解决方案不起作用(它将创建一个仅命名为 'red' 的大型列组)。通过使用

调整 Stefan 的代码可以很容易地修复它

cols <- unlist(cols[grepl(paste0(x,"."), names(cols), fixed = T)])

完整示例如下所示:

library(reactable)
library(tidyr)

data = tibble(group = c("red","red month"), 
              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) {
# Here is the change
cols <- unlist(cols[grepl(paste0(x,"."), names(cols), fixed = T)])
  colGroup(name = x, columns = unname(cols))
})

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