How to make data in Shiny modal consistently update before rendering

How can I force my app to always update the data before re-rendering the modal?

I posted this on SO without success, so am trying my luck here - any help would be appreciated, even to point me in the right direction, e.g., am I structuring my app wrong?

I'm trying to make the data in my R Shiny app modal (output$selected_table and output$selected_details) always refresh before rendering.

My attempt in the app below sometimes works, but often doesn't, especially when I select different rows in the left-hand table in the modal (output$selected_table) before closing it and reopening it with a different row of output$summary_table selected.

Note that the plot from the first modal (versicolor) is briefly visible after I close and then re-open it on a different row (virginica) (the demo is from here).

shiny_reprex

library(shiny)
library(dplyr)
library(ggplot2)
library(reactable)

iris_summary <- iris %>% group_by(Species) %>% summarise_all(mean)

summary_ui <- function(id) {
  ns = NS(id)
  reactableOutput(ns("summary_table"))
}

details_ui <- function(id) {
  ns = NS(id)
  fluidPage(
    fluidRow(
      column(6, reactableOutput(ns("selected_table"))),
      uiOutput(ns("selected_details"))
    )
  )
}

details_server <- function(id, summary_data, full_data, selected_summary_row) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    selected_species <- reactive({
      req(selected_summary_row() > 0)
      summary_data[selected_summary_row(), ]$Species
    })
    
    selected_data <- reactive({
      req(selected_summary_row() > 0)
      full_data %>% filter(Species == selected_species()) 
    })
    
    output$selected_table <- renderReactable({
      outputOptions(output, "selected_table", suspendWhenHidden = FALSE)
      reactable(
        selected_data(), 
        selection = "single", 
        onClick = "select",
        defaultSelected = 1
      )
    })
    
    selected_details_row = reactive(getReactableState("selected_table", "selected"))
    
    toggle_plot = reactive({
      req(selected_details_row())
      if (selected_details_row() %% 2 == 0) TRUE else FALSE
    })
    
    selected_details_data = reactive({
      selected_data()[selected_details_row(), ]
    })
    
    output$selected_details_plot <- renderPlot({
      outputOptions(output, "selected_details_plot", suspendWhenHidden = FALSE)
      req(toggle_plot() == TRUE)
      selected_details_data() %>%
        ggplot(aes(x = Sepal.Length, y = Sepal.Width)) +
        geom_point()
    }, width = 500, height = 500)
    
    output$selected_details_table <- renderReactable({
      outputOptions(output, "selected_details_table", suspendWhenHidden = FALSE)
      req(toggle_plot() == FALSE)
      reactable(selected_details_data())
    })
    
    output$selected_details = renderUI({
      outputOptions(output, "selected_details", suspendWhenHidden = FALSE)
      if (toggle_plot() == TRUE) {
        column(6, plotOutput(ns("selected_details_plot")))
      } else {
        column(6, reactableOutput(ns("selected_details_table")))
      }
    })
  })
}

summary_server <- function(id, full_data, summary_data) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    output$summary_table <- renderReactable({
      reactable(
        summary_data, 
        selection = "single", 
        onClick = "select"
      )
    })
    
    selected_summary_row = reactive(getReactableState("summary_table", "selected"))
    
    observeEvent(selected_summary_row(), {
      showModal(modalDialog(
        details_ui(ns("details")),
        easyClose = TRUE
      ))
    })
    details_server("details", summary_data, full_data, selected_summary_row)
  })
}

ui <- fluidPage(
  tags$head(tags$style(".modal-dialog{ width: 60% }")),
  tags$head(tags$style(".modal-body{ min-height: 600px }")),
  titlePanel("Iris Dataset"),
  sidebarLayout(
    sidebarPanel(),
    mainPanel(
      summary_ui("summary")
    )
  )
)

server <- function(input, output, session) {
  summary_server("summary", iris, iris_summary)
}

shinyApp(ui, server)

Hmmm. I think you may want to use shinycssloaders

1 Like

By now I left a workaround here.

1 Like

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.