R 使用从一个闪亮模块到另一个闪亮模块的数据

我试图使用一个闪亮模块中的值，并将其传递给第二个闪亮模块以打印它。因此，当用户从第一个下拉列表中选择“橙色”时，它会显示“打印”

，您已经选择了“橙色”

。但是到现在为止，它打印的是您选择的ATC，它只不过是我要经过的id。下面是我正在使用的代码。谢谢

library(shiny)
library(shinydashboard)
library(shinyWidgets)

dropDownUI <- function(id, div_width = "col-xs-12 col-md-8") {

  ns <- NS(id)

  div(column(3, uiOutput(ns("class_level"))),
      column(3,uiOutput(ns("selected_product_ui"))
      ))
}

chartTableBoxUI <- function(id, div_width = "col-xs-12 col-md-8") {
  ns <- NS(id)

  div(tabBox(width = 12, title = id,
             tabPanel(icon("bar-chart"),
                      textOutput(ns("selected_var")))
   )
  )
}

chartTableBox <- function(input, output, session, data,ImProxy) {

  output$selected_var <- renderText({
    ns <- session$ns
    paste("You have selected",ns(ImProxy$selected_class))
  })
}

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

  ns <- session$ns

  observe({output$class_level <- renderUI({
    selectInput(
      ns("selected_class"),
      label = h4("Classification Level"),
      choices = list(
        "apple " = "apple",
        "orange " = "orange"),
      selected = "orange"
    )})
  })

  a<-reactive({input$selected_class})

  output$selected_product_ui <- renderUI({
    req(input$selected_class)
    Sys.sleep(0.2)
    ns <- session$ns

    if (input$selected_class == "apple") {
      my_choices <- c("foo","zoo","boo")
    } else if (input$selected_class == "orange") {
      my_choices <- c("22","33","44")
    } else {
      my_choices <- c("aa","bb","cc")
    }

    selectInput(inputId = ns("selected_product"),
                label = h4("Product Family"),
                choices = my_choices)
  })

}

sidebar <- dashboardSidebar(sidebarMenu(
  menuItem("aaa",tabName = "aaa"),
  menuItem("bbb", tabName = "bbb"),
  menuItem("ccc", tabName = "ccc")
))

body <-   ## Body content
  dashboardBody(tabItems(
    tabItem(tabName = "aaa",
            fluidRow(dropDownUI(id = "dropdown"),
                     fluidRow(chartTableBoxUI(id = "ATC"))
            )
    )))
# Put them together into a dashboardPage
ui <-   dashboardPage(
  dashboardHeader(title = "Loyalty Monthly Scorecard"),
  sidebar,
  body
)

server = {
  shinyServer(function(input, output, session) {
    callModule(dropDown, id = "dropdown")
    callModule(chartTableBox, id = "ATC", data = MyData)

  })
}

shinyApp(ui = ui, server = server)

库（闪亮）
图书馆（shinydashboard）
图书馆（shinyWidgets）
dropDownUI您的代码有两个问题：


ImProxy
是一个用户定义的变量。您没有定义它，也没有将它作为参数传递
您正在使用
id
作为选项卡框的标题

下面对这两个问题进行了更正

library(shiny)
library(shinydashboard)
library(shinyWidgets)

dropDownUI <- function(id, div_width = "col-xs-12 col-md-8") {

  ns <- NS(id)

  div(column(3,uiOutput(ns("class_level"))),
      column(3,uiOutput(ns("selected_product_ui"))
      ))
}

chartTableBoxUI <- function(id, div_width = "col-xs-12 col-md-8") {
  ns <- NS(id)

  div(tabBox(width = 12, title = textOutput(ns("title_var")), ## fixing issue 2
             tabPanel(icon("bar-chart"),
                      textOutput(ns("selected_var")))
  )
  )
}

chartTableBox <- function(input, output, session, data,a) { ## fixing issue 1

  output$selected_var <- renderText({
    paste("You have selected",a())
  })

  output$title_var <- renderText({ a() }) ## fixing issue 2


}

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

  ns <- session$ns

  observe({output$class_level <- renderUI({
    selectInput(
      ns("selected_class"),
      label = h4("Classification Level"),
      choices = list(
        "apple " = "apple",
        "orange " = "orange"),
      selected = "orange"
    )})
  })

  a<-reactive({input$selected_class})

  output$selected_product_ui <- renderUI({
    req(input$selected_class)
    Sys.sleep(0.2)
    ns <- session$ns

    if (input$selected_class == "apple") {
      my_choices <- c("foo","zoo","boo")
    } else if (input$selected_class == "orange") {
      my_choices <- c("22","33","44")
    } else {
      my_choices <- c("aa","bb","cc")
    }

    selectInput(inputId = ns("selected_product"),
                label = h4("Product Family"),
                choices = my_choices)
  })

  return(a) ## fixing issue 1
}

# Put them together into a dashboardPage
ui =   dashboardPage(
  dashboardHeader(title = "Loyalty Monthly Scorecard"),
  dashboardSidebar(sidebarMenu(
    menuItem("aaa",tabName = "aaa")
  )),
  dashboardBody(tabItems(
    tabItem(tabName = "aaa",
            fluidRow(dropDownUI(id = "dropdown"),
                     chartTableBoxUI(id = "ATC") # this text
            )
    )))
)

server = {
  shinyServer(function(input, output, session) {
    a = callModule(dropDown, id = "dropdown")
    callModule(chartTableBox, id = "ATC", data = MyData, a = a)

  })
}

shinyApp(ui = ui, server = server)

库（闪亮）
图书馆（shinydashboard）
图书馆（shinyWidgets）
dropDownUI可能与@GregordeCillia重复我确实修改了我的问题。