How to filter rows in both parent and nested tables, using reactable?

Viewed 578

How to filter rows with a specific Type, which are either in the parent or in any of the nested tables of a reactable, using crosstalk::filter_checkbox, as shown here ?

dat <- structure(list(Manufacturer = c(
  "Acura", "Acura", "Audi", "Audi",
  "BMW", "Buick", "Buick", "Buick", "Buick", "Cadillac", "Cadillac",
  "Chevrolet", "Chevrolet", "Chevrolet", "Chevrolet", "Chevrolet",
  "Chevrolet", "Chevrolet", "Chevrolet", "Chrysler", "Chrysler",
  "Chrysler", "Dodge", "Dodge", "Dodge", "Dodge", "Dodge", "Dodge",
  "Eagle", "Eagle", "Ford", "Ford", "Ford", "Ford", "Ford", "Ford",
  "Ford", "Ford", "Geo", "Geo", "Honda", "Honda", "Honda", "Hyundai",
  "Hyundai", "Hyundai", "Hyundai", "Infiniti", "Lexus", "Lexus",
  "Lincoln", "Lincoln", "Mazda", "Mazda", "Mazda", "Mazda", "Mazda",
  "Mercedes-Benz", "Mercedes-Benz", "Mercury", "Mercury", "Mitsubishi",
  "Mitsubishi", "Nissan", "Nissan", "Nissan", "Nissan", "Oldsmobile",
  "Oldsmobile", "Oldsmobile", "Oldsmobile", "Plymouth", "Pontiac",
  "Pontiac", "Pontiac", "Pontiac", "Pontiac", "Saab", "Saturn",
  "Subaru", "Subaru", "Subaru", "Suzuki", "Toyota", "Toyota", "Toyota",
  "Toyota", "Volkswagen", "Volkswagen", "Volkswagen", "Volkswagen",
  "Volvo", "Volvo"
), Model = structure(c(
  49L, 56L, 9L, 1L, 6L,
  24L, 54L, 74L, 73L, 35L, 79L, 22L, 30L, 17L, 58L, 59L, 15L, 20L,
  31L, 27L, 52L, 48L, 26L, 80L, 83L, 21L, 37L, 84L, 86L, 93L, 44L,
  41L, 90L, 64L, 68L, 13L, 89L, 33L, 62L, 85L, 66L, 25L, 11L, 43L,
  40L, 77L, 82L, 70L, 38L, 75L, 28L, 92L, 5L, 69L, 7L, 60L, 72L,
  2L, 4L, 19L, 32L, 63L, 36L, 78L, 14L, 71L, 61L, 12L, 34L, 81L,
  39L, 51L, 53L, 87L, 45L, 47L, 16L, 10L, 76L, 50L, 57L, 55L, 88L,
  91L, 23L, 18L, 67L, 46L, 42L, 65L, 29L, 3L, 8L
), .Label = c(
  "100",
  "190E", "240", "300E", "323", "535i", "626", "850", "90", "900",
  "Accord", "Achieva", "Aerostar", "Altima", "Astro", "Bonneville",
  "Camaro", "Camry", "Capri", "Caprice", "Caravan", "Cavalier",
  "Celica", "Century", "Civic", "Colt", "Concorde", "Continental",
  "Corrado", "Corsica", "Corvette", "Cougar", "Crown_Victoria",
  "Cutlass_Ciera", "DeVille", "Diamante", "Dynasty", "ES300", "Eighty-Eight",
  "Elantra", "Escort", "Eurovan", "Excel", "Festiva", "Firebird",
  "Fox", "Grand_Prix", "Imperial", "Integra", "Justy", "Laser",
  "LeBaron", "LeMans", "LeSabre", "Legacy", "Legend", "Loyale",
  "Lumina", "Lumina_APV", "MPV", "Maxima", "Metro", "Mirage", "Mustang",
  "Passat", "Prelude", "Previa", "Probe", "Protege", "Q45", "Quest",
  "RX-7", "Riviera", "Roadmaster", "SC300", "SL", "Scoupe", "Sentra",
  "Seville", "Shadow", "Silhouette", "Sonata", "Spirit", "Stealth",
  "Storm", "Summit", "Sunbird", "Swift", "Taurus", "Tempo", "Tercel",
  "Town_Car", "Vision"
), class = "factor"), Type = c(
  "Small", "Midsize",
  "Compact", "Midsize", "Midsize", "Midsize", "Large", "Large",
  "Midsize", "Large", "Midsize", "Compact", "Compact", "Sporty",
  "Midsize", "Van", "Van", "Large", "Sporty", "Large", "Compact",
  "Large", "Small", "Small", "Compact", "Van", "Midsize", "Sporty",
  "Small", "Large", "Small", "Small", "Compact", "Sporty", "Sporty",
  "Van", "Midsize", "Large", "Small", "Sporty", "Sporty", "Small",
  "Compact", "Small", "Small", "Sporty", "Midsize", "Midsize",
  "Midsize", "Midsize", "Midsize", "Large", "Small", "Small", "Compact",
  "Van", "Sporty", "Compact", "Midsize", "Sporty", "Midsize", "Small",
  "Midsize", "Small", "Compact", "Van", "Midsize", "Compact", "Midsize",
  "Van", "Large", "Sporty", "Small", "Compact", "Sporty", "Midsize",
  "Large", "Compact", "Small", "Small", "Small", "Compact", "Small",
  "Small", "Sporty", "Midsize", "Van", "Small", "Van", "Compact",
  "Sporty", "Compact", "Midsize"
), subtask = c(
  0, 1, 0, 1, 0, 0,
  1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1,
  1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0,
  0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1,
  1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1,
  1, 0, 1
)), row.names = c(NA, 93L), class = "data.frame")

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

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)
    )
  }
})
1 Answers

Update:

I can see that you already received the answer from reactable package developer:

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.

I tried to create a custom input filter function based on the filter_checkbox() one, but realised that it's going to be easier to fork the entire project and make your own

First, there're plenty of essential internal functions like makeGroupOptions() and inlineCheckbox(). As far as I know, this is not a recommended approach, but in case we really need it, we can always use crosstalk:::<...>().

Second, there're too many groups. Every parent row creates a separate dat_subtask, which would mean that we need to convert all of them into SharedData and include as filtering groups to the filter input functions.

The solution I'd apply in the real-life conditions would be most likely hard-coded JS onchange event that hides/shows the rows manually, turning off the default behavior. But this code would belong to the JS community.


You need to create crosstalk's SharedData from the data you're using for reactable:

shared_data = SharedData$new(dat_task[,1:3])

Then you can easily add columns with bscols() and set up the filter checkbox:

bscols(
  widths = c(3, 9),
  list(
    filter_checkbox("type", "Type", shared_data, ~Type)
  ),
  reactable(shared_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]
      htmltools::div(style = "padding: 16px",
                     reactable(dat_subtask, outlined = TRUE)
      )
    }
  })
)

The full code will be:

dat <- structure(list(Manufacturer = c(
  "Acura", "Acura", "Audi", "Audi",
  "BMW", "Buick", "Buick", "Buick", "Buick", "Cadillac", "Cadillac",
  "Chevrolet", "Chevrolet", "Chevrolet", "Chevrolet", "Chevrolet",
  "Chevrolet", "Chevrolet", "Chevrolet", "Chrysler", "Chrysler",
  "Chrysler", "Dodge", "Dodge", "Dodge", "Dodge", "Dodge", "Dodge",
  "Eagle", "Eagle", "Ford", "Ford", "Ford", "Ford", "Ford", "Ford",
  "Ford", "Ford", "Geo", "Geo", "Honda", "Honda", "Honda", "Hyundai",
  "Hyundai", "Hyundai", "Hyundai", "Infiniti", "Lexus", "Lexus",
  "Lincoln", "Lincoln", "Mazda", "Mazda", "Mazda", "Mazda", "Mazda",
  "Mercedes-Benz", "Mercedes-Benz", "Mercury", "Mercury", "Mitsubishi",
  "Mitsubishi", "Nissan", "Nissan", "Nissan", "Nissan", "Oldsmobile",
  "Oldsmobile", "Oldsmobile", "Oldsmobile", "Plymouth", "Pontiac",
  "Pontiac", "Pontiac", "Pontiac", "Pontiac", "Saab", "Saturn",
  "Subaru", "Subaru", "Subaru", "Suzuki", "Toyota", "Toyota", "Toyota",
  "Toyota", "Volkswagen", "Volkswagen", "Volkswagen", "Volkswagen",
  "Volvo", "Volvo"
), Model = structure(c(
  49L, 56L, 9L, 1L, 6L,
  24L, 54L, 74L, 73L, 35L, 79L, 22L, 30L, 17L, 58L, 59L, 15L, 20L,
  31L, 27L, 52L, 48L, 26L, 80L, 83L, 21L, 37L, 84L, 86L, 93L, 44L,
  41L, 90L, 64L, 68L, 13L, 89L, 33L, 62L, 85L, 66L, 25L, 11L, 43L,
  40L, 77L, 82L, 70L, 38L, 75L, 28L, 92L, 5L, 69L, 7L, 60L, 72L,
  2L, 4L, 19L, 32L, 63L, 36L, 78L, 14L, 71L, 61L, 12L, 34L, 81L,
  39L, 51L, 53L, 87L, 45L, 47L, 16L, 10L, 76L, 50L, 57L, 55L, 88L,
  91L, 23L, 18L, 67L, 46L, 42L, 65L, 29L, 3L, 8L
), .Label = c(
  "100",
  "190E", "240", "300E", "323", "535i", "626", "850", "90", "900",
  "Accord", "Achieva", "Aerostar", "Altima", "Astro", "Bonneville",
  "Camaro", "Camry", "Capri", "Caprice", "Caravan", "Cavalier",
  "Celica", "Century", "Civic", "Colt", "Concorde", "Continental",
  "Corrado", "Corsica", "Corvette", "Cougar", "Crown_Victoria",
  "Cutlass_Ciera", "DeVille", "Diamante", "Dynasty", "ES300", "Eighty-Eight",
  "Elantra", "Escort", "Eurovan", "Excel", "Festiva", "Firebird",
  "Fox", "Grand_Prix", "Imperial", "Integra", "Justy", "Laser",
  "LeBaron", "LeMans", "LeSabre", "Legacy", "Legend", "Loyale",
  "Lumina", "Lumina_APV", "MPV", "Maxima", "Metro", "Mirage", "Mustang",
  "Passat", "Prelude", "Previa", "Probe", "Protege", "Q45", "Quest",
  "RX-7", "Riviera", "Roadmaster", "SC300", "SL", "Scoupe", "Sentra",
  "Seville", "Shadow", "Silhouette", "Sonata", "Spirit", "Stealth",
  "Storm", "Summit", "Sunbird", "Swift", "Taurus", "Tempo", "Tercel",
  "Town_Car", "Vision"
), class = "factor"), Type = c(
  "Small", "Midsize",
  "Compact", "Midsize", "Midsize", "Midsize", "Large", "Large",
  "Midsize", "Large", "Midsize", "Compact", "Compact", "Sporty",
  "Midsize", "Van", "Van", "Large", "Sporty", "Large", "Compact",
  "Large", "Small", "Small", "Compact", "Van", "Midsize", "Sporty",
  "Small", "Large", "Small", "Small", "Compact", "Sporty", "Sporty",
  "Van", "Midsize", "Large", "Small", "Sporty", "Sporty", "Small",
  "Compact", "Small", "Small", "Sporty", "Midsize", "Midsize",
  "Midsize", "Midsize", "Midsize", "Large", "Small", "Small", "Compact",
  "Van", "Sporty", "Compact", "Midsize", "Sporty", "Midsize", "Small",
  "Midsize", "Small", "Compact", "Van", "Midsize", "Compact", "Midsize",
  "Van", "Large", "Sporty", "Small", "Compact", "Sporty", "Midsize",
  "Large", "Compact", "Small", "Small", "Small", "Compact", "Small",
  "Small", "Sporty", "Midsize", "Van", "Small", "Van", "Compact",
  "Sporty", "Compact", "Midsize"
), subtask = c(
  0, 1, 0, 1, 0, 0,
  1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1,
  1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0,
  0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 0, 1,
  1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1,
  1, 0, 1
)), row.names = c(NA, 93L), class = "data.frame")

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

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

shared_data = SharedData$new(dat_task[,1:3])

bscols(
  widths = c(3, 9),
  list(
    filter_checkbox("type", "Type", shared_data, ~Type)
  ),
  reactable(shared_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]
      htmltools::div(style = "padding: 16px",
                     reactable(dat_subtask, outlined = TRUE)
      )
    }
  })
)

enter image description here

Related