Question

此代码读入数据，查找列的唯一值（Location），并将这些值作为选项放在下拉菜单中。我的目标是根据下拉菜单中选择的值自定义数据。我的数据如下所示：

我试图查看数据但发现它无法正常工作。我该怎么办？

更新1：问题出在data()$Location == input$Locationscheck，但我不知道如何修复它。

library(shiny)

dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {

  status <- match.arg(status)
  # dropdown button content
  html_ul <- list(
    class = "dropdown-menu",
    style = if (!is.null(width)) 
      paste0("width: ", validateCssUnit(width), ";"),
    lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
  )
  # dropdown button apparence
  html_button <- list(
    class = paste0("btn btn-", status," dropdown-toggle"),
    type = "button", 
    `data-toggle` = "dropdown"
  )
  html_button <- c(html_button, list(label))
  html_button <- c(html_button, list(tags$span(class = "caret")))
  # final result
  tags$div(
    class = "dropdown",
    do.call(tags$button, html_button),
    do.call(tags$ul, html_ul),
    tags$script(
      "$('.dropdown-menu').click(function(e) {
      e.stopPropagation();
});")
  )
}

ui <- fluidPage(
  fileInput(inputId = "uploadedcsv","", accept = '.csv'),
  dropdownButton(label = "Choose the locations",status = "default",
                 width = 250,actionButton(inputId = "allLocations", label = "(Un)select all"),
                 checkboxGroupInput(inputId = "Locationscheck",label = "Choose",choices = "")),
  actionButton('Run', label = "Run!")
)

server <- function(input, output, session) {

  data <- reactive({
    infile <- input$uploadedcsv

    if (is.null(infile))
      return(NULL)

    read.csv(infile$datapath, header = TRUE, sep = ",")
  })

  observe({
    locationnames <- unique(data()$Location)
    updateCheckboxGroupInput(session, "Locationscheck",
                             choices = locationnames,
                             selected = locationnames)

    ### selecting and de-selecting in step 2 ###
    observeEvent(input$allLocations, {
      if (is.null(input$Locationscheck)) {
        updateCheckboxGroupInput(session = session,
                                 inputId = "Locationscheck",
                                 selected = locationnames)
      } else {
        updateCheckboxGroupInput(session = session,
                                 inputId = "Locationscheck",
                                 selected = "")
      }
    })
    ### End of selecting and de-selecting ###

    observeEvent(input$Run, {
      Newdata <- data()[data()$Location == input$Locationscheck,]
      View(data())
      View(Newdata)
    })

  })
}
shinyApp(ui = ui, server = server)

Answer 1

代码data()$Location == input$Locationscheck中的问题是它只考虑input$Locationscheck向量中的第一个元素，并将结果作为匹配的值（例如：Location1）。您应该使用which(data()[data()$Location %in% input$Locationscheck,])代替。 which为索引提供%in% data()$Location与input$Locationscheck向量中的所有值进行比较。

我修改了你的代码并进一步添加了一个表来说明工作：

library(shiny)

 dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {

   status <- match.arg(status)
   # dropdown button content
   html_ul <- list(
     class = "dropdown-menu",
     style = if (!is.null(width)) 
       paste0("width: ", validateCssUnit(width), ";"),
     lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
   )
   # dropdown button apparence
   html_button <- list(
     class = paste0("btn btn-", status," dropdown-toggle"),
     type = "button", 
     `data-toggle` = "dropdown"
   )
   html_button <- c(html_button, list(label))
   html_button <- c(html_button, list(tags$span(class = "caret")))
   # final result
   tags$div(
     class = "dropdown",
     do.call(tags$button, html_button),
     do.call(tags$ul, html_ul),
     tags$script(
       "$('.dropdown-menu').click(function(e) {
       e.stopPropagation();
 });")
  )
   }

 ui <- fluidPage(
   fileInput(inputId = "uploadedcsv","", accept = '.csv'),
   dropdownButton(label = "Choose the locations",status = "default",
                  width = 250,actionButton(inputId = "allLocations", label = "(Un)select all"),
                  checkboxGroupInput(inputId = "Locationscheck",label = "Choose",choices = "")),
   actionButton('Run', label = "Run!"),
   tableOutput('table')
 )

 server <- function(input, output, session) {

   data <- reactive({
     infile <- input$uploadedcsv

     if (is.null(infile))
       return(NULL)

     read.csv(infile$datapath, header = TRUE, sep = ",", stringsAsFactors = FALSE)
   })

   observe({
     locationnames <- unique(data()$Location)

     updateCheckboxGroupInput(session, "Locationscheck",
                              choices = locationnames,
                              selected = locationnames)

     ### selecting and de-selecting in step 2 ###
     observeEvent(input$allLocations, {
       if (is.null(input$Locationscheck)) {
         updateCheckboxGroupInput(session = session,
                                  inputId = "Locationscheck",
                                  selected = locationnames)
       } else {
         updateCheckboxGroupInput(session = session,
                                  inputId = "Locationscheck",
                                  selected = "")
       }
     })
     ### End of selecting and de-selecting ###

     observeEvent(input$Run, {
       # Newdata <- data()[data()$Location == input$Locationscheck,]
       Newdata <- data()[which(data()$Location %in% input$Locationscheck),]
       # # View(data())
       # View(Newdata)
       output$table <- renderTable({
         Newdata
       })

     })

   })
 }
 shinyApp(ui = ui, server = server)

我建议您在访问该值时使用isolate，以便不会一次又一次地触发被动事件，例如Newdata <- isolate(data())[which(isolate(data())$Location %in% input$Locationscheck),]

希望它有所帮助！

通过下拉菜单选择数据行

1 个答案: