假设我在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 ...
我的问题如下:
FALSE
和TRUE
之间)进行怪异的切换,我还能如何实现代码块C的触发?此应用将在'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)