Filtering nested tables (is it possible?)

[ghost]

In the following reproducible example, I would like to be able to filter results by using the values in x2.x and x2.y columns:

library(tidyverse)
library(reactable)
library(crosstalk)
df1 <- data.frame(id=c(1,2,3), x1=c("test1", "test2","test3"), x2=c("label1", "label2","label3"))
df2 <- data.frame(parentid=c(1,1,1),id=c(7,8,9), x1=c("test7", "test8","test9"), x2=c("label3", "label2","label2"))
df <- left_join(df1,df2, by = c("id" = "parentid"))

data <- df %>% select(id, x1.x, x2.x) %>%  unique()
tasks_with_subtasks <- df2$parentid %>% unique()

dat <- SharedData$new(data)


bscols(
  widths = c(3, 9),
  list(
    filter_checkbox("type", "Type", dat, ~x2.x) # , x2.y
  ),
  reactable(dat , details = function(index) {
    if (index %in% tasks_with_subtasks) {
      df_data <- df[df$id == dat$origData()$id[index], c("id.y", "x1.y", "x2.y")]
      htmltools::div(
        style = "padding: 16px",
        reactable(df_data, outlined = TRUE)
      )
    }
  })
)

[glin]

Hi,

Do you want to filter only the nested table, not including the parent table? If so, you can use Crosstalk groups to link together two different data frames.

In the example below, shared_choices is a SharedData instance that populates the choices in the filter input. You can create that up front, and then give it a group name like "nested_table_1"

Then, create another SharedData instance for the nested table, with the same group name, "nested_table_1"

I removed the SharedData for the parent table. But if you want to link the parent table as well, you can use another SharedData instance for that with the same group name.

library(tidyverse)
library(reactable)
library(crosstalk)

df1 <- data.frame(id=c(1,2,3), x1=c("test1", "test2","test3"), x2=c("label1", "label2","label3"))
df2 <- data.frame(parentid=c(1,1,1),id=c(7,8,9), x1=c("test7", "test8","test9"), x2=c("label3", "label2","label2"))
df <- left_join(df1,df2, by = c("id" = "parentid"))

data <- df %>% select(id, x1.x, x2.x) %>%  unique()
tasks_with_subtasks <- df2$parentid %>% unique()

shared_choices <- SharedData$new(df, group = "nested_table_1")

bscols(
  widths = c(3, 9),
  list(
    filter_checkbox("type", "Type", shared_choices, ~x2.y)
  ),
  reactable(data, details = function(index) {
    if (index %in% tasks_with_subtasks) {
      df_data <- df[df$id == data$id[index], c("id.y", "x1.y", "x2.y")]
      shared_data <- SharedData$new(df_data, group = "nested_table_1")
      htmltools::div(
        style = "padding: 16px",
        reactable(shared_data, outlined = TRUE)
      )
    }
  })
)

See Grouping in https://rstudio.github.io/crosstalk/using.html for some more examples.

---

edit: fixed the original example, which didn't work as intended

[ghost]

@glin Thank you for your answer, but I' m not able to "link the parent table as well". The labels that I'm interested in, are both in x2.x (parent) and x2.y (nested). So, I would like to filter the nested and the parent table at the same time. For example, the image shows the desired result for "label2". In sql, it would be something like this: (x2.x= "label2" OR x2.y="label2"). Ideally, the nested table should automatically expand, if it contains results.

[ghost]

Ι have created another, simpler example. How to add a filter, say for the Type variable, that will work for the parent AND nested tables?

data <- MASS::Cars93
data$subtask <- 1
data[c(1,3,5,6,10,12,20,23,29,31,39,41,44,48,49,51,53,58,60,62,64,68,72,73,78,79,80,84,88,92),"subtask"] <- 0
dat <- data[,c("Manufacturer", "Model", "Type","subtask")]
dat$Manufacturer <- as.character(dat$Manufacturer )


dat_task <- dat %>% filter(subtask==0)
tasks_with_subtasks <- dat %>% filter(subtask==1) %>% 
  pull(Manufacturer) %>% unique() 


reactable(dat_task[,1:3], details = function(index) {
  if(dat_task$Manufacturer[index] %in% tasks_with_subtasks){
    dat_subtask <- dat[dat$Manufacturer == dat_task$Manufacturer[index] & dat$subtask==1,1:3]
    htmltools::div(style = "padding: 16px",
                   reactable(dat_subtask, outlined = TRUE)
    )
  }
})

[glin]

I think this is possible as long as both the parent and nested data are subsets of the same dataset. For the example above, both the parent and nested data are subsets of dat, so it should work.

You can create separate shared data instances for the parent table, nested tables, and filter input, and link them together by using the same Crosstalk group and same set of Crosstalk keys. Here's a heavily-commented example that demonstrates this.

While making this example, I also found a bug where Crosstalk filtering didn't work on nested tables (4b54f1a), so you'll also need the latest development version for this to work.

library(tidyverse)
library(crosstalk)
# devtools::install_github("glin/reactable")
library(reactable)

data <- MASS::Cars93
data$subtask <- 1
data[c(1,3,5,6,10,12,20,23,29,31,39,41,44,48,49,51,53,58,60,62,64,68,72,73,78,79,80,84,88,92),"subtask"] <- 0
dat <- data[,c("Manufacturer", "Model", "Type","subtask")]
dat$Manufacturer <- as.character(dat$Manufacturer )

# Set a unique ID (row index) for each row. This ID will be used
# as the Crosstalk key for each shared data instance.
# Note: could also use row names instead of a column, but dplyr
# drops row names when filtering, which makes row names unreliable.
dat$id <- 1:nrow(dat)

# The parent table data - a subset of the original data.
dat_task <- dat %>% filter(subtask==0)
tasks_with_subtasks <- dat %>% filter(subtask==1) %>%
  pull(Manufacturer) %>% unique()

# Create a shared data instance for the filter input. Takes the original
# dataset (dat) so it can filter both the parent table (dat_task) and the
# nested tables (dat_subtask). Use `id` as the key and "dat" as the
# arbitrarily-chosen group name.
shared_dat <- SharedData$new(dat, key = ~id, group = "dat")

# Create a shared data instance for the parent table. Use the same key and group.
shared_dat_task <- SharedData$new(select(dat_task, -subtask), key = ~id, group = "dat")

bscols(
  widths = c(3, 9),
  list(
    filter_checkbox("type", "Type", shared_dat, ~Type)
  ),
  reactable(
    shared_dat_task,
    details = function(index) {
      if(dat_task$Manufacturer[index] %in% tasks_with_subtasks){
        # The nested table data - a subset of the original data.
        dat_subtask <- dat[dat$Manufacturer == dat_task$Manufacturer[index] & dat$subtask==1, ] %>%
          select(-subtask)
        # Create a shared data instance for the nested table,
        # and use the same group name and key.
        shared_dat_subtask <- SharedData$new(dat_subtask, key = ~id, group = "dat")
        tbl <- reactable(
          shared_dat_subtask,
          outlined = TRUE,
          columns = list(
            # Hide the ID column
            id = colDef(show = FALSE)
          )
        )
        htmltools::div(style = "padding: 16px", tbl)
      }
    },
    columns = list(
      # Hide the ID column
      id = colDef(show = FALSE)
    )
  )
)

[ghost]

Thanks again. However I still think that the filter works only for the parent table. For example, if I ask for 'Midsize' I don't get the Acura Legend Midsize in the result set, even if I have the nested table expanded.

[glin]

Ah, I see what you mean now. Essentially, you want a filter that can match multiple values (the parent table's value + the nested table's values) for a row. I don't think this is possible to do with Crosstalk's built-in filter inputs, but it might be possible with a custom Crosstalk filter input.

Or if you can use Shiny, you could implement the custom filtering logic yourself, and also get rows to expand when filtering. Here's another attempt at it using Shiny:

library(shiny)
library(reactable)
library(dplyr)

data <- MASS::Cars93
data$subtask <- 1
data[c(1,3,5,6,10,12,20,23,29,31,39,41,44,48,49,51,53,58,60,62,64,68,72,73,78,79,80,84,88,92),"subtask"] <- 0
dat <- data[,c("Manufacturer", "Model", "Type","subtask")]
dat$Manufacturer <- as.character(dat$Manufacturer )

dat_task <- dat %>% filter(subtask==0) %>% select(-subtask)
tasks_with_subtasks <- dat %>% filter(subtask==1) %>% 
  pull(Manufacturer) %>% unique() 

dat_subtasks <- tasks_with_subtasks %>%
  map(~ filter(dat, Manufacturer == . & subtask == 1)) %>%
  map(~ select(., -subtask)) %>%
  set_names(tasks_with_subtasks)

ui <- fluidPage(
  checkboxGroupInput("type", "Type", choices = unique(dat$Type)),
  reactableOutput("table")
)

server <- function(input, output) {
  output$table <- renderReactable({
    if (!is.null(input$type)) {
      mfrs_with_type <- filter(dat, Type %in% input$type) %>%
        pull(Manufacturer) %>%
        unique()
      data <- filter(dat_task, Manufacturer %in% mfrs_with_type)
      expanded <- TRUE
    } else {
      data <- dat_task
      expanded <- FALSE
    }
    
    reactable(
      data,
      details = function(index) {
        if(dat_task$Manufacturer[index] %in% tasks_with_subtasks){
          dat_subtask <- dat[dat$Manufacturer == dat_task$Manufacturer[index] & dat$subtask==1,1:3]
          if (!is.null(input$type)) {
            dat_subtask <- filter(dat_subtask, Type %in% input$type)
          }
          htmltools::div(style = "padding: 16px",
                         reactable(dat_subtask, outlined = TRUE)
          )
        }
      },
      defaultExpanded = expanded
    )
  })
}

shinyApp(ui, server)