How to select rows of a matrix which has to meet mutiple conditions in R Shiny

问题

The goal is to build an application able to select and present only rows of a matrix that meets specific conditions selected by the user via Shiny elements such as checkboxes and sliderInput Our data is subject to two (or more) ways to be filtered:

Via checkboxGroupInput where user can select one or more numbers
Via sliders. There will be one slider for each column of data. This allows user to select the range of numbers for each column.

I got stuck on making the data react to the selection entered by the user. Any suggestion is appreciated!

Here is the code that I have:

server.R

   # Load libraries.
   library(shiny)
   library(datasets)
   library(xtable)
   library(R.utils)

 shinyServer(
     function(input, output) {
      source('global.R', local=TRUE)

getDataName <- reactive({
  out <- input$dataName
  print(out)
  return(out)
})

getData <- reactive({
    cat("Getting data for, ", getDataName(), ".", sep = '')
  if(getDataName() == ""){
      print("ERROR: getDAtaName is empty! Check your code!")
      out <- NULL
  }
  else {
      dataSet <- t(combn(max(selectRange(getDataName())), numCols(getDataName())))

  }
  print(head(dataSet, n = 10))
  return(dataSet)
})


selectedValues <- reactive({
  print("Numbers selected via checkboxes:")
  print(input$numSelector)
})      

output$numSelector <- renderUI({
  out <- checkboxGroupInput(
    inputId = "numSelector",
    label   = "Select the numbers to be included in the rows",
    choices = selectRange(input$dataName),  
    inline = TRUE
  )
  return(out)
})

output$sliders <- renderUI({
  numSliders <- numCols(input$dataName)
  lapply(1:numSliders, function(i) {
    sliderInput(
      inputId = paste0('column', i),
      label = paste0('Select the range for column ', i),
      min = min(selectRange(input$dataName)),
      max = max(selectRange(input$dataName)),
      value = c(min(selectRange(input$dataName)), max(selectRange(input$dataName))),
      step =1)
  })
})



output$selectedDataDisplay <- renderDataTable({
  as.table(getData())}, options = list(lengthMenu = c(5, 30, 50), pageLength = 10))
}

)

ui.R

library(shiny)

 shinyUI(
    pageWithSidebar(
       headerPanel("Selection zone"),

# Select inputs
sidebarPanel(

  selectInput(
    inputId = "dataName",
    label   = "Select data",
    choices = c("data1", "data2", "data3", "data4")
  ),


  uiOutput(outputId = "numSelector"),
  uiOutput(outputId = "sliders")

),

mainPanel(
   tableOutput("selectedDataDisplay"))

 )
)

global.R

 selectRange <- function(x){
 if(x == "data1"){choices = c(1:10)}
 if(x == "data2"){choices = c(1:15)}
 if(x == "data3"){choices = c(1:20)}
 if(x == "data4"){choices = c(1:25)}
 return(choices)
}

numCols <- function(x){
 if(x == "data1"){maxNum = 10
               numCol = 5}
 if(x == "data2"){maxNum = 15
               numCol = 5}
 if(x == "data3"){maxNum = 20 
              numCol = 5}
 if(x == "data4"){maxNum = 25 
              numCol = 6}
 return(numCol)
 }

回答1:

You did not provide your actual data sets, so I simulated a couple, and I don't have your exact formulas but hopefully you can extend the idea:

ui.R

shinyUI(
  pageWithSidebar(
    headerPanel("Selection zone"),

    # Select inputs
    sidebarPanel(

      # User enters name of dat.frame here.
      selectInput(
        inputId = "dataName",
        label   = "Select your data",
        choices = c("data1", "data2", "data3", "data4")
      ),


      uiOutput(outputId = "numSelector"),
      uiOutput(outputId = "sliders")

    ),

    mainPanel(
      tabsetPanel(
        tabPanel("Model Summary", dataTableOutput("selectedDataDisplay"), textOutput("vars"))

      )
    )
  ))

server.R

library(shiny)
library(data.table)

data1 <- matrix(round(runif(10000, min = 1, max = 20), 0), ncol = 10)
data2 <- matrix(round(runif(10000, min = 1, max = 20), 0), ncol = 10)
data3 <- matrix(round(runif(10000, min = 1, max = 20), 0), ncol = 10)
data4 <- matrix(round(runif(10000, min = 1, max = 20), 0), ncol = 10)

shinyServer(function(input, output) {

  output$numSelector <- renderUI({
    out <- checkboxGroupInput(
      inputId = "numSelector",
      label   = "Select the numbers to be included in the rows",
      choices = 1:20,  
      inline = TRUE
    )
    return(out)
  })


  output$sliders <- renderUI({
    numSliders <- eval(parse(text = c("ncol(",input$dataName, ")")))
    lapply(1:numSliders, function(i) {
      sliderInput(
        inputId = paste0('column', i),
        label = paste0('Select the range for column ', i),
        min = 1,
        max = 20,
        value = c(1, 20),
        step = 1)
    })
  })

  dataSet <- reactive({
    if ( is.null(input$column1) ){

    } else {
      colName <- "Column"
      eval(parse(text = c(paste0("set <- as.data.table(", input$dataName, ")"))))
      setnames(set, colnames(set), paste0(colName, seq(ncol(set))))

      # generate boolean values for each column's rows based upon individual ranges & the over all 
      validRows <- list()
      for(k in seq(ncol(set))){
        validRows[[k]] <- eval(parse(text = paste0("with(set, ", colName, k, " %in% input$column", k, "[1]:input$column", k, "[2] &  ", colName, k, " %in% input$numSelector )")))
      }

      validRows <- do.call(cbind, validRows)

      # if any of the column's conditions are satisfied, the row is accepted
      validRows <- apply(validRows, 1, any)

      # ouput accepted rows
      set[ validRows ]  
    }
  })

  output$selectedDataDisplay <- renderDataTable(dataSet(), options = list(lengthMenu = c(5, 30, 50), pageLength = 10))

})

来源：https://stackoverflow.com/questions/29827829/how-to-select-rows-of-a-matrix-which-has-to-meet-mutiple-conditions-in-r-shiny

标签

Shiny