Question

我需要与其他observeEvent块共享一个observeEvent块中的多个数据帧。原因是因为仅在按下按钮后才能构建数据。

我发现以下两个问题非常足智多谋，但与我的应用程序的结构不太吻合...

How to return a variable from a module to the server in an R Shiny app?

How to access dataframe from another observeEvent?

我尝试将按钮watchEvent包装在模块中，但是该应用程序无法正常工作。我不知道如何将代码更改为模块以使其正常工作。

这是一个最小的例子。

library(shiny)
library(shinydashboard)
library(DT)

header1 <- dashboardHeader(
  title = "My App"
)

sidebar1 <- dashboardSidebar(
  sidebarMenu(id = "sbmenu",
              menuItemOutput("menuitems01"),
              menuItemOutput("menuitems02")
  ) #sidebarMenu
) #dashboardSidebar

body1 <- dashboardBody(
  tabItems(
    uiOutput("tabitems01")
  ) #tabItems
) #dashboardBody

ui <- dashboardPage(header1, sidebar1, body1)

server <- function(input, output, session) {

  # render menu
  output$menuitems01 <- renderMenu({
    menuItem("Main", tabName = "main", icon = icon("key"))
  })

  # render tabitems
  output$tabitems01 <- renderUI({
    tabItem(tabName = "main",
            h2("Main"),
            actionButton(inputId = "btn1", label = "Button1")
    ) #tabItem
  }) #renderUI

  observeEvent(input$btn1, {
    dfresult02 <- data.frame(c(1, 2), c(3, 4)) # e.g. read some data from db
    dfresult05 <- data.frame(c(5, 6), c(7, 8)) # e.g. read some data from db
    rResult02 <- reactive({dfresult02}) # NEED TO MAKE THIS DATA AVAILABLE TO OTHER MODULE(S)
    rResult05 <- reactive({dfresult05}) # NEED TO MAKE THIS DATA AVAILABLE TO OTHER MODULE(S)
    output$menuitems02 <- renderMenu({
      menuItem("MyData", tabName = "mydata", icon = icon("th"))
    }) #renderMenu
    updateTabItems(session, "sbmenu", "mydata")
    print("button1 pressed")
  }) #observeEvent(input$btn1)

  observeEvent(input$sbmenu, {

    # IF I UNCOMMENT THE NEXT FOUR LINES, THE TABLES ARE DISPLAYED
    #dfresult02 <- data.frame(c(1, 2), c(3, 4))
    #rResult02 <- reactive({dfresult02})
    #dfresult05 <- data.frame(c(1, 2), c(3, 4))
    #rResult05 <- reactive({dfresult05})

    if(input$sbmenu == "mydata")
    {
      output$tabitems01 <- renderUI({
        tabItem(tabName = "mydata",
                h2("My Data"),
                DT::dataTableOutput('tbl02'),
                DT::dataTableOutput('tbl05')
        ) #tabItem
      }) #renderUI
      output$tbl02 <- DT::renderDataTable({rResult02()}) # NEED DATA FROM OTHER MODULE HERE
      output$tbl05 <- DT::renderDataTable({rResult05()}) # NEED DATA FROM OTHER MODULE HERE
    } #if(input$sbmenu == "mydata")

    if(input$sbmenu == "main")
    {
      output$tabitems01 <- renderUI({
        tabItem(tabName = "main",
                h2("Main"),
                actionButton(inputId = "btn1", label = "Button1")
        ) #tabItem
      }) #renderUI
    } #if(input$sbmenu == "main")

  }) #observeEvent(input$sbmenu)

} #server

shinyApp(ui = ui, server = server)

Answer 1

使用上面非常有用的注释，我最终获得了这段代码，效果很好！非常感谢！！！（注意使用reactValues）

library(shiny)
library(shinydashboard)
library(DT)

header1 <- dashboardHeader(
  title = "My App"
)

sidebar1 <- dashboardSidebar(
  sidebarMenu(id = "sbmenu",
              menuItemOutput("menuitems01"),
              menuItemOutput("menuitems02")
  ) #sidebarMenu
) #dashboardSidebar

body1 <- dashboardBody(
  tabItems(
    uiOutput("tabitems01")
  ) #tabItems
) #dashboardBody

ui <- dashboardPage(header1, sidebar1, body1)

server <- function(input, output, session) {

  # DECLARE REACTIVEVALUES FUNCTION HERE
  rResult <- reactiveValues(df02 = 0, df05 = 0)

  # render menu
  output$menuitems01 <- renderMenu({
    menuItem("Main", tabName = "main", icon = icon("key"))
  })

  # render tabitems
  output$tabitems01 <- renderUI({
    tabItem(tabName = "main",
            h2("Main"),
            actionButton(inputId = "btn1", label = "Button1")
    ) #tabItem
  }) #renderUI

  observeEvent(input$btn1, {
    dfresult02 <- data.frame(c(1, 2), c(3, 4)) # e.g. read some data from db
    dfresult05 <- data.frame(c(5, 6), c(7, 8)) # e.g. read some data from db
    rResult$df02 <- dfresult02 # MAKE THIS DATA AVAILABLE TO OTHER MODULE(S)
    rResult$df05 <- dfresult05 # MAKE THIS DATA AVAILABLE TO OTHER MODULE(S)
    output$menuitems02 <- renderMenu({
      menuItem("MyData", tabName = "mydata", icon = icon("th"))
    }) #renderMenu
    updateTabItems(session, "sbmenu", "mydata")
    print("button1 pressed")
  }) #observeEvent(input$btn1)

  observeEvent(input$sbmenu, {

    if(input$sbmenu == "mydata")
    {
      output$tabitems01 <- renderUI({
        tabItem(tabName = "mydata",
                h2("My Data"),
                DT::dataTableOutput('tbl02'),
                DT::dataTableOutput('tbl05')
        ) #tabItem
      }) #renderUI
      output$tbl02 <- DT::renderDataTable(rResult$df02) # GET DATA FROM OTHER MODULE(S) HERE
      output$tbl05 <- DT::renderDataTable(rResult$df05) # GET DATA FROM OTHER MODULE(S) HERE
    } #if(input$sbmenu == "mydata")

    if(input$sbmenu == "main")
    {
      output$tabitems01 <- renderUI({
        tabItem(tabName = "main",
                h2("Main"),
                actionButton(inputId = "btn1", label = "Button1")
        ) #tabItem
      }) #renderUI
    } #if(input$sbmenu == "main")

  }) #observeEvent(input$sbmenu)

} #server

shinyApp(ui = ui, server = server)

如何将数据帧从observeEvent模块共享到另一个模块

1 个答案: