在我闪亮的应用程序中,我有一个使用 renderUI 的动态输入。
这工作得很好,程序的另一部分捕获滑块的输入。
当应用程序状态发生变化时(例如,当按下“更新模型”按钮时),我仍然需要显示/使用具有类似标签的滑块,但由于它们是“新的”,因此需要将值重新初始化为零。
问题是滑块有记忆。如果我重复使用相同的 inputId
paste0(Labv[i], "_v",buttn)
闪亮的将具有与其关联的旧值。
目前我的代码正在使用变量buttn
绕过这个问题:每次状态改变时我都会创建“新”滑块。
另一方面,用户使用该应用程序的次数越多,就会有越多的垃圾被收集到shiny中。
我尝试使用 renderUI 将元素列表发送为 NULL,尝试发送元素列表
updateTextInput(session, paste0(lbs[i],"_v",buttn),
label = NULL, value = NULL )
or tags$div("foo", NULL)
但在每种情况下,实际变量都呈现为文本,这是最糟糕的!
# 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
})
}
)
在实际的应用程序中,checkboxGroupInput 也是通过 renderUI 从服务器驱动的,并在按下“更新模型”时重置。另外,UI 中还有更多“事件”我没有添加到代码中。
任何想法?