Shiny - динамические фильтры данных с использованием insertUI

Я новичок в глянце и пытался написать приложение, где пользователь может динамически добавлять фильтры данных (см. Код ниже). Я думал, что insertUI и удаление пользовательского интерфейса довольно круто для этой цели. Однако у меня есть несколько проблем:

    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)
 Jordi09 июн. 2016 г., 14:42
Да, спасибо, но добавление и удаление элементов пользовательского интерфейса работает нормально, используя insertUI и removeUI. Проблема скорее в том, чтобы адресовать и обновлять эти динамически добавленные элементы.
 K. Rohde08 июн. 2016 г., 12:52
Вы проверилиэтот вопрос и ответ? Проблема довольно похожа.

Ответы на вопрос(1)

Пожалуйста, смотрите код ниже для моих предложений. Я в основном сделал то, что вы надеялись / пытались сделать, а именно динамически добавлять наблюдателей так, чтобы у каждого нового элемента фильтра был свой наблюдатель. Оказывается: ты можешь просто сделать это. Просто так. Поэтому я добавил наблюдателей в точное поле наблюдения, где отображаются элементы пользовательского интерфейса, чтобы дать им необходимую реактивность. Я даже добавил «личные» кнопки удаления, которые будут удобнее, чем просто удаление самой нижней кнопки. Кроме того, логикой для обработки всех этих фильтров будет агрегированный список, в котором хранится вся информация, выбранная в настоящий момент в различных фильтрах. Это делает часть renderTable намного проще.

Ознакомьтесь с кодом и, пожалуйста, спросите, есть ли какие-либо сомнения.

С уважением

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)
 Jordi13 июн. 2016 г., 16:26
Привет, потрясающе! Большое спасибо! Я все еще работаю над вашим кодом, но это именно то, что я искал. Мне еще предстоит многому научиться, но ваш код прекрасно иллюстрирует пару важных понятий, которые я раньше не видел таким образом.
 Jordi16 июн. 2016 г., 15:26
Правильно, как.характер работает. Спасибо!
 Jordi16 июн. 2016 г., 15:21
Есть еще одна странность: когда я добавляю фильтр и выбираю, например, цил в качестве фильтра столбца. Затем я выбираю «8». Правильно, отображаются только строки с cyl! = 8. Однако, когда я снова снимаю отметку «8», вся таблица должна отображаться снова, но она просто остается прежней.
 Jordi14 июн. 2016 г., 16:15
Одна вещь, которую я до сих пор не понимаю. Не следует ли изначально выбирать все варианты updateCheckboxGroupInput? Когда я запускаю приложение, их нет.
 K. Rohde15 июн. 2016 г., 09:59
@ Джорди О, ты прав, я даже не заметил. Но я попробовал вокруг, и это потому, чтоcheckBoxGroupInput принимает свой выборкак персонаж, Установитьselected = 21 будет просто проигнорировано. Ноselected = "21" работает. Так что просто используйтеselected = as.character(values) и это будет работать.

Ваш ответ на вопрос