Search code examples
rdataframeshinyshinydashboardshinyapps

Subset dataframe based on pickerInput


I have a dataframe like this :

enter image description here

I would like to subset the dataframe based on multiple selection. I used pickerInput function from shinyWidgets but i dont get the desired result, some observations are omitted : When x and y are selected, the resulted dataframe is incorrect, I got this :

enter image description here

instead of this

enter image description here

How can we fix it ? This is what i did :

library("shiny")
library(DT)
library(shinyWidgets)

shinyApp(
  ui = fluidPage(
    
    sidebarLayout(
      
      sidebarPanel(
        
        pickerInput("id", "variable:",   
                    choices = c( "x", "y","z"), 
                    options = list(`actions-box` = TRUE),
                    selected = "z",
                    multiple = TRUE )),
      
      mainPanel(
        dataTableOutput("example")
      )
    )
  ),
  
  server = function(input, output) {
    
    df <- data.frame(variable = c(rep("x",4),rep("y",4),rep("z",4)),
                     x1 = 1:12)
    
    
    output$example <- renderDT({
      df2 <- df %>% 
        filter(variable == input$id )
    })
    
  }
  
)

Some help would be appreciated


Solution

  • The issue is using == instead of %in%. The == is elementwise operator and it works when there is only a single element on the rhs as it will recycle, whereas with lengths > 1 and not equal to the length of the lhs vector, it recycles, but then the comparison will get incorrect output.

    > library(dplyr)
    > df %>% mutate(new = variable == c("x", "y"))
       variable x1   new
    1         x  1  TRUE
    2         x  2 FALSE
    3         x  3  TRUE
    4         x  4 FALSE
    5         y  5 FALSE
    6         y  6  TRUE
    7         y  7 FALSE
    8         y  8  TRUE
    9         z  9 FALSE
    10        z 10 FALSE
    11        z 11 FALSE
    12        z 12 FALSE
    > df %>% mutate(new = variable %in% c("x", "y"))
       variable x1   new
    1         x  1  TRUE
    2         x  2  TRUE
    3         x  3  TRUE
    4         x  4  TRUE
    5         y  5  TRUE
    6         y  6  TRUE
    7         y  7  TRUE
    8         y  8  TRUE
    9         z  9 FALSE
    10        z 10 FALSE
    11        z 11 FALSE
    12        z 12 FALSE
    

    If we check the first comparison, the 'x', 'y' will be compared to the first two row, then with recyling, again 'x', 'y' is compared and so on until it reaches the last row (in some cases a warning is noticed when the number of elements is not a multiple of the length of the rhs vector)


    library(DT)
    library(shinyWidgets)
    library(dplyr)
    
    shinyApp(
      ui = fluidPage(
        
        sidebarLayout(
          
          sidebarPanel(
            
            pickerInput("id", "variable:",   
                        choices = c( "x", "y","z"), 
                        options = list(`actions-box` = TRUE),
                        selected = "z",
                        multiple = TRUE )),
          
          mainPanel(
            dataTableOutput("example")
          )
        )
      ),
      
      server = function(input, output) {
        
        df <- data.frame(variable = c(rep("x",4),rep("y",4),rep("z",4)),
                         x1 = 1:12)
        
        
        output$example <- renderDT({
          df2 <- df %>% 
            filter(variable %in% input$id )
        })
        
      }
      
    )
    

    -output

    enter image description here