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)

现在，我希望有这样的功能：如果用户想要仅绘制xy对，例如var1 >= 54和var3 == "B"或var2 == "3"，或其他一些组合子集规则，他们可以指定他们想要子集的变量，然后指定子集的标准。

我能想到的是允许用户编写一系列子集标准，例如只需手动输入var1 >=54 & var3=="B"，但是，此工具将由没有人使用编程背景和使用较少编程知识的解决方案更好。

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

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

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)