Question

我喜欢根据动态用户输入过滤数据。下面提到的示例代码是可执行的，但是，目前，它没有过滤数据的逻辑。因此，表格不会随着任何变量的选择而改变。
代码主要有三个组成部分：1。前几行代码创建一个数据框，其中的信息可用于动态创建控件小部件; 2. ui代码; 3. server目前有动态创建控件小部件的逻辑，我需要弄清楚如何使用动态创建的控件小部件和过滤数据（用于不同目的）的信息。我无法弄清楚如何根据其范围跟踪变量和过滤的数量。非常感谢建议。

## Create a data frame of which information is used in creating (dynamical) control widgets
varnames <- names(iris[,1:4]) # names
varinit <- apply(iris[,1:4],2,median) # initival value used in slider
varmin <- apply(iris[,1:4],2,min) # min.
varmax <- apply(iris[,1:4],2,max) # max. 

## dataframe
vardf <- data.frame(varnames,varmin,varmax,varinit)

ui <- fluidPage(
   checkboxGroupInput("ConditioningVariables", "Conditioning variables (choose one or more):",
                      varnames,inline = TRUE),
uiOutput("ControlWidgetsofConditioningVariables"),
   tableOutput("data")
)

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

   output$ControlWidgetsofConditioningVariables <- renderUI({
      if (is.null(input$ConditioningVariables)){
         return() 
      } else {
         selvarnames = sort(input$ConditioningVariables)
         selpos = sapply(selvarnames,function(x) which(varnames==x))
         # create a taglist of dynamic widgets
         ListofDynamicWidgets <- lapply(selpos, function(x){sliderInput(as.character(vardf[x,1]),
                                                          as.character(vardf[x,1]),
                                                          vardf[x,2],vardf[x,3],
                                                          vardf[x,4],.1)})
         do.call(tagList, ListofDynamicWidgets)
      }
   })
   ## filter data as per selected variables and their range
   ## this is where I'm kind of struck, I think I need to track number of variables (is list good idea?)
   ## and filter as per selected range of a specific variable
   newdata <- reactive({
      subset(iris)
   })
   output$data <- renderTable({ newdata() })
   }
shinyApp(ui, server)

Answer 1

这是一种方法（请注意，我稍微修改了代码以生成小部件）。主要思想是生成范围向量的命名列表（conds），将范围转换为表示过滤条件（subs）的字符串列表，将它们折叠成一个长字符串条件，并将其用作filter_()的子集参数。

library(dplyr)
server <- function(input, output, session) {
  allControls <- lapply(setNames(varnames, varnames), function(x) {
    sliderInput(x, x, varmin[x], varmax[x], c(varmin[x], varinit[x]), 
      round = -2)
  })
  output$ControlWidgetsofConditioningVariables <- renderUI({    
    if (is.null(input$ConditioningVariables)){
      return() 
    } else {
      allControls[input$ConditioningVariables]
    }
  })
  ## filter data as per selected variables and their range
  newdata <- reactive({
    if(!is.null(input$ConditioningVariables)) {
      cond_names <- input$ConditioningVariables
      conds <- lapply(setNames(cond_names, cond_names), function(x) input[[x]])
      subs <- mapply(function(name, range){
        if (!is.null(range))
          sprintf("%1$s >= %2$f & %1$s <= %3$f", name, range[1], range[2])
      }, names(conds), conds)
      subs <- subs[!sapply(subs, is.null)]
      if (length(subs) > 0)
        filter_(iris, paste0(subs, collapse = " & "))    
      } else {
        iris
      }
    })
  output$data <- renderTable({ newdata() })
}

输出：

根据动态用户输入对数据进行子集或过滤

1 个答案: