时间戳

首页 > 解决方案 > R Shiny 中的两个依赖过滤器和一个 DataTable

r - R Shiny 中的两个依赖过滤器和一个 DataTable

问题描述

我有两个问题：

我在数据库中有两个依赖过滤器，我想按玩家或他们的 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)

标签： rfiltershinyshinydashboardflexdashboard

解决方案

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


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. 我不会使用 asearchInput作为 ID，但由于这是您的选择，我将其保留在这里。
  4. 该isTruthy()函数检查 in 中的值是否input$id如名称所述“真实”。基本上它会检查它不是 NULL、空字符串、NA 等。因此，当没有给出 ID 时，我们使用selectInput()过滤器中的名称。
  5. 过滤可以使用 {dplyr} 完成，但使用 base 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()

推荐阅读