通过下拉菜单选择数据行

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),]

希望它有帮助！