Я выполнял это раньше с помощью 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)
Кроме того, если вы хотите что-то, что повторяется как al oop, вот пример, который описывает вышеупомянутый процесс, но отображает каждую строку данных в модальной строке по одной за раз и каждый раз запрашивает ввод данных пользователем:
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)