navbarPage 有两个数据集和相同的小部件集 - 双向依赖

Question

我尝试创建一个简单闪亮的应用程序。我们这里有两个 tabPanel 模块的应用程序，每个模块都引用不同的数据集。实际上，这两个数据集具有相同的结构（即列名、列内因子的名称），唯一的区别是列 value 和这些列中的实例数。我想为每个 tabPanel 创建相同的布局。我尝试将 Module 1 中的小部件依赖于 Module 2 中的小部件。例如，如果我在 Module 1 中选择产品 P2，然后将 tabPanel 更改为 Module 2，小部件会自动将值更改为 P2。主要目标是创建允许我以两种方式更改两个小部件的值的机制。例如，在我使用值 P2 转到 Module 2 然后我将其更改为 P3 并返回 Module 1 我想看到 P3 作为出色地。

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)

Answer 1

这是一个非常简单的例子。基本上，您使用 observeEvent 来确定 selectInput 何时更改，然后使用 updateSelectnput 来更新另一个 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)

navbarPage 有两个数据集和相同的小部件集 - 双向依赖

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

r

shiny

ggvis