3

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.

I highly appreciate any hints.

Thanks, Jordi

here the code:

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)
2
  • Did you check out this question and answer? The problem is quite similar.
    – K. Rohde
    Jun 8, 2016 at 10:52
  • Yes, thanks, but adding and deleting ui elements works fine using insertUI and removeUI. The problem is rather addressing and updating those dynamically added elements.
    – Jordi
    Jun 9, 2016 at 12:42

1 Answer 1

5

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.

Best Regards

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)
4
  • Hi, terrific! Thanks a lot! I am still working through your code, but that's exactly what I was looking for. There is still a lot to learn for me, but your code nicely exemplifies a couple of important concepts that I did not see in this way before.
    – Jordi
    Jun 13, 2016 at 14:26
  • One thing I still don't get. Shouldn't be the all choices of updateCheckboxGroupInput be selected initially? When I run the app, they are not.
    – Jordi
    Jun 14, 2016 at 14:15
  • @Jordi Oh, you are right, I didn't even notice. But I tried around and it's because checkBoxGroupInput takes its choices as character. To set selected = 21 will be just ignored. But selected = "21" works. So just use selected = as.character(values) and it will work.
    – K. Rohde
    Jun 15, 2016 at 7:59
  • There is also another oddity: When I add a filter and choose for example cyl as the column filter. Then I select "8". Correctly, only lines with cyl !=8 are displayed. However, when I uncheck "8" again, the whole table should be displayed again, but it just stays it was.
    – Jordi
    Jun 16, 2016 at 13:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.