时间戳

首页 > 解决方案 > 如何等待两个代码块在 R Shiny 中运行

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

问题描述

假设我在 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
  }
})

如您所见，我将块 A 和 B 中的反应值切换FALSE为TRUE触发块 C 运行。

我想编写代码，以便循环可以重复：

一些触发器 -> 阻止 A 和 B -> C ->

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

我的问题如下：

  1. 当代码块 A 和 B 都完成运行时，如何使代码块 C只运行一次？
  2. 如果不奇怪地切换我目前依赖的反应值（在FALSE和之间），我还能如何实现触发代码块 C ？TRUE

标签： rshinyshinydashboardshiny-reactivity

解决方案

我之前已经通过 eventObserving 或 eventReacting 对“code-block-a”或“code-block-b”生成的反应对象或反应值来完成此操作。我附上了 3 个闪亮的小应用程序示例，以使用不同的方法深入了解这种方法（希望这些将有助于回答最初的问题 - 或者至少给出一些想法）。

这个应用程序将在“code-block-a”中创建一个表格，其中包含与 sliderInput 选择的行数一样多的行。一旦这个 'event_a()' 反应被更新，'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)

或者，如果您所有的“代码块”都是观察者，您可以使用在观察者内部更新的反应值。如果需要发生多件事来触发下游的某些事情，我发现这很灵活：

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)

推荐阅读