Challenge while updating multiple inputs in shiny - r

Question

UpdateSliderInput not working...
Hi All,
Seems like a challenge updating sliderInput. So i wanted to develop an application in a way so that filter can be applied dynamically wherein one of the variables needs to be provided with a slider.
Any help can be really appriciable.
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'),
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),
# sliderInput(rowfilterId, label = "Select variable values",
# min = 1, max = 2, value = 1:4)
# )
ui = tags$div(column(9,id = filterId,
actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
selectInput(colfilterId, label = "Some Filter", choices = headers, selected = NULL),
conditionalPanel(condition = paste0("input.",colfilterId," != 'mpg'"),
checkboxGroupInput(rowfilterId, label = "Select variable values",
choices = NULL, selected = NULL, width = 4000)),
conditionalPanel(condition = paste0("input.",colfilterId," == 'mpg'"),
sliderInput(rowfilterId,
label = 'select values',
min = 1,#min(datafile$Age),
max = 10,#max(datafile$Age),
value = 1:5))#c(min(datafile$Age),max(datafile$Age))))
)
)
)
observeEvent(input[[colfilterId]], {
col <- input[[colfilterId]]
values <- as.list(unique(mtcars[col]))[[1]]
print(values)
print(paste0("example",as.list(unique(mtcars[col]))))
#
# updateCheckboxGroupInput(session, rowfilterId , label = "Select variable values",
# choices = values, selected = values, inline = TRUE)
#
updateSliderInput(session, rowfilterId , min = min(values), max = max(values), value = c(min(values),max(values)))
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)
Mpg values are not being updated, Is this due to conditionalPanel because of which the sliderInput is not being updated?

Answer 1

Everything seems to be perfect apart from the inputid you are using for 2 input types.
I just created one more variable for Sliderinput which will create dynamic input id.
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)
rowfilterId_num <- paste0('Row_Filter_num_', 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),
sliderInput(rowfilterId_num, label = "Select variable values",
min = 1, max = 2, value = 1:4)
)
)
observeEvent(input[[colfilterId]], {
print(rowfilterId)
print(paste0(input[[colfilterId]]))
col <- input[[colfilterId]]
values <- as.list(unique(mtcars[col]))[[1]]
print(values)
print(paste0("example",as.list(unique(mtcars[col]))))
updateCheckboxGroupInput(session, rowfilterId , label = "Select variable values",
choices = values, selected = values, inline = TRUE)
updateSliderInput(session, rowfilterId_num , label = "Select variable",min = min(values), max = max(values), value = c(min(values),max(values)))
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)
just check and let me know that this is what you wanted to achieve. let me know incase any thing else is required.