[英]How to create dynamic number of observeEvent in shiny?
Here I have tried to replicate my original problem. 在这里,我试图复制我原来的问题。 The following shiny code will create 'Sub Segment' button if you click on 'Add a Segment'.
如果您单击“添加细分”,以下闪亮代码将创建“子细分”按钮。
Now 'Add a Sub Segment' button should give a single line text on each click. 现在,“添加子段”按钮应在每次单击时提供单行文本。 But what I have noticed, It creates (1 + number of 'Add a Segment' button after the clicked one) many lines.
但是我注意到,它创建了(1 +多个'点击后添加一个段'按钮)多行。
For single observeEvent it is working (the code is commented out). 对于单个observeEvent它正在工作(代码被注释掉)。
library(shiny)
ui <- fluidPage(
verbatimTextOutput("txt",placeholder = T), #"It is Created for Testing"
actionButton("addSeg", "Add a Segment"),
uiOutput("myUI")
)
server <- function(input, output, session) {
alld <- reactiveValues()
alld$ui <- list()
# Action to add new Segment
observeEvent(input$addSeg,{
alld$ui[[length(alld$ui)+1]] <- list(actionButton(paste0("addSub_",(length(alld$ui)+1)), "Add a Sub Segment"))
})
# Action to add new Sub Segment
# observeEvent(input[[paste0("addSub_",1)]],{
# alld$ui[[1]][[length(alld$ui[[1]])+1]] <- paste0("addSub_",1)
# })
observeEvent(input$addSeg,{
lapply(1:length(alld$ui), function(i){
observeEvent(input[[paste0("addSub_",i)]],{
alld$ui[[i]][[length(alld$ui[[i]])+1]] <- HTML(paste0("<br>addSub_",i,"<br>"))
})
})
})
output$myUI <- renderUI({alld$ui})
output$txt <- renderText(class(alld$ui))
}
shinyApp(ui, server)
Please Help... 请帮忙...
Very interesting question, and a very commendable reprex. 非常有趣的问题,以及一个非常值得称道的代表。 I managed to find a solution.
我设法找到了解决方案。 You can replace your server object with this:
您可以使用以下命令替换服务器对象:
server <- function(input, output, session) {
alld <- reactiveValues()
alld$ui <- list()
# Action to add new Segment
observeEvent(input$addSeg,{
new_id <- length(alld$ui) + 1
sub_name <- paste0("addSub_", new_id)
alld$ui[[new_id]] <- list(
actionButton(sub_name, "Add a Sub Segment")
)
observeEvent(input[[sub_name]], {
new_text_id <- length(alld$ui[[new_id]]) + 1
alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("<br>addSub<br>"))
})
})
output$myUI <- renderUI({alld$ui})
output$txt <- renderText({
capture.output(str(alld$ui))
})
}
Let's talk about your original code. 我们来谈谈您的原始代码。 Your first observer works just fine.
你的第一个观察者工作正常。 The second one, however, is causing the unwanted behaviour.
然而,第二个是导致不必要的行为。 It returns a list of new observers, one for every
addSub
button currently in the app. 它返回一个新观察者列表,一个用于当前在应用程序中的每个
addSub
按钮。 This means that on the first click, it creates an observer for addSub_1
, and on the second click, it returns an observer for addSub_1
and addSub_2
. 这意味着在第一次单击时,它会为
addSub_1
创建一个观察者,在第二次单击时,它将返回addSub_1
和addSub_2
的观察者。 However, the first addSub_1
observer still exists. 但是,第一个
addSub_1
观察者仍然存在。 This means that when you click addSub_1
, there are two observers responding and the text is shown twice. 这意味着当您单击
addSub_1
,有两个观察者响应并且文本显示两次。
My solution is to combine your two observers into one. 我的解决方案是将你的两个观察者合二为一。 When you click
addSeg
, the button is created in the UI-list, and the observer that handles it is also created. 单击
addSeg
,将在UI列表中创建该按钮,并且还会创建处理它的观察者。 This way, there are no duplicates and the app works as expected. 这样,没有重复项,应用程序按预期工作。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.