How can I filter rows based on a delimited string in R?

Question

I have a field in my dataframe that is a delimited string. I have a checkbox input with possible values. I have a radio button with two choices: "Any" and "All."

I compare the list of selected items in the checkbox to the items in the delimited string.

I would like the Any option to behave like set intersection. If any of the selected items are anywhere in the delimited string, keep that row.

I would like the All option to behave like set equivalence. Only strings with the exact set of selected items should remain.

library(shiny)
library(data.table)
library(dplyr)
library(DT)
library(shinyWidgets)
library(shinydashboard)

ui <- fluidPage(

    # Application title
    titlePanel("DT"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(

             treeInput(
               inputId = "spectrumDeployedCheckbox",
               label   = "Spectrum Deployed" ,
               choices = create_tree(
                 data.frame(
                   "All" = c("All"),
                   "Deployed" = c("13","5","2","4","66","77"),
                   "DeployedVAR" = c("13","5","2","4","66","77") 
                 ),
                 levels = c("All","Deployed"),
                 levels_id = c("All","DeployedVAR")
               ),
               selected = c("All"),
               returnValue = "id" ,
               closeDepth = 1 
             ),
             radioButtons(
               "spectrumDeployedMatchRadioButton", 
               "Match On",
               choiceNames=c("Any","All"), 
               choiceValues=c("ANY","ALL"),
               selected='ANY'
             )
        ),

        # Show a plot of the generated distribution
        mainPanel(
           DT::dataTableOutput("demoTable")# ,
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  OPRBAND <- c("13;5","4;2","4","13","5","13;5;2;4;66;77","44;5")
  OPRBAND2 <- c("13;5","4;2","4","13","5","13;5;2;4;66;77","44;5")
  data <- data.frame(OPRBAND,OPRBAND2) %>%
    rowwise() %>%
    mutate(
      OPRBAND_LIST = strsplit(OPRBAND,split=";") 
    ) %>%
    ungroup()
  
  observe({print(class(list(paste0(unlist(input$spectrumLeftCheckbox ) ) )))})
    tableData <- reactive({
      return(data %>%
        rowwise() %>% 
      filter( 
        case_when(
          input$spectrumDeployedMatchRadioButton == 'ANY' ~ 
            case_when(
              length(input$spectrumDeployedCheckbox) == 0 ~ TRUE ,
              TRUE ~ length(intersect(OPRBAND_LIST[[1]],input$spectrumDeployedCheckbox[!input$spectrumDeployedCheckbox == 'All'])) >= 0 
            ),
          input$spectrumDeployedMatchRadioButton == 'ALL' ~ 
            case_when(
              length(input$spectrumDeployedCheckbox) == 0 ~ FALSE ,
              TRUE ~ identical(sort(input$spectrumDeployedCheckbox[!input$spectrumDeployedCheckbox == 'All']) , sort(OPRBAND_LIST[[1]])) == TRUE
            )
        )
      ) %>% 
      ungroup() %>% 
        as.data.frame()
      )
  })

  
  output$demoTable <- DT::renderDataTable({
    DT::datatable( tableData() 
                   ,extension = 'Buttons' ,
                   filter = list(position = 'top', clear = FALSE), 
                   options = list(
                     paging = TRUE,
                     searching = TRUE,
                     fixedColumns = TRUE,
                     autoWidth = TRUE,
                     ordering = TRUE,
                     dom = 'lftsp' ,
                     stateSave = TRUE ,
                     order = list(list(1,'asc'),list(2,'asc'))
                     #buttons = c('copy', 'csv', 'excel'),  
                     # modify this for full download. github.com/rstudio/DT/issues/267
                   ), 
                   escape = FALSE,
                   class='display',
                   rownames = FALSE
    )
  }, server=FALSE, escape=FALSE)
}

# Run the application 
shinyApp(ui = ui, server = server)

I get very inconsistent behavior from what I think should happen. For example if only the 4 is selected, and "Any" is chosen, I would expect rows 2, 3, and 6 to remain. If I switch the radio to "All" then only row 3 should remain.

Answer 1

You said

For example if only the 4 is selected, and "Any" is chosen, I would expect rows 3, 4, and 6 to remain

but I see "4" in rows 2, 3, and 6. Assuming that, then

input$spectrumDeployedCheckbox
# [1] "4"
input$spectrumDeployedMatchRadioButton
# [1] "ANY"

anyallfun <- switch(
  input$spectrumDeployedMatchRadioButton,
  "ANY" = any,
  all)
data %>%
  filter(
    sapply(data$OPRBAND_LIST,
           function(z) anyallfun(z %in% input$spectrumDeployedCheckbox))
  )
# # A tibble: 3 × 3
#   OPRBAND        OPRBAND2       OPRBAND_LIST
#   <chr>          <chr>          <list>      
# 1 4;2            4;2            <chr [2]>   
# 2 4              4              <chr [1]>   
# 3 13;5;2;4;66;77 13;5;2;4;66;77 <chr [6]>   

Alternatively, if we have "ALL" selected,

input$spectrumDeployedCheckbox
# [1] "4"
input$spectrumDeployedMatchRadioButton
# [1] "ALL"

anyallfun <- switch(
  input$spectrumDeployedMatchRadioButton,
  "ANY" = any,
  all)
data %>%
  filter(
    sapply(data$OPRBAND_LIST,
           function(z) anyallfun(z %in% input$spectrumDeployedCheckbox))
  )
# # A tibble: 1 × 3
#   OPRBAND OPRBAND2 OPRBAND_LIST
#   <chr>   <chr>    <list>      
# 1 4       4        <chr [1]>   

Some FYIs:

• you don't need to use rowwise to create OPRBAND_LIST, nor does it have to be a full-up list of lists, it can be a list of character vectors,

  data <- data.frame(OPRBAND, OPRBAND2) %>%
    mutate(OPRBAND_LIST = strsplit(OPRBAND, ";"))
  data
  #          OPRBAND       OPRBAND2        OPRBAND_LIST
  # 1           13;5           13;5               13, 5
  # 2            4;2            4;2                4, 2
  # 3              4              4                   4
  # 4             13             13                  13
  # 5              5              5                   5
  # 6 13;5;2;4;66;77 13;5;2;4;66;77 13, 5, 2, 4, 66, 77
  # 7           44;5           44;5               44, 5
  

  works just as well (for me in mild testing).

• you don't need return(...) in your reactive ... in fact, you rarely rarely rarely need to use return at all. Even when you do, I suggest (somewhat but not entirely stylistically) that it is not great to wrap a long %>%-pipe expression in a single return(..), it really confuses things (perhaps foremost my eyes, but more certainly).