通過下拉菜單選擇數據行

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

希望它有幫助！