5

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)
    )
  }
})
gd047
  • 29,749
  • 18
  • 107
  • 146
  • 1
    Your question possibly falls into [Crosstalk limitations](https://rstudio.github.io/crosstalk/) : Crosstalk currently only works for linked brushing and filtering of views that show individual data points, not aggregate or summary views – Waldi Jul 15 '20 at 07:21
  • @Waldi I guess you are right. I think I'd better go for a shiny app. – gd047 Jul 15 '20 at 07:28
  • @Waldi I guess it doesn't, see my answer below. This question would fall under those limitations in case of an attempt to aggregate data to filter out the function, but it can be solved by using JS callback instead of built-in aggregation function. – Maksim I. Kuzmin Dec 15 '21 at 22:14

1 Answers1

0

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

Maksim I. Kuzmin
  • 1,170
  • 7
  • 16
  • Thanks, but I don't think it works the way I wanted. In your example the "Acura - Legend - Midsize" is not in the result set. I want to filter both the parent and the nested table's values. – gd047 Dec 16 '21 at 06:11