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)
Jordi
  • 93
  • 1
  • 6
  • Did you check out [this question and answer](http://stackoverflow.com/questions/37504933/dynamically-add-and-remove-uioutput-elements-based-on-index-using-actionbuttons/37521979#37521979)? The problem is quite similar. – K. Rohde Jun 08 '16 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 09 '16 at 12:42

1 Answers1

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)
K. Rohde
  • 9,439
  • 1
  • 31
  • 51
  • 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 '16 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 '16 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 '16 at 07: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 '16 at 13:21