Блестящий универсальный фильтр данных с флажком и ползунком диапазона - PullRequest
Новая
       41

Блестящий универсальный фильтр данных с флажком и ползунком диапазона

0 голосов
/ 26 февраля 2019

В моем блестящем приложении, куда я могу загрузить любой набор данных, я пытаюсь добавить систему фильтров, чтобы выбрать любой столбец и фильтровать данные с помощью sliderInput или checkboxInput

Мои проблемы:
-после 1 фильтра следующие не работают
- снятие последнего флажка не удаляет фильтр для этого столбца

Я нашел это SO: Shiny - фильтры динамических данных с использованием insertUI что я использовал базовый, но разрешить только фильтр с флажком (непрактично с данными числовых значений) 

library(shiny)
library(shinyWidgets)

mydata = iris

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(6, actionButton('addFilter', 'Add filter')),
        offset = 6
      ),
      tags$hr(),
      tags$div(id = 'placeholderAddRemFilt'),
      tags$div(id = 'placeholderFilter'),
      width = 4 # sidebar
    ),
    mainPanel(
      tableOutput("data")
    )
  )
)

server <- function(input, output,session) {
  filter <- character(0)

  makeReactiveBinding("aggregFilterObserver")
  aggregFilterObserver <- list()

  observeEvent(input$addFilter, {
    add <- input$addFilter
    filterId <- paste0('Filter_', add)
    colfilterId <- paste0('Col_Filter_', add)
    rowfilterId <- paste0('Row_Filter_', add)
    removeFilterId <- paste0('Remove_Filter_', add)
    headers <- names(mydata)

    insertUI(
      selector = '#placeholderFilter',
      ui = tags$div(id = filterId,
                    actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
                    selectInput(colfilterId, label = "Some Filter", choices = as.list(headers), selected = 0),
                    uiOutput("rowfilterIdP")
      )
    )
    #select column observer
    observeEvent(input[[colfilterId]], {
      col <- input[[colfilterId]]
      values <- as.list(unique(mydata[col]))[[1]]

      output$rowfilterIdP = renderUI(
        if (is.numeric(values)) {
          shinyWidgets::sliderTextInput(inputId = rowfilterId, label = "select", choices = as.character(order(values)))
        }else{
          checkboxGroupInput(rowfilterId , label = "Select variable    values", 
                             choices = values, selected = values, inline = TRUE)
        }
      )
      aggregFilterObserver[[filterId]]$col <<- col
      aggregFilterObserver[[filterId]]$rows <<- NULL
      print("----")
      print(aggregFilterObserver)
    })
    #input observer
    observeEvent(input[[rowfilterId]], {
      rows <- input[[rowfilterId]]
      aggregFilterObserver[[filterId]]$rows <<- rows
      print("----")
      print(aggregFilterObserver)
    })
    #remove selected filter
    observeEvent(input[[removeFilterId]], {
      removeUI(selector = paste0('#', filterId))
      aggregFilterObserver[[filterId]] <<- NULL
      print("----")
      print(aggregFilterObserver)
    })
  })

  output$data <- renderTable({
    dataSet <- mydata
    invisible(lapply(aggregFilterObserver, function(filter){
      dataSet <<- dataSet[which(!(dataSet[[filter$col]] %in% filter$rows)), ]
    }))
    dataSet
  })
}

shinyApp(ui = ui, server = server)

Как я могу изменить этот код, чтобы разрешить фильтр числового вывода с ползунком диапазона.Вот мой взгляд на код: 

library(shiny)

mydata = iris

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(6, actionButton('addFilter', 'Add filter')),
        offset = 6
      ),
      tags$hr(),
      tags$div(id = 'placeholderAddRemFilt'),
      tags$div(id = 'placeholderFilter'),
      width = 4 # sidebar
    ),
    mainPanel(
      tableOutput("data")
    )
  )
)

server <- function(input, output,session) {
  filter <- character(0)

  makeReactiveBinding("aggregFilterObserver")
  aggregFilterObserver <- list()

  observeEvent(input$addFilter, {
    add <- input$addFilter
    filterId <- paste0('Filter_', add)
    colfilterId <- paste0('Col_Filter_', add)
    rowfilterId <- paste0('Row_Filter_', add)
    removeFilterId <- paste0('Remove_Filter_', add)
    headers <- names(mydata)

    insertUI(
      selector = '#placeholderFilter',
      ui = tags$div(id = filterId,
                    actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
                    selectInput(colfilterId, label = "Some Filter", choices = as.list(headers), selected = 1),
                    uiOutput("rowfilterIdP")
      )
    )

    observeEvent(input[[colfilterId]], {
      col <- input[[colfilterId]]
      values <- as.list(unique(mydata[col]))[[1]]

      output$rowfilterIdP = renderUI(
        if (is.numeric(values)) {
          shinyWidgets::sliderTextInput(inputId = rowfilterId, label = "select", choices = as.character(order(values)))
        }else{
          checkboxGroupInput(rowfilterId , label = "Select variable    values", 
                             choices = values, selected = values, inline = TRUE)
        }
      )
      aggregFilterObserver[[filterId]]$col <<- col
      aggregFilterObserver[[filterId]]$rows <<- NULL
      print("----")
      print(aggregFilterObserver)
    })

    observeEvent(input[[rowfilterId]], {
      rows <- input[[rowfilterId]]
      aggregFilterObserver[[filterId]]$rows <<- rows
      print("----")
      print(aggregFilterObserver)
    })

    observeEvent(input[[removeFilterId]], {
      removeUI(selector = paste0('#', filterId))
      aggregFilterObserver[[filterId]] <<- NULL
      print("----")
      print(aggregFilterObserver)
    })
  })

  output$data <- renderTable({
    dataSet <- mydata
    invisible(lapply(aggregFilterObserver, function(filter){
      dataSet <<- dataSet[which(!(dataSet[[filter$col]] %in% filter$rows)), ]
    }))
    dataSet
  })
}

shinyApp(ui = ui, server = server)
...