Two dependent filters in R Shiny with a DataTable

Question

I have two problems:

I have two dependent filters in the database, and I want to search either by player or by their ID. I also want the first filter (SelectInput) to be responsive.

If for example I enter the number 2 in the ID, I want my selectInput to display Lionel Messi automatically.

Here is the code and thank you for your answers

library(DT)
library(shinydashboard)
library(shiny)
library(shinyWidgets)
library(dplyr)

Database<- data.frame(Player=c("Cristiano Ronaldo","Lionel Messi","Neymar Jr","Cristiano Ronaldo"),ID=c(1,2,3,1))

ui<-dashboardPage(title="Application",skin="red",
                  dashboardHeader(),
                  dashboardSidebar(),
                  dashboardBody(
                    selectInput("player",HTML('Please select your player'),choices=names(table(Database$Player))),
                    searchInput(inputId = "IDSEARCH", label = HTML('Or Please write the ID player'),
                      #placeholder = "13850",
                      btnSearch = icon("search"),
                      btnReset = icon("remove"),
                      width = "500px"),
                    DT::dataTableOutput("mtable2")
                    ))





server <- function(input, output){
  mtable2 <- reactive({filter(Database,(Player==input$player|ID==input$IDSEARCH))})
 output$mtable2<-DT::renderDataTable({DT::datatable(mtable2())})
    
    
    
}
shinyApp(ui,server)

Answer 1

this is my solution to your problem. After the code I explain several things there.

library(DT)
library(shinydashboard)
library(shiny)
library(shinyWidgets)

Database <- data.frame(
  Player = c("Cristiano Ronaldo", "Lionel Messi", "Neymar Jr", "Cristiano Ronaldo"),
  ID = c(1, 2, 3, 1), 
  stringsAsFactors = FALSE
)

ui <- dashboardPage(title = "Application", skin = "red",
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    selectInput(
    inputId = "player", 
    label = "Please select your player",
      choices = unique(Database$Player)
    ),
    searchInput(
      inputId = "id", 
      label = "Or Please write the ID player",
      btnSearch = icon("search"),
      btnReset = icon("remove"),
      width = "500px"
    ),
    DT::dataTableOutput("mtable2")
  )
)


server <- function(input, output, session) {
  mtable2 <- reactive({
    if (!isTruthy(input$id)) {
      idx <- Database$Player == input$player
    } else {
      idx <- Database$ID == input$id
    }
    Database[idx, ]
  })
  
  output$mtable2 <- DT::renderDataTable({
    DT::datatable(mtable2())
  })
  
  observeEvent(input$id, {
    req(input$id)
    selected_plyr <- unique(Database[Database$ID == input$id, ]$Player)
    
    if (length(selected_plyr) == 0) {
      showNotification("There is no player for the given ID", type = "error")
      req(FALSE)
    }
    
    if (length(selected_plyr) > 1) {
      showNotification("There is more than one player for a given ID", type = "error")
      req(FALSE)
    }
    
    updateSelectInput(
      session = session,
      inputId = "player",
      selected = selected_plyr
    )
  })

}
shinyApp(ui,server)

1. There is no need to wrap the input labels within HTML().
2. I've slightly modified how you pick the choices for the selectInput(). Note the stringsAsFactors = FALSE when creating the data frame (in R >= 4.0.0 this is not needed).
3. I wouldn't use a searchInput for the ID, but since it was your choice I'm keeping it here.
4. The isTruthy() function checks whether the value in input$id is "truthy" as the name says. Basically it checks it is not NULL, empty string, NA, etc. So, when no ID is given, we use the name in the selectInput() to filter.
5. The filtering could be done with {dplyr} but it is also very easy with base R (just subset notation Database[idx, ].
6. I added an observer to input$id that updates the selectInput(). Note you need to pass the session, which becomes an argument to your server function...

Well, just feel free to ask if you have any questions!

EDIT:

To use {dplyr} I would change the following

    if (!isTruthy(input$id)) {
      idx <- Database$Player == input$player
    } else {
      idx <- Database$ID == input$id
    }
    Database[idx, ]

would be rewritten as

    if (!isTruthy(input$id)) {
      Database %>% filter(Player == input$player)
    } else {
      Database %>% filter(ID == input$id)
    }

and replace

selected_plyr <- unique(Database[Database$ID == input$id, ]$Player)

with

selected_plyr <- Database %>% filter(ID == input$id) %>% pull(Player) %>% unique()