How to select certain rows in a reactive dataset in R Shiny

Question

I have reactive data react$data , and I have two inputs input$chosencolumn , input$chosenrows

With the reactive dataset, how would I be able to specify rows I want like a data.frame where you do data[data$chosencolumn == chosenrows,]

Reproducible example:

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"))

              )))
    )
)

I would like to change reactdata1$datatable1 so that it only includes rows of data chosen by the sample selected (ie the value that input$sampleselected is chosen as).

So, something like reactdata1$datatable1[input$selectsamples == input$sampleselected,]

An example dataset is here: Dropbox link to excel file

Answer 1

Here's a general example where you subset a reactive data.frame based on dynamically entered user input:

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)