Suppose I have the following blocks of codes in 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
}
})
As you can see, I'm toggling the reactive values in Blocks A and B from FALSE to TRUE to trigger Block C to run.
I want to write the code so that the cycle can repeat itself:
Some trigger -> Block A & B -> C ->
Some trigger -> Block A & B -> C ...
My questions are the following:
FALSE and TRUE) that I am currently relying on?I have accomplished this before by eventObserving or eventReacting to the reactive objects or reactiveValues generated by 'code-block-a' or 'code-block-b'. I have attached 3 small shiny app examples to give insight into this approach using different methods (hopefully these will help answer the original question - or at least give some ideas).
This app will create a table in 'code-block-a' with as many rows as the sliderInput has selected. Once this 'event_a()' reactive is updated 'code-block-b' subsets one row. Once 'code-block-b' updates its object 'event_b()' a modal is displayed showing the selected row in a table.
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)
Or if all your 'code-block' are observers you can use reactive values that are updated inside of an observer. I have found this flexible if multiple things need to happen to trigger something downstream:
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)
Furthermore, if you are wanting something that iterates like a loop here is an example that describes the above process, but plots each row of data in a modal one row at a time and asking for user input each time:
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)