带有DataTable的R Shiny中的两个相关筛选器

Question

我有两个问题：

我在数据库中有两个相关的过滤器，我想按玩家或他们的ID进行搜索。我还希望第一个过滤器(SelectInput(能够响应。

例如，如果我在ID中输入数字2，我希望我的selectInput自动显示莱昂内尔·梅西。

这是代码，谢谢你的回答

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

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

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中，这是不需要的(
3. 我不会用searchInput作为身份证，但既然是你的选择，我就把它放在这里
4. CCD_ 5函数检查CCD_；truthy；正如名字所说。基本上，它会检查它是否为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()