In my brilliant application, I have dynamic input using renderUI.
This works very well, and the other part of the program captures the input of the sliders.
When the application changes its status (for example, when the "Update Model" button is pressed), I still need to display / use sliders with similar labels, but since they are "new", the value needs to be reinitialized to zero.
The problem is that sliders have memory. If I reuse the same inputId
paste0(Labv[i], "_v",buttn)
shiny will have the old meaning associated with it.
Currently, my code uses the buttn variable to work around the problem: every time I change the state, I create "new" sliders.
On the other hand, the more users will use the application, the more garbage will be collected in brilliant.
I tried using renderUI to send a list of items to NULL, experimenting with sending a list
updateTextInput(session, paste0(lbs[i],"_v",buttn), label = NULL, value = NULL )
or tags$div("foo", NULL) , but in each case the actual variable was displayed as text, which is worse!
# Added simplified example library(shiny) library(data.table) # dt_ = data.table( Month = month.abb[1:5], A=rnorm(5, mean = 5, sd = 4), B=rnorm(5, mean = 5, sd = 4), C=rnorm(5, mean = 5, sd = 4), D=rnorm(5, mean = 5, sd = 4), E=rnorm(5, mean = 5, sd = 4)) dt_[,id :=.I] dt <- copy(dt_) setkey(dt_, "Month") setkey(dt, "Month") shinyApp( ui = fluidPage( fluidRow( column(4, actionButton("saveButton", "Update Model"))), fluidRow( column(6, dataTableOutput('DT')), column(3, br(),br(),checkboxGroupInput("pick",h6("Picker"), month.abb[1:5])), column(3, uiOutput('foo'))), fluidRow( column(4, verbatimTextOutput('vals'))) ), server = function(session,input, output) { valPpu <- reactiveValues() valPpu$buttonF <- 1 valPpu$dt_ <- dt_ ## output$DT <- renderDataTable({ if(length(input$pick) > 0 ) { # browser() isolate( { labs <- input$pick } ) # buttn <- valPpu$buttonF iter <- length(labs) valLabs <- sapply(1:iter, function(i) { as.numeric(input[[paste0(labs[i],"_v",buttn)]]) }) if( iter == sum(sapply(valLabs,length)) ) { cPerc <- valLabs cPerc <- as.data.table(cPerc) cPercDt <- cbind(Month=labs,cPerc) ival <- which(dt[["Month"]] %in% cPercDt[["Month"]]) setkey(cPercDt, "Month") for(j in LETTERS[1:5]) set(dt_, i=ival, j=j, dt[cPercDt][[j]] * (1 + dt_[cPercDt][["cPerc"]]) ) valPpu$dt_ <- dt_ } } dt_[order(id),] }, options = list( scrollX = TRUE, scrollY = "250px" , scrollCollapse = TRUE, paging = FALSE, searching = FALSE, ordering = FALSE ) ) ## output$foo <- renderUI({ if(is.null(input$saveButton)) { return() } if(length(input$pick) > 0 ) { labs <- input$pick iter <- length(labs) buttn <- isolate(valPpu$buttonF ) valLabs <- sapply(1:iter, function(i) { if(is.null(input[[paste0(labs[i],"_v",buttn)]] )) { 0 } else { as.numeric(input[[paste0(labs[i],"_v",buttn)]]) } }) # toRender <- lapply(1:iter, function(i) { sliderInput(inputId = paste0(labs[i], "_v",buttn), label = h6(paste0(labs[i],"")), min = -1, max = 1, step = 0.01, value = valLabs[i], # format = "##0.#%", ticks = FALSE, animate = FALSE) }) toRender } }) observe({ if(is.null(input$saveButton)) { return() } if(input$saveButton < valPpu$buttonF) { return() } valPpu$buttonF <- valPpu$buttonF + 1 dt <<- valPpu$dt_ # TODO: add proper saving code }) } )
In a real application, checkboxGroupInput is also controlled from the server using renderUI and reset when the "Update Model" button is clicked. In addition, the user interface has more “events” that I have not yet added to the code.
Any idea?