navbarPage shiny with two datasets and identical set of widgets - both ways dependence

问题

I try to create a simple shiny app. What we have here is app with two tabPanel modules, each refers to different dataset. Actually both datasets have the same structure (i.e. name of column, name of factors within columns), only difference is column value and number of instances in those columns. I would like to create the same layout of each tabPanel. I try to depend widget in Module 1 on widget in Module 2. For example, if I choose product P2 in Module 1 and then change tabPanel into Module 2, widget automatically change value into P2. The main goal is to create mechanism which allow me to change the value of both widgets in both ways. For example, after I go to the Module 2 with value P2 and then I change it into P3 and come back to Module 1 I want to see P3 as well.

ui.R

library(ggvis)
library(shiny)

shinyUI(
        navbarPage(title = '',
                   tabPanel("Module 1",
                            fluidRow(
                                    selectInput('prod1','', prod),
                                    ggvisOutput('ggvis_plot1')
                            )
                   ),
                   tabPanel("Module 2",
                            fluidRow(
                                    uiOutput('in_prod2'),
                                    ggvisOutput('ggvis_plot2')
                            ))
        )
)

server.R

library(shiny)
library(ggvis)
library(dplyr)

shinyServer(function(input, output) {

        # renderUI part
        output$in_prod2 <- renderUI({
                selectInput('prod2','',
                            choices = prod, selected = input$prod1)
        })

        # Code for data module1
        data_mod1_0 <- reactive({
                df <- module1_df
                df <- df %>% 
                        filter(prod == input$prod1)
        })

        ggvis_plot1 <- reactive({

                plot <- data_mod1_0() %>% 
                        ggvis(~id, ~value) %>% 
                        layer_points(fill = ~part)
        })

        ggvis_plot1 %>% bind_shiny('ggvis_plot1')

        # Code for data module2
        data_mod2_0 <- reactive({
                if (is.null(input$prod2))
                        df <- module2_df
                else {
                        df <- module2_df
                        df <- df %>% 
                                filter(prod == input$prod2)        
                }

        })

        ggvis_plot2 <- reactive({

                plot1 <- data_mod2_0() %>% 
                        ggvis(~id, ~value) %>% 
                        layer_points(fill = ~part)
        })

        ggvis_plot2 %>% bind_shiny('ggvis_plot2')
})

global.R

library(dplyr)

prod <- c('P1','P2','P3')
level <- c('L1','L2','L3')
part <- c('p1','p2','p3','p4','p5')

axis_x <- list(L1 = list('Ordering' = 'id'),
               L2 = list('Ordering' = 'id', 'Part name' = 'part'),
               L3 = list('Ordering' = 'id', 'Part name' = 'part'))

# Data for module 1
set.seed(123)
module1_df <- data.frame(prod = sample(prod,300, replace = T), 
                        level = sample(level, 300, replace = T), 
                        part = sample(part, 300, replace = T),
                        value = rnorm(300))

module1_df <- module1_df %>% 
        group_by(prod) %>% 
        mutate(id = 1:n()) %>% 
        arrange(prod, id)

# Data for module 2
set.seed(321)
module2_df <- data.frame(prod = sample(prod,300, replace = T), 
                         level = sample(level, 300, replace = T), 
                         part = sample(part, 300, replace = T),
                         value = rnorm(300))

module2_df <- module2_df %>% 
        group_by(prod) %>% 
        mutate(id = 1:n()) %>% 
        arrange(prod, id)

回答1:

Here is a very simple example of this. Basically you use observeEvent to determine when a selectInput has changed, and then use updateSelectnput to update the other select.

library(shiny)

ui <-navbarPage(title = '',
                tabPanel("Module 1",
                         fluidRow(
                           selectInput('sel1','Select 1', choices=c("A","B","C")),
                           textOutput('select1')
                         )
                ),
                tabPanel("Module 2",
                         fluidRow(
                           selectInput('sel2','Select 2', choices=c("A","B","C")),
                           textOutput('select2')
                         ))
)


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

  output$select1<-renderText(input$sel1)
  output$select2<-renderText(input$sel2)
  observeEvent(input$sel1, updateSelectInput(session,input='sel2',selected=input$sel1))
  observeEvent(input$sel2, updateSelectInput(session,input='sel1',selected=input$sel2))
}


shinyApp(ui = ui, server = server)

来源：https://stackoverflow.com/questions/34652284/navbarpage-shiny-with-two-datasets-and-identical-set-of-widgets-both-ways-depe