R Shiny中带有数据表的两个从属过滤器

问题描述

我有两个问题：

我在数据库中有两个从属过滤器，我想按播放器或按其ID搜索。我还希望第一个过滤器（SelectInput）能够响应。

例如，如果我在ID中输入数字2，则希望我的selectInput自动显示Lionel Messi。

这是代码，谢谢您的回答

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)

解决方法

这是我为您解决的问题。在代码之后，我在那里解释了几件事。

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. 无需在HTML()中包装输入标签。
2. 我对您选择selectInput()的方式进行了一些修改。创建数据框时，请注意stringsAsFactors = FALSE（在R> = 4.0.0中是不需要的）。
3. 我不会使用searchInput作为ID，但是由于您是自己的选择，因此我将其保留在这里。
4. isTruthy()函数检查input$id中的值是否真如其名。基本上，它检查它是否不是NULL，空字符串，NA等。因此，当未给出ID时，我们使用selectInput()中的名称进行过滤。
5. 可以使用{dplyr}进行过滤，但是使用基数R（仅使用子集表示法Database[idx,]也非常容易。
6. 我向input$id添加了一个观察者，以更新selectInput()。请注意，您需要传递session，它成为服务器函数的参数...

好吧，随便问你有什么问题！

编辑：

要使用{dplyr}，我需要更改以下内容

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

将被重写为

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

并替换

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

使用

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