1

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). here

How can I force it to always update the data before it re-renders the modal?

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

iris_data = iris
iris_summary <- iris_data %>% 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_data, iris_summary)
}

shinyApp(ui, server)
tauft
  • 546
  • 4
  • 13
  • How does the undesired behaviour manifest (what am I looking for)? I am not sure i can reproduce it. – ismirsehregal Mar 31 '23 at 07:11
  • Hi @ismirsehregal thanks for looking at it - I added a published version of the reprex on shinyapps.io along with a video demonstrating the problem. – tauft Mar 31 '23 at 08:44
  • Hi there, unfortunately the video is private and can't be viewed. You might want to check https://www.screentogif.com/ and add the gif directly to your above question. – ismirsehregal Mar 31 '23 at 09:07
  • Oh, sorry about that, I thought I had made it public. Thanks for the software tip, I have added a gif now that demonstrates the issue. – tauft Mar 31 '23 at 09:19
  • Interesting - when I'm accessing your app on shinyapps.io or running it on my machine this issue isn't present (on Chrome). Which browser was used? – ismirsehregal Mar 31 '23 at 09:23
  • My demo from shinyapps.io was on Chrome. When I was loading the app on my local Windows machine the issue didn’t appear to be occurring, but it was when running locally on Linux. – tauft Mar 31 '23 at 09:39
  • 1
    I'd try to simplify the app (are these nested modules really needed?) and use a `conditionalPanel` (UI solution) instead of the slower `renderUI` (detour to the server) approach to switch between the plot and the table output. – ismirsehregal Apr 05 '23 at 08:47

1 Answers1

1

This is an approach utilizing my earlier answer here.

The following is blocking the display of your uiOutput until the modal has been (re)rendered:

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

iris_data = iris
iris_summary <- iris_data %>% 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"))),
      conditionalPanel("input.modal_visible == true", uiOutput(ns("selected_details")), style = "display: none;")
    )
  )
}

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$script(HTML(
    "$(document).on('shown.bs.modal','#shiny-modal', function () {
       Shiny.setInputValue(id = 'modal_visible', value = true);
      });
     $(document).on('hidden.bs.modal','#shiny-modal', function () {
       Shiny.setInputValue(id = 'modal_visible', value = false);
     });"
  )),
  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_data, iris_summary)
}

print(shinyApp(ui, server))

As mentioned in the comments, still I think the concept is overly complex and can be simplified. However, of course, I can't tell which parts are needed in the "real world app".

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78