如何在R Shiny中等待两个代码块运行

Question

假设我在Shiny中有以下代码块：

library(shiny)

rv <- reactiveValues()

observe({
  # Event A
  # Code Block A
  # The code below signals the end of Code Block A
  rv$event_a <- F
  rv$event_a <- T
})

observe({
  # Event B
  # Code Block B
  # The code below signals the end of Code Block B
  rv$event_b <- F
  rv$event_b <- T
})

observe({
  rv$event_a
  rv$event_b
  if(rv$event_a & rv$event_b) {
    # Do something only after both Code Blocks A and B finish running.
    # Code Block C
  }
})

您可以看到，我正在从 FALSE 切换到 TRUE，以触发块 C 运行的响应值。

我希望编写代码，使得循环可以重复进行：

某些触发器 -> 块 A 和 B -> C ->

某些触发器 -> 块 A 和 B -> C ...

我的问题如下：

1. 我如何编写代码，使得代码块 C 仅在 A 和 B 代码块完成运行时运行一次？
2. 除了当前依赖于奇怪的响应值切换（在FALSE和TRUE之间）外，我还能通过什么方式来触发代码块 C？

- johnny

Answer 1

我以前通过对由'code-block-a'或'code-block-b'生成的reactive对象或reactiveValues进行事件观察或事件反应来完成此操作。我附加了3个小的shiny app示例，以使用不同的方法提供洞察力（希望这些会帮助回答原始问题 - 或者至少提供一些想法）。

该应用程序将在'code-block-a'中创建一个表格，其中行数等于sliderInput选择的行数。一旦更新了'event_a()' reactive，'code-block-b'就会对一个行进行子集处理。一旦'code-block-b'更新其对象'event_b()'，就会显示一个模态框，其中显示所选行的表格。

library(shiny)
library(tidyverse)


ui <- fluidPage(
  sliderInput("slide", "slide", value = 5, min = 1, max = 10),
  actionButton("go", "go"),
)

server <- function(input, output, session) {


  rv <- reactiveValues(tr1 = 0, el = 0)
  final <- reactiveValues()



  #CODE BLOCK A#
  #takes slider input and makes a table with that many rows
  event_a <- eventReactive(input$go,{
    nums <- seq(1, input$slide, by = 1)
    l <- 1:length(nums)

          tibble(Letter = letters[l],
                        Value = nums)

  })

  #trigger next series of events in response to event_a()
  #observeEvent(event_a(),{
  #  rv$el <- rv$el + 1
 # })

  ##CODE BLOCK B##
  # this will subset a row of data based on the value of the reactive
  event_b <- eventReactive(event_a(), {
    row <- sample(1:nrow(event_a()), 1)
    event_a()[row,]
  })

  #look for changes in event_b() to trigger event C
  #the loading of event_b will trigger the modal via rv$tr1
 # observeEvent(event_b(), {
 #   rv$tr1 <-  rv$tr1 + 1
 # })

  #side effect make a table from event_b() to be shown in modal
  output$modal_plot <- renderTable({
    event_b()
  })


  ##CODE BLOCK C##
  #launch modal showing table
  observeEvent(event_b(), {
    showModal(modalDialog(title = "Table",
                          "This is a table",
                          tableOutput("modal_plot"),
                                             inline = T))


  })




}

shinyApp(ui, server)

如果你的所有 'code-block' 都是观察者，那么你可以使用在观察器内更新的响应式值。如果需要多个操作来触发下游事件，我发现这很灵活：

library(shiny)
library(tidyverse)


ui <- fluidPage(
  sliderInput("slide", "slide", value = 5, min = 1, max = 10),
  actionButton("go", "go"),
)

server <- function(input, output, session) {


  rv <- reactiveValues(tr1 = 0, el = 0)
  final <- reactiveValues()



  #CODE BLOCK A#
  #takes slider input and makes a table with that many rows
  event_a <- eventReactive(input$go,{
    nums <- seq(1, input$slide, by = 1)
    l <- 1:length(nums)

          tibble(Letter = letters[l],
                        Value = nums)

  })

  #trigger next series of events in response to event_a()
  observeEvent(event_a(),{
    rv$el <- rv$el + 1
  })

  ##CODE BLOCK B##
  # this will subset a row of data based on the value of the reactive
  event_b <- eventReactive(rv$el, ignoreInit = T, {
    row <- sample(1:nrow(event_a()), 1)
    event_a()[row,]
  })

  #look for changes in event_b() to trigger event C
  #the loading of event_b will trigger the modal via rv$tr1
  observeEvent(event_b(), {
     rv$tr1 <-  rv$tr1 + 1
   })

  #side effect make a table from event_b() to be shown in modal
  output$modal_plot <- renderTable({
    event_b()
  })


  ##CODE BLOCK C##
  #launch modal showing table
  observeEvent(rv$tr1, ignoreInit = T, {
    showModal(modalDialog(title = "Table",
                          "This is a table",
                          tableOutput("modal_plot"),
                                             inline = T))


  })




}

shinyApp(ui, server)

此外，如果您需要像循环一样迭代执行某些操作，以下示例可以描述上述过程，但每次仅在模态框中绘制一行数据并要求用户输入：

library(shiny)
library(tidyverse)


ui <- fluidPage(
  sliderInput("slide", "slide", value = 5, min = 1, max = 10),
  actionButton("go", "go"),
  tableOutput("df"),
  tableOutput("user_choices_table")
)

server <- function(input, output, session) {


  rv <- reactiveValues(tr1 = 0, el = 0)
  final <- reactiveValues()


  #STEP 1
  #some function/series of events that gives us a some data
  data1 <- eventReactive(input$go,{
    c <- seq(1, input$slide, by = 1)
    l <- 1:length(c)
    out_table <- tibble(Letter = letters[l],
                        Value = c)
    return(out_table)
  })

  #side effect - return data1 to UI
  output$df <- renderTable({
    data1()
  })

  #number of max iterations we will go though (dependent number of rows in data1)
  num_iterations <- reactive({
    nrow(data1())
  })


  #trigger next series of events in response to data1()
  #this will get us from 0 to 1 and another observer will be used to add
  #all the way up to the max_iterations
  observeEvent(data1(),{
    rv$el <- rv$el + 1
  })
  #this ^ observer is like entering the loop on the first iteration

  ##STEP 2##
  ##start/continue the "disjointed-loop".
  #Subset data1 into smaller piece we want based on rv$el
  #this will be our 'i' equivalent in for(i in ...)
  #data subset
  data2 <- eventReactive(rv$el, ignoreInit = TRUE, {
    data2 <- data1()[rv$el,]
    return(data2)
  })

  #side effect make a plot based on data2 to be shown in modal
  output$modal_plot <- renderPlot({
    d <- data2()
    ggplot()+
      geom_col(data = d, aes(x = Letter, y = Value,  fill = Letter))+
      theme_linedraw()
  })


  #once we get our data2 subset ask the user via modal if this is what they want
  #the loading of data2 will trigger the modal via rv$tr1
  observeEvent(data2(), {
    rv$tr1 <-  rv$tr1 + 1
  })

##STEP 3##
  #launch modal showing plot and ask for user input
  observeEvent(rv$tr1, ignoreInit = TRUE, {
    showModal(modalDialog(title = "Make a Choice!",
                          "Is this a good selection?",
                          plotOutput("modal_plot"),
                          checkboxGroupInput("check", "Choose:",
                                            choices = c("Yes" = "yes",
                                                        "No" = "no"),
                                            inline = T),
                          footer = actionButton("modal_submit", "Submit")))

  })

  #when user closes modal the response is saveed to final[[character representing number of iteration]]
  observeEvent(input$modal_submit, {
    final[[as.character(rv$el)]] <- input$check
    if(rv$el < num_iterations()){
    rv$el <- rv$el + 1 #this retriggers step2 to go again
    } else {
      rv$done <- rv$done + 1
    } #breaks the disjointed loop and trigger start of next reactions
  })

  #and the modal is closed
  observeEvent(input$modal_submit, {
    removeModal()

  })

  final_choice <- eventReactive(rv$done, ignoreInit = TRUE,{
    enframe(isolate(reactiveValuesToList(final))) %>%
      mutate(name = as.numeric(name),
             value = unlist(value)) %>%
      arrange(name)

  })

  output$user_choices_table <- renderTable({
   final_choice()
  })




}

shinyApp(ui, server)

- bs93

---

谢谢您的回答！根据您的建议，我尝试使用了 eventReactive()，但最终我发现通过使用 debounce 可以解决我的问题。 - johnny