如何在R Shiny中选择必须满足多重条件的矩阵行

Question

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:

1. Via checkboxGroupInput where user can select one or more numbers
2. 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)
 }

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

})