Incorrect subset of dataframe based on dynamic column names selection

Question

I have the shiny app below in which the user may select between one or more column names from the data frame.

name<-c("John","Jack","Bill")
value1<-c(2,4,6)
add<-c("SDF","GHK","FGH")
value2<-c(3,4,5)
dt<-data.frame(name,value1,add,value2)

Then for every selection he makes the relative pickerInput() may be displayed below. Then based on the selection of column or columns and their values I would like to subset the initial dataframe and display it in a table. But the name of the columns may differ for every different dataframe Im going to use in my orifinal app so I need a more generic way to do it. My method is below but there are some things that do not work. For example if I select name(without any name selected) and the value1 which has all the values selected I get an empty table while I should have had all the values. The table is starting to get filled when I start selecting names.

library(DT)
# ui object
ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            pickerInput(
                inputId = "p1",
                label = "Select Column headers",
                choices = colnames( dt),
                multiple = TRUE,
                options = list(`actions-box` = TRUE)
            ),
            #Add the output for new pickers
            uiOutput("pickers")
        ),
        
        mainPanel(
            DTOutput("table")
        )
    )
)

# server()
server <- function(input, output) {
    
    observeEvent(input$p1, {
        #Create the new pickers 
        output$pickers<-renderUI({
            div(lapply(input$p1, function(x){
                if (is.numeric(dt[[x]])) {
                    sliderInput(inputId=x, label=x, min=min(dt[x]), max=max(dt[[x]]), value=c(min(dt[[x]]),max(dt[[x]])))
                }
                else if (is.factor(dt[[x]])) {
                    selectInput(
                        inputId = x#The colname of selected column
                        ,
                        label = x #The colname of selected column
                        ,
                        choices = dt[,x]#all rows of selected column
                        ,
                        multiple = TRUE
                        
                    )
                }
                
            }))
        })
    })
    output$table<-renderDT({
        req(input$p1, sapply(input$p1, function(x) input[[x]]))
        dt_part <- dt
        for (colname in input$p1) {
            if (is.factor(dt_part[[colname]])) {
                dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
            } else {
                dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
            }
        }
        dt_part
    })
}

# shinyApp()
shinyApp(ui = ui, server = server)

starja · Accepted Answer · 2020-09-07 19:39:06Z

By default, inputs where no value is selected are NULL. So you you have to check if the input is NULL and then don't filter. If you use dplyr, I've recently written a function to make this filtering easier in shiny.

Here is a working example with your code:

library(shiny)
library(DT)
library(shinyWidgets)
# ui object
ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      pickerInput(
        inputId = "p1",
        label = "Select Column headers",
        choices = colnames( dt),
        multiple = TRUE,
        options = list(`actions-box` = TRUE)
      ),
      #Add the output for new pickers
      uiOutput("pickers")
    ),
    
    mainPanel(
      DTOutput("table")
    )
  )
)

# server()
server <- function(input, output) {
  
  observeEvent(input$p1, {
    #Create the new pickers 
    output$pickers<-renderUI({
      div(lapply(input$p1, function(x){
        if (is.numeric(dt[[x]])) {
          sliderInput(inputId=x, label=x, min=min(dt[x]), max=max(dt[[x]]), value=c(min(dt[[x]]),max(dt[[x]])))
        }
        else if (is.factor(dt[[x]])) {
          selectInput(
            inputId = x#The colname of selected column
            ,
            label = x #The colname of selected column
            ,
            choices = dt[,x]#all rows of selected column
            ,
            multiple = TRUE
            
          )
        }
        
      }))
    })
  })
  
  output_table <- reactive({
    req(input$p1, sapply(input$p1, function(x) input[[x]]))
    dt_part <- dt
    for (colname in input$p1) {
      if (is.factor(dt_part[[colname]]) && !is.null(input[[colname]])) {
        dt_part <- subset(dt_part, dt_part[[colname]] %in% input[[colname]])
      } else {
        if (!is.null(input[[colname]][[1]])) {
          dt_part <- subset(dt_part, (dt_part[[colname]] >= input[[colname]][[1]]) & dt_part[[colname]] <= input[[colname]][[2]])
        }
      }
    }
    dt_part
  })
  output$table<-renderDT({
    output_table()
  })
}

# shinyApp()
shinyApp(ui = ui, server = server)

I dont get it if I value1 and name again without having selected any name I still get an empty table

Collectives™ on Stack Overflow

Incorrect subset of dataframe based on dynamic column names selection

1 Answer 1

1 Comment

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Linked

Related