在 Shiny 中对数据进行子集化的选项

Question

我正在 Shiny 中创建一个交互式绘图，用户将上传一个带有 x 和 y 坐标的数据集（因此 x 为一列，y 为一列），然后 Shiny 将绘制一个散点图。用户上传的数据集将具有额外的列，这些列将为子集提供信息。例如，这可能是用户上传的数据集（称为dat）：

n = 100
x = runif(n,0,100)
y = runif(n,0,100)

var1 = sample(1:100,n,replace=TRUE)
var2 = as.factor(sample(1:3,n,replace=TRUE))
var3 = sample(c("A","B"),n,replace=TRUE)

dat = data.frame(x,y,var1,var2,var3)

现在，我想拥有这样的功能，如果用户只想绘制 x-y 对，例如 var1 >= 54 和 var3 == "B" 或 var2 == "3"，或其他子集规则的组合，他们可以指定他们想要对其进行子集化的变量，然后是子集化的标准。

我能想到的是允许用户编写一个子集标准字符串，例如让他们手动输入var1 >=54 & var3=="B"，但是，这个工具将由没有编程背景的人使用因此，使用较少编程知识的解决方案越好。

我还可以设想有一个字段的东西，你用子集变量填充它，另一个框说>, >=, =, <=, <, !=，然后是值，然后如果你想进一步子集，在你填写完之后会出现另一个字段但我无法弄清楚这是否是 Shiny 中的一项现实任务。这种方法的另一个困难是如何允许用户指定 AND 和 OR 语句。

非常感谢任何帮助/cmets/建议！

Answer 1

我解决这个问题的方法是，由于空间问题，过滤条件的数量应该最大化。您可以在names 变量中设置过滤器的最大数量。 （在示例中设置为 4）

基本上每个过滤器都是相同的：它们由一个变量、一个关系运算符、一个值和一个可选的逻辑运算符组成，以设置更多过滤器。对于这些过滤器，我使用了一个名为filterModuleUI 的模块来生成带有lapply 的过滤器。最后一个过滤器不需要逻辑运算符。它是通过模块函数中的last 参数设置的。

在服务器端，为每个过滤器设置了一个observeEvent，以观察逻辑运算符。如果这些设置为"-"，则隐藏更多过滤器并且也设置为"-"。即：如果您有 4 个活动过滤器，并且您将第一个过滤器的逻辑运算符设置为 "-"，那么它将隐藏第二个、第三个和第四个过滤器。

单击apply button 时，条件将粘贴到由逻辑运算符分隔的字符串列表中。即：如果有3个条件：

...用于过滤的字符串是："x>6&x<20&var1>2"。

这是使用 eval 和 parse 函数评估的。

注意事项：

• 没有实施异常处理。
• 此代码可以进一步改进。欢迎提出修改建议。

代码如下：

library(shiny)
library(shinyjs)

# Set the maximum number of filters e.g: names <- paste0("in", 1:5) for a maximum of 5 filters. 
names <- paste0("in", 1:4)
inputs <- c("var", "oper", "val", "log")

# Create a UI module to reuse
filterModuleUI <- function(id, last = F){
  ns <- NS(id)
  tagList(
    div(class = id,
      fluidRow(
        column(2,
          selectInput(ns("var"),
            "",
            choices = colnames(dat)
          )
        ),
        column(2,
          selectInput(ns("oper"),
            "",
            choices = c(">", ">=", "==", "<=", "<", "!=")
          )
        ),
        column(2,
          textInput(ns("val"),
            ""
          )
        ),
        if(last == F){
          column(2,
            selectInput(ns("log"),
              "",
              choices = c(
                "-" = "-",
                "AND" = "&",
                "OR" = "|"
                ),
              selected = "-"
            )
          )
        }
      )
    )
  )
}

# Load demo data
n = 100
x = runif(n,0,100)
y = runif(n,0,100)

var1 = sample(1:100,n,replace=TRUE)
var2 = as.factor(sample(1:3,n,replace=TRUE))
var3 = sample(c("A","B"),n,replace=TRUE)

dat = data.frame(x,y,var1,var2,var3)


ui <- fluidPage(
  useShinyjs(),
  h3("Filter demo"),
  lapply(names, function(x){
    if(x == names[length(names)]) filterModuleUI(x, last=T)
    else filterModuleUI(x)
  }),

  actionButton("apply", "Apply filter"),
  plotOutput("plot")
)

server <- function(input, output, session){
  # Set observeEvent to hide further filterModule-s if the logical operator is set to "-"
  lapply(names, function(x){
    no_item <- which(names == x)
    input_log <- paste(x, "log", sep = "-")
    if(no_item != length(names)){
      observeEvent(input[[input_log]],{
        next_items <- names[(no_item + 1) : length(names)]
        if(input[[input_log]] == "-"){
          lapply(next_items, function(x){
            updateSelectInput(session, paste(x, "log", sep = "-"), selected = "-")
          })
          lapply(paste(next_items[1], inputs, sep = "-"), hide)
        }
        else lapply(paste(next_items[1], inputs, sep = "-"), show)
      })
    }
  })

  # Initialize data$a with a predefined data.frame (dat)
  data <- reactiveValues(a = dat)

  # Filter based on the selectInput-s
  observeEvent(input$apply,{
    obj <- lapply(names, function(x){
      lapply(inputs, function(y){
        paste(x, y, sep="-")
      })
    })
    # Construct filtering conditions by pasting variable, operator and value together (e.g.: x > 20)  
    condition <- lapply(obj, function(x){
      paste0(input[[x[[1]]]], input[[x[[2]]]], input[[x[[3]]]])
    })
    # Compute how many AND/OR logical operators are used
    used_cond <- sum(sapply(paste(names[-length(names)], "log", sep="-"), function(x){
      input[[x]] != "-"
    }))
    # Paste the conditions together with logical operators
    filter <- vector()
    for(i in 1:(used_cond + 1)){
      nm <- ifelse(i==1, "", input[[paste(names[i-1], "log", sep="-")]])
      filter <- paste(filter, condition[[i]], sep = nm)
    }
    # Check filter in console
    print(filter)
    # Filtering
    data$a <- dat[eval(parse(text=filter)), ]
  })
  output$plot <- renderPlot({
    dat <- data$a
    plot(dat$x, dat$y)
  })
}

shinyApp(ui, server)