Shiny - Dynamische Datenfilter mit insertUI
Ich bin neu in Shiny und habe versucht, eine App zu schreiben, in der der Benutzer Datenfilter dynamisch hinzufügen kann (siehe Code unten). Ich fand InsertUI und Remove UI für diesen Zweck ziemlich cool. Ich habe jedoch mehrere Probleme:
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.
Ich freue mich über Hinweise.
Danke, Jordi
hier der 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)