ドロップダウンメニューでデータ行を選択する

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ベクトルの最初の要素を考慮し、あなたにマッチした値（例：位置1）として結果を与えることです。代わりにwhich(data()[data()$Location %in% input$Locationscheck,])を使用する必要があります。 whichはインデックスを与え、は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),]

希望します！