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

问题描述 投票:3回答:1

假设我在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. 如何使代码块C运行仅一次,何时代码块A和B都运行[[完成?
  2. 如果不依赖我当前依赖的无功值(在FALSETRUE之间)进行怪异的切换,我还能如何实现代码块C的触发?
r shiny shinydashboard shiny-reactivity
1个回答
2
投票
我之前通过对由'code-block-a'或'code-block-b'生成的反应对象或反应值进行eventObserving或eventReacting来完成此操作。我附带了3个闪亮的小型应用程序示例,以使用不同的方法深入了解此方法(希望这些方法有助于回答最初的问题-或至少提供一些想法)。

此应用将在'code-block-a'中创建一个表,其中的行数与sliderInput选择的行数相同。一旦此“ event_a()”反应式更新为“代码块-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)

© www.soinside.com 2019 - 2024. All rights reserved.