Как выбрать определенные строки в реактивном наборе данных в R Shiny

Question

У меня есть реактивные данные react$data, и у меня есть два входа input$chosencolumn, input$chosenrows

С реактивным набором данными, как бы я быть в состоянии указать строки, которые я хочу, как у data.frame где вы data[data$chosencolumn == chosenrows,]

Возпроизводимо пример:

server.R 

### Start of Shiny server 
shinyServer(function(input, output, session) { 

    reactdata <- reactiveValues() 
    observe({ 
    if(is.null(input$fileinput)){return(NULL)} 
    else{reactdata$inputdata <- read.xlsx(input$fileinput$datapath, header=T, sheetIndex = 1)} 
    }) 



    output$selectsamples <- renderUI({ 
    if(is.null(input$fileinput)){return(NULL)} 
    selectInput("selectsamples", 
       label = h5("Samples"), choices = colnames(reactdata$inputdata), 
       selected="Sample") 
    }) 

    output$sampleselected <- renderUI({ 
    if(is.null(input$fileinput)){return(NULL)} 
    selectInput("sampleselected", 
       label = h5("sampleselected"), choices = unique(as.character(reactdata$inputdata[,input$selectsamples])), 
       selected="B") 
    }) 

    output$selectdilutions <- renderUI({ 
    if(is.null(input$fileinput)){return(NULL)} 
    selectInput("selectdilutions", 
       label=h5("Select Dilutions"), 
       choices = colnames(reactdata$inputdata), 
       selected="Dilution") 
    }) 


    reactdata1 <- reactiveValues() 
    observe({ 
    reactdata1$datatable1 <- datatable(reactdata$inputdata, 
       rownames = TRUE, 
       options = list(pageLength = 100, dom = 'tip')) 

    }) 


    output$datatable1 <- renderDataTable({ 
    reactdata1$datatable1 
    }) 

}) 

ui.R 

require(shiny) 
require(devtools) 
require(grDevices) 
require(xlsx) 
require(DT) 


shinyUI(fluidPage(
    navbarPage("",inverse = FALSE, 
      tabPanel("Analyse")), 
    titlePanel(""), 
    fluidRow(
    column(3, 
      wellPanel(
      fileInput("fileinput", label = h5("Input file")), 
      uiOutput("selectsamples"), 
      uiOutput("sampleselected"), 
      uiOutput("selectdilutions") 
      )), 

    column(9, 
      fluidRow(
      wellPanel(
        uiOutput("sample1"), 
        dataTableOutput("datatable1")) 

      ))) 
    ) 
) 

Я хотел бы изменить reactdata1$datatable1 так, что она включает в себя только строки данных, выбранных SAMP le выбран (т.е. выбирается значение, выбранное в качестве входных $ samples).

Так, что-то вроде reactdata1$datatable1[input$selectsamples == input$sampleselected,]

Пример набора данных здесь: Dropbox link to excel file

Answer 1

Вот общий пример, где подмножество реактивную data.frame на основе динамически введен пользовательский ввод:

require(shiny) 

ui <- shinyUI(fluidPage( 
    sidebarLayout(
    sidebarPanel(
     selectInput("dataset", "Choose a dataset:", 
        choices = c("rock", "pressure", "cars","DNase","iris") 
    ), 
     selectizeInput(
     'colName', 'Select Column: ', list(), multiple = TRUE 
    ), 
     selectizeInput(
     'rowName', 'Select Rows', list(), multiple = TRUE 
    ) 
    ), 
    mainPanel(
     tableOutput('tbl') 
    ) 
) #end sidebar layout 
)) 

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

    datasetInput <- reactive({ 
    switch(input$dataset, 
      "rock" = rock, 
      "pressure" = pressure, 
      "cars" = cars, 
      "DNase"=DNase, 
      "iris"=iris) 
    }) 

    # Update UI 
    observe({ 
    updateSelectizeInput(session, "colName", choices = colnames(datasetInput())) 
    updateSelectizeInput(session, "rowName", choices = rownames(datasetInput())) 
    }) 

    # Create reactive data by subseting the reactive dataset 
    r1 <- reactive({ 
    v <- input$colName %in% colnames(datasetInput()) 
    if(sum(v == FALSE) > 0) return() # Check for missmatching datasetInput names and column names 
    if(is.null(input$colName) || is.null(input$rowName)) return() # None selected, return empty 

    # Subset data 
    datasetInput()[as.numeric(input$rowName), input$colName, drop=FALSE] 
    }) 

    output$tbl <- renderTable({ 
    r1() 
    }) 
}) 

shinyApp(ui, server)