R中上下限的多重过滤器

所有这些代码都改编自

我目前正在使用R Shining代码，该代码应该允许创建多个过滤器（Shining服务器允许的数量）

每个过滤器包括选择要过滤的变量、上限、下限，以及是否仅通过取上限和下限之间的值（即lwrupr）。我已将相关代码编译成与此问题特别相关的代码

源代码（简化代码）如下所示：

library(shiny)
library(ggplot2)

# Column names of file.
logColumns <- names(read.csv("file.csv"))

ui <- fluidPage(

   titlePanel("Testing Filters"),

   sidebarLayout(
      sidebarPanel(
        # Data type to display as Y value in graph.
        selectInput("display", label = "Data Type", choice = logColumns),

        # Button to activate addFilter actions.
        fluidRow(
          column(6, actionButton('addFilter', "Add Filter")),
          offset=6
        ),
        tags$hr(),
        # Area to generate new filters.
        tags$div(id='filters'),
        width = 4
      ),

      mainPanel(
         # Displays plot.
         plotOutput("distPlot")
      )
   )
)

server <- function(input, output, session) {
  # File to use.
  usefile <- reactive({
    # Placeholder code, does basic file reading for now.
    # Basic (unedited) file format is time (in milliseconds) in first column
    # followed by other columns with different types of data, e.g., voltage.
    usefile <- read.csv("file.csv", header=TRUE)
    usefile$time <- usefile$time / 1000
    usefile
  })
  # Column names of above file.
  logNames <- reactive({
    names(usefile())
  })

  # Turns aggregFilterObserver into a reactive list.
  makeReactiveBinding("aggregFilterObserver")
  aggregFilterObserver <- list()

  observeEvent(input$addFilter, {

    # Generates unique IDs for each filter.
    add <- input$addFilter
    filterId <- paste0('filter', add)
    colFilter <- paste0('colFilter', add)
    lwrBoundNum <- paste0('lowerBound', add)
    uprBoundNum <- paste0('upperBound', add)
    removeFilter <- paste0('removeFilter', add)
    exclusivity <- paste0('exclusivity', add)

    # Dictates which items are in each generated filter, 
    #   and where each new UI element is generated.
    insertUI(
      selector = '#filters',
      ui = tags$div(id = filterId,
                    actionButton(removeFilter, label = "Remove filter", style = "float: right;"),
                    selectInput(colFilter, label = paste("Filter", add), choices = logNames()),
                    numericInput(lwrBoundNum, label = "Lower Bound", value=0, width = 4000),
                    numericInput(uprBoundNum, label = "Upper Bound", value=0, width = 4000),
                    checkboxInput(exclusivity, label = "Within Boundaries?", value=TRUE)
      )
    )

    # Generates a filter and updates min/max values.
    observeEvent(input[[colFilter]], {

      # Selects a data type to filter by.
      filteredCol <- usefile()[[input[[colFilter]]]]

      # Updates min and max values for lower and upper bounds.
      updateNumericInput(session, lwrBoundNum, min=min(filteredCol), max=max(filteredCol))
      updateNumericInput(session, uprBoundNum, min=min(filteredCol), max=max(filteredCol))

      # Stores data type to filter with in col, and nulls rows.
      aggregFilterObserver[[filterId]]$col <<- input[[colFilter]]
      aggregFilterObserver[[filterId]]$rows <<- NULL
    })

    # Creates boolean vector by which to filter data.
    observeEvent(c(input[[lwrBoundNum]], input[[uprBoundNum]], input[[colFilter]], input[[exclusivity]]), {
      # Takes only data between lower and upper bound (inclusive), or
      if (input[[exclusivity]]){
        rows <- usefile()[[input[[colFilter]]]] >= input[[lwrBoundNum]]
        rows <- "&"(rows, usefile()[[input[[colFilter]]]] <= input[[uprBoundNum]])
      }
      # Takes only data NOT between lower and upper bounds (inclusive).
      else{
        rows <- usefile()[[input[[colFilter]]]] < input[[lwrBoundNum]]
        rows <- "|"(rows, usefile()[[input[[colFilter]]]] > input[[uprBoundNum]])
      }

      aggregFilterObserver[[filterId]]$rows <<- rows
    })

    # Removes filter.
    observeEvent(input[[removeFilter]], {
      # Deletes UI object...
      removeUI(selector = paste0('#', filterId))

      # and nulls the respective vectors in aggregFilterObserver.
      aggregFilterObserver[[filterId]] <<- NULL
    })
  })

  # Filters data based on boolean vectors contained in aggregFitlerObserver
  adjusted <- reactive({
    toAdjust <- rep(TRUE,nrow(usefile()))
    lapply(aggregFilterObserver, function(filter){
      toAdjust <- "&"(toAdjust, filter$rows)
    })
    subset(usefile(), toAdjust)
  })

  # Creates plot based on filtered data and selected data type
  output$distPlot <- renderPlot({
    xData <- adjusted()$time
    yData <- adjusted()[[input$display]]
    curData <- data.frame(xData, yData)
    plot <- ggplot(data=curData, aes(x=xData, y=yData)) + geom_point() + labs(x = "Time (seconds)", y = input$display)
    plot
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

---

谢谢你的帮助

问题来自这样一个事实：您从未存储过滤结果。当您定义调整后的

时，
lappy
的结果永远不会被存储

# Filters data based on boolean vectors contained in aggregFitlerObserver
adjusted <- reactive({
  toAdjust <- rep(TRUE,nrow(usefile()))
  tmp <- lapply(aggregFilterObserver, function(filter){
           toAdjust <- "&"(toAdjust, filter$rows)
         })
  if (length(tmp$filter1) == 0) {
    return(usefile())
  } else {
    subset(usefile(), tmp$filter1)
  }
})

#根据aggregFitlerObserver中包含的布尔向量过滤数据
调整了啊，我原以为在运行lappy时会改变调整。谢谢
# Filters data based on boolean vectors contained in aggregFitlerObserver
adjusted <- reactive({
  toAdjust <- rep(TRUE,nrow(usefile()))
  tmp <- lapply(aggregFilterObserver, function(filter){
           toAdjust <- "&"(toAdjust, filter$rows)
         })
  if (length(tmp$filter1) == 0) {
    return(usefile())
  } else {
    subset(usefile(), tmp$filter1)
  }
})