R语言 如何在渲染前使Shiny模态中的数据一致更新

92dk7w1h  于 2023-04-09  发布在  其他
关注(0)|答案(1)|浏览(160)

我试图使我的R Shiny应用程序中的数据模式(output$selected_tableoutput$selected_details)在渲染之前总是刷新。
我在下面的应用程序中的尝试有时会起作用,但通常不会,特别是当我在模式(output$selected_table)中选择左侧表中的不同行,然后关闭它并重新打开它,选择不同的output$summary_table行。
请注意,第一个模态(versicolor)的图在我关闭后短暂可见,然后在另一行(virginica)重新打开它(演示来自here)。
我怎样才能强制它在重新呈现模型之前总是更新数据呢?

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)
w80xi6nr

w80xi6nr1#

这是一种利用我前面的答案的方法。
下面的代码阻止了uiOutput的显示,直到模态被(重新)呈现:

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

正如在评论中提到的,我仍然认为这个概念过于复杂,可以简化。然而,当然,我不能告诉哪些部分是需要在“真实的世界的应用程序”。

相关问题