Как передать данные из одного модуля - PullRequest
Новая
       36

Как передать данные из одного модуля

1 голос
/ 15 марта 2019

Мне нужно предоставить доступ к нескольким кадрам данных в пределах блока наблюдения с другими блоками наблюдения. Причина в том, что данные создаются только после нажатия кнопки.

Я нашел следующие два вопроса очень изобретательными, но не совсем близкими к структуре моего приложения ...

Как вернуть переменную из модуля на сервер в приложении R Shiny?

Как получить доступ к фрейму данных из другого события наблюдения?

Я пытался обернуть кнопку наблюдать за событием внутри модуля, но тогда приложение не работает. Я не могу понять, как преобразовать мой код в модули, чтобы он работал.

Вот минимальный пример. 

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)

1 Ответ

1 голос
/ 16 марта 2019

Используя очень полезный комментарий выше, я получил этот код, который отлично работает! Огромное спасибо!!! (обратите внимание на использование реактивных значений) 

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