r - 一个闪亮的观察者事件可以等待它触发的另一个观察者吗? - r - Can a shiny observeEvent wait for another observer that it triggers? 小贝子编程网

这是一个可重现的例子：

library(shiny)
my_UI <- fluidPage(
fluidRow(column(3, numericInput("Count", "Count", 0)),
column(3, actionButton("example", "Example"))),
tags$div(id = 'entry')
)
my_server <- function(input, output, session) {
ch_Count <- reactive({input$Count})
max_Count <<- 0
observeEvent(ch_Count(), {
if (input$Count>max_Count) {
#Get list of entry to add
if (max_Count==0) {lstGen <- seq(input$Count)} else {lstGen <- seq(input$Count)[-seq(max_Count)]}
#Update max_Count
max_Count <<- input$Count
#Insert UI
lapply(lstGen, function(ID) {
insertUI(
selector = "#entry",
ui = conditionalPanel(paste0("input.Count >= ", ID),
wellPanel(fluidRow(column(2,numericInput(paste0("entry_", ID), paste0("Entry ", ID, ":"), 0))),
fluidRow(tags$div(id = paste0("pos_", ID))))
)
)
#2nd-layer reactive
assign(paste0("ch_Count_", ID), reactive({input[[paste0("entry_", ID)]]}), inherits = T)
assign(paste0("max_Count_", ID), 0, inherits = T)
observeEvent(get(paste0("ch_Count_", ID))(), {
MaxCount <<- get(paste0("max_Count_", ID))
NowCount <<- get(paste0("ch_Count_", ID))()
if (NowCount>MaxCount) {
#Get list of entry to add
if (MaxCount==0) {lstGen2 <- seq(NowCount)} else {lstGen2 <- seq(NowCount)[-seq(MaxCount)]}
#Update max_Count
assign(paste0("max_Count_", ID), NowCount, inherits = T)
#Insert UI
lapply(lstGen2, function(ID2) {
insertUI(
selector = paste0("#pos_", ID),
ui = column(2, textInput(paste0("entry_", ID, "_", ID2), label = NULL, value = 1))
)
})
}
})
})
}
})
observeEvent(input$example, {
updateTextInput(session, "Count", value = 4)
updateTextInput(session, "entry_4", value = 7)
updateTextInput(session, "entry_4_1", value = 7)
updateTextInput(session, "entry_4_2", value = 14)
updateTextInput(session, "entry_4_3", value = 21)
updateTextInput(session, "entry_4_4", value = 28)
updateTextInput(session, "entry_4_5", value = 35)
updateTextInput(session, "entry_4_6", value = 42)
updateTextInput(session, "entry_4_7", value = 49)
updateTextInput(session, "entry_1", value = 3)
updateTextInput(session, "entry_1_1", value = 3)
updateTextInput(session, "entry_1_2", value = 6)
updateTextInput(session, "entry_1_3", value = 9)
updateTextInput(session, "entry_2", value = 2)
updateTextInput(session, "entry_2_1", value = 2)
updateTextInput(session, "entry_2_2", value = 4)
updateTextInput(session, "entry_3", value = 6)
updateTextInput(session, "entry_3_1", value = 6)
updateTextInput(session, "entry_3_2", value = 12)
updateTextInput(session, "entry_3_3", value = 18)
updateTextInput(session, "entry_3_4", value = 24)
updateTextInput(session, "entry_3_5", value = 30)
updateTextInput(session, "entry_3_6", value = 36)
})
}
shinyApp(my_UI, my_server)

在此应用程序中，有一个嵌套的动态 UI，其中：

顶部的计数是为了控制要显示的面板数量
每个面板上的第一个条目是控制该面板中可用的输入数量。

为了方便用户理解，我还包含一个示例按钮，用于输入一些预设数据。但是，需要单击3次才能更新所有输入值。我想这是因为必须在触发另一个observeEvent之前完成一个，因此在上面的代码中，它会尝试更新尚存在的textInput框，导致一键更新失败。

然后，我尝试了如下解决方法：

my_UI <- fluidPage(
conditionalPanel("true", numericInput("dummy", NULL, 0)),
fluidRow(column(3, numericInput("Count", "Count", 0)),
column(3, actionButton("example", "Example"))),
tags$div(id = 'entry')
)
my_server <- function(input, output, session) {
ch_Count <- reactive({input$Count})
max_Count <<- 0
observeEvent(ch_Count(), {
if (input$Count>max_Count) {
#Get list of entry to add
if (max_Count==0) {lstGen <- seq(input$Count)} else {lstGen <- seq(input$Count)[-seq(max_Count)]}
#Update max_Count
max_Count <<- input$Count
#Insert UI
lapply(lstGen, function(ID) {
insertUI(
selector = "#entry",
ui = conditionalPanel(paste0("input.Count >= ", ID),
wellPanel(fluidRow(column(2,numericInput(paste0("entry_", ID), paste0("Entry ", ID, ":"), 0))),
fluidRow(tags$div(id = paste0("pos_", ID))))
)
)
#2nd-layer reactive
assign(paste0("ch_Count_", ID), reactive({input[[paste0("entry_", ID)]]}), inherits = T)
assign(paste0("max_Count_", ID), 0, inherits = T)
observeEvent(get(paste0("ch_Count_", ID))(), {
MaxCount <<- get(paste0("max_Count_", ID))
NowCount <<- get(paste0("ch_Count_", ID))()
if (NowCount>MaxCount) {
#Get list of entry to add
if (MaxCount==0) {lstGen2 <- seq(NowCount)} else {lstGen2 <- seq(NowCount)[-seq(MaxCount)]}
#Update max_Count
assign(paste0("max_Count_", ID), NowCount, inherits = T)
#Insert UI
lapply(lstGen2, function(ID2) {
insertUI(
selector = paste0("#pos_", ID),
ui = column(2, textInput(paste0("entry_", ID, "_", ID2), label = NULL, value = 1))
)
})
}
})
})
}
})

observeEvent(input$example, {
print("0>1 starts")
updateNumericInput(session, "Count", value = 4)
updateNumericInput(session, "dummy", value = 1)
print("0>1 ends")
})
ch_dummy <- reactive({input$dummy})
observeEvent(ch_dummy(), {
if (ch_dummy()==1) {
print("1>2 starts")
updateNumericInput(session, "entry_1", value = 3)
updateNumericInput(session, "entry_2", value = 2)
updateNumericInput(session, "entry_3", value = 6)
updateNumericInput(session, "entry_4", value = 7)
updateNumericInput(session, "dummy", value = 2)
print("1>2 ends")
} else if (ch_dummy()==2) {
print("2>0 starts")
updateTextInput(session, "entry_1_1", value = 3)
updateTextInput(session, "entry_1_2", value = 6)
updateTextInput(session, "entry_1_3", value = 9)
updateTextInput(session, "entry_2_1", value = 2)
updateTextInput(session, "entry_2_2", value = 4)
updateTextInput(session, "entry_3_1", value = 6)
updateTextInput(session, "entry_3_2", value = 12)
updateTextInput(session, "entry_3_3", value = 18)
updateTextInput(session, "entry_3_4", value = 24)
updateTextInput(session, "entry_3_5", value = 30)
updateTextInput(session, "entry_3_6", value = 36)
updateTextInput(session, "entry_4_1", value = 7)
updateTextInput(session, "entry_4_2", value = 14)
updateTextInput(session, "entry_4_3", value = 21)
updateTextInput(session, "entry_4_4", value = 28)
updateTextInput(session, "entry_4_5", value = 35)
updateTextInput(session, "entry_4_6", value = 42)
updateTextInput(session, "entry_4_7", value = 49)
updateNumericInput(session, "dummy", value = 0)
print("2>0 ends")
} else {}
})
}
shinyApp(my_UI, my_server)

我添加了一个虚拟对象，每次触发observeEvent时都会更新其值，并通过这样做触发下一个observeEvent，希望表单将在observeEvents之间更新。

它没有......缺少什么？

对此有什么建议吗？我不想通过预先创建所有必需的框来做到这一点。

谢谢！

下面的版本对我有用(替换上面的observeEvent(ch_dummy(), {})块)。相信我，我不知道为什么会这样。一般的想法是创建一个虚拟observeEvent的额外触发器

在调用insertUI(包括其numericInput组件)之后，以及

在调用相应updateNumericInput之前。

observeEvent(ch_dummy(), {
if (ch_dummy()==1) {
print("1>2 starts")
updateNumericInput(session, "dummy", value = 2)
print("1>2 ends")
} else if (ch_dummy()==2) {
print("2>3 starts")
updateNumericInput(session, "entry_1", value = 3)
updateNumericInput(session, "entry_2", value = 2)
updateNumericInput(session, "entry_3", value = 6)
updateNumericInput(session, "entry_4", value = 7)
updateNumericInput(session, "dummy", value = 3)
print("2>3 ends")
} else if (ch_dummy()==3) {
print("3>4 starts")
updateNumericInput(session, "dummy", value = 4)
print("3>4 starts")
} else if (ch_dummy()==4) {
print("4>0 starts")
updateTextInput(session, "entry_1_1", value = 3)
updateTextInput(session, "entry_1_2", value = 6)
updateTextInput(session, "entry_1_3", value = 9)
updateTextInput(session, "entry_2_1", value = 2)
updateTextInput(session, "entry_2_2", value = 4)
updateTextInput(session, "entry_3_1", value = 6)
updateTextInput(session, "entry_3_2", value = 12)
updateTextInput(session, "entry_3_3", value = 18)
updateTextInput(session, "entry_3_4", value = 24)
updateTextInput(session, "entry_3_5", value = 30)
updateTextInput(session, "entry_3_6", value = 36)
updateTextInput(session, "entry_4_1", value = 7)
updateTextInput(session, "entry_4_2", value = 14)
updateTextInput(session, "entry_4_3", value = 21)
updateTextInput(session, "entry_4_4", value = 28)
updateTextInput(session, "entry_4_5", value = 35)
updateTextInput(session, "entry_4_6", value = 42)
updateTextInput(session, "entry_4_7", value = 49)
updateNumericInput(session, "dummy", value = 0)
print("4>0 ends")
}
})

r - 一个闪亮的观察者事件可以等待它触发的另一个观察者吗?

相关内容

最新更新

热门标签：