闪亮-使用insertUI的动态数据过滤器 [英] Shiny - dynamic data filters using insertUI

问题描述

我不熟悉Shiny，并且正在尝试编写一个应用程序，以便用户可以动态添加数据过滤器(请参见下面的代码). 我认为insertUI和remove UI对此非常酷. 但是，我有几个问题:

I am new to shiny and was trying to write an app where the user can dynamically add data filters (see code below). I thought insertUI and remove UI are pretty cool for that purpose. However, I have several problems:

    1) I cannot address dynamically generates input$ids (see filterId in the code, l. 36 and l. 58)
    2) in updateCheckboxGroupInput (l. 62) checkboxes are not preselected.
    3) I cannot select data rows using which() (l. 74)
    4) The checkboxes are not displayed inside the column, but spread over the whole page.

我非常感谢任何提示.

谢谢，乔迪

此处是代码:

library(shiny)

rowvalues <- function(col,data) {
  as.list(unique(data[col]))
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(
        column(6, actionButton('addFilter', 'Add filter')),
        column(6, actionButton('removeFilter', 'Remove 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)

  observeEvent(input$addFilter, {
    add <- input$addFilter
    filterId <- paste0('Filter', add)
    headers <- names(mtcars)
    insertUI(
      selector = '#placeholderFilter',
      ui = tags$div(
        # selectInput(filterId, label = paste0("Filter ",add), # does not work
        selectInput("ColFilter", label = paste0("Filter ",add), 
                    choices = as.list(headers), 
                    selected = 1),
        checkboxGroupInput("RowFilter", label = "Select variable values",
                           choices = NULL, selected = NULL, 
                           inline = TRUE, width = 4000),
        id = filterId
      )
    )

    filter <<- c(filter,filterId)
  })

  observeEvent(input$removeFilter, {
    removeUI(
      ## pass in appropriate div id
      selector = paste0('#', filter[length(filter)])
    )
    filter <<- filter[-length(filter)]
  })

  # observeEvent(input$filterId, { # does ntót work
  observeEvent(input$ColFilter, {
    col <- input$ColFilter
    values <- as.list(unique(mtcars[col]))[[1]]
    updateCheckboxGroupInput(session,"RowFilter", label = "Select variable    values", 
                              choices = values, selected = values, 
                              inline = TRUE)
  })

  output$data <- renderTable({
    col <- input$ColFilter
    rows <- input$RowFilter
    print(c("selected col: ",col))
    print(c("selected rows: ",as.vector(rows)))
    if(is.null(col)) mtcars
    else {
      mtcars[which(mtcars$col != rows),]
    }
  })
 }

shinyApp(ui = ui, server = server)

推荐答案

请参见下面的代码以获取我的建议.我基本上做了您希望/尝试做的事情，即动态添加观察者，以便每个新的过滤器元素都有自己的观察者.事实证明:您可以做到.就这样因此，我在呈现ui元素的确切observerEvent中添加了观察者，以使他们具有所需的反应性.我什至还添加了个人"删除按钮，这比仅删除最底部的按钮更为方便.同样，处理所有这些过滤器的逻辑将是一个聚合列表，该列表存储了当前在各种过滤器中选择的所有信息.这使renderTable部分更加容易.

Please see the code below for my suggestions. I basically did what you were hoping/trying to do, namely to add observers dynamically such that each new filter element has its own observer. It turns out: you can just do it. Just like that. So I added observers inside the exact observeEvent where the ui elements are rendered, to give them the reactivity they need. I even added "personal" remove buttons, which will be more convenient than just removing the bottommost one. Also, the logic to handle all those filters will be an aggregated list that stores all the information currently selected in the various filters. This makes the renderTable part much easier.

使自己熟悉该代码，如果有任何不确定性，请询问.

Make yourself familiar with the code and please ask, if there are any uncertainties.

最好的问候

library(shiny)

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(mtcars)
    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),
        checkboxGroupInput(rowfilterId, label = "Select variable values",
                           choices = NULL, selected = NULL, width = 4000)
      )
    )

    observeEvent(input[[colfilterId]], {

      col <- input[[colfilterId]]
      values <- as.list(unique(mtcars[col]))[[1]]

      updateCheckboxGroupInput(session, rowfilterId , label = "Select variable    values", 
                              choices = values, selected = values, inline = TRUE)

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

    observeEvent(input[[rowfilterId]], {

      rows <- input[[rowfilterId]]

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

    })

    observeEvent(input[[removeFilterId]], {
      removeUI(selector = paste0('#', filterId))

      aggregFilterObserver[[filterId]] <<- NULL

    })
  })

  output$data <- renderTable({

    dataSet <- mtcars

    invisible(lapply(aggregFilterObserver, function(filter){

      dataSet <<- dataSet[which(!(dataSet[[filter$col]] %in% filter$rows)), ]

    }))

    dataSet
  })
 }

shinyApp(ui = ui, server = server)

这篇关于闪亮-使用insertUI的动态数据过滤器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！