代码之家  ›  专栏  ›  技术社区  ›  AgnieszkaTomczyk

renderIUI在R中的闪亮模块中不工作

  •  2
  • AgnieszkaTomczyk  · 技术社区  · 7 年前

    我使用shinydashboard和gapminder的数据在Shiny中制作了一个简单的应用程序。基本版本正在运行,但我无法将其划分为模块。

    应用程序正在根据用户选择绘制直方图:

    • 列表中的大陆(数据中提供的所有大陆) 和
    • 国家(根据所选大陆过滤国家)

    代码和屏幕如下所示。 应用程序:

        library(gapminder)
        library(shiny)
        library(shinydashboard)
        library(dplyr)
    
        ui <- dashboardPage(
    
        skin = "yellow",
        dashboardHeader(
        title = "gapminder - data",
        titleWidth = 300
      ),
    
      dashboardSidebar(
        width = 300,
        sidebarMenu(
          id="menu",
    
          uiOutput("continent"),
          uiOutput("country")
    
        )
      ),
    
    
      dashboardBody(
    
        fluidRow(
          plotOutput("plot")
        ))
      )
    
    server <- function(input, output, session) {
    
      data <- reactive({
        all_data <- filter(gapminder, country != "Kuwait")
        all_data
      })
    
      output$continent <- renderUI({
    
        data <- data()
        selectInput("continent",
                    "CONTINENT:",
                    multiple = FALSE,
                    choices = sort(unique(data$continent)))
      })
    
    
      output$country <- renderUI({
    
        data <- data()
        ct <- input$continent
    
        data %>%
          filter(continent == ct) %>%
          .$country %>%
          unique() %>%
          as.character() -> names
    
        selectInput("country",
                    "COUNTRY:",
                    multiple = FALSE,
                    choices = names)
      })
    
    
      output$plot <- renderPlot({
    
        data <- data()
        ct <- input$continent
        co <- input$country
    
        data %>%
        filter(continent == ct,
               country == co) %>%
          .$lifeExp ->selected_data
    
    
      histogram <- hist(selected_data)
      histogram
    
    })
    
    }
    # Run the application 
    shinyApp(ui = ui, server = server)
    

    enter image description here

    我想用闪亮的模块重写它——将下拉字段放在单独的模块中。我收到了如下错误:

    enter image description here

    修改后的应用程序(带模块)的代码为:

    library(gapminder)
    library(shiny)
    library(shinydashboard)
    library(dplyr)
    
    source("global.R")
    
    ui <- dashboardPage(
    
      skin = "yellow",
    
      dashboardHeader(
        title = "gapminder - data",
        titleWidth = 300
      ),
    
      dashboardSidebar(
        width = 300,
    
        sidebarMenu(
          id="menu",
    
          gapModuleUI("all")
    
        ) ),
    
    
      dashboardBody(
    
        fluidRow(
          plotOutput("plot")
        )
      )
    )
    
    server <- function(input, output, session) {
    
      callModule(gapModule, "all")
    
      data <- reactive({
        all_data <- filter(gapminder, country != "Kuwait")
        all_data
      })
    
      output$plot <- renderPlot({
    
        data <- data()
        ct <- input$continent
        co <- input$country
    
        data %>%
          filter(continent == ct,
                 country == co) %>%
          .$lifeExp ->selected_data
    
    
        histogram <- hist(selected_data)
        histogram
    
      })
    
    }
    # Run the application 
    shinyApp(ui = ui, server = server)
    

    模块在全球范围内。R:

    gapModuleUI <- function(id) {
      ns <- NS(id)
    
      tagList(
    
        uiOutput(ns("continent")),
    
        uiOutput(ns("country"))
      )
    }
    
    gapModule <- function(input, output, session) {
    
      ns <- session$ns
    
      data <- reactive({
        all_data <- filter(gapminder, country != "Kuwait")
        all_data
      })
    
      output$continent <- renderUI({
    
        data <- data()
    
        selectInput(ns("continent"),
                    "CONTINENT:",
                    multiple = FALSE,
                    choices = sort(unique(data$continent)))
    
        })
    
    
      output$country <- renderUI({
    
        data <- data()
        ct <- reactive({input$continent})
    
        data %>%
          filter(continent == ct) %>%
          .$country %>%
          unique() %>%
          as.character() -> names
    
        selectInputns(ns("country"),
                    "COUNTRY:",
                    multiple = FALSE,
                    choices = names)
      })
    
    }
    

    我应该在模块中更改什么?

    1 回复  |  直到 7 年前
        1
  •  2
  •   Daniel Rodak    7 年前

    在模块的服务器部分,当您呈现UI时,还必须将ID封装在 ns 。从中获取 session 使用 ns <- session$ns 。然后:

      output$continent <- renderUI({
    
        data <- data()
    
        selectInput(ns("continent"),
                    "CONTINENT:",
                    multiple = FALSE,
                    choices = sort(unique(data$continent)))
    
        })
    

    与相同 output$country

    编辑: 所以有三件事:

    1. 在里面 global.R 改变 filter(continent == ct) %>% filter(continent == ct()) %>% ct 是反应功能。
    2. 在里面 全球的R 您还有一个输入错误:更改 selectInputns(ns("country"), selectInput(ns("country"),
    3. 在主文件中有一个重要的东西。您尝试使用来自此模块外部模块的输入: ct <- input$continent co <- input$country 。模块应该是自包含的,但有一种方法可以到达它们。 NS(id) 仅附加 "id-" 适用于所有对象,即: NS("MyId")("input") == "MyId-input" 。因此,如果要使用模块输入,可以通过以下几种方式进行:

      nsall <- NS("all")
      ct <- input[[nsall('continent')]]
      co <- input[[nsall('country')]]
      

      ct <- input$`all-continent`
      co <- input$`all-country`
      

      或者你也可以 gapModule 返回内容:

      return(reactive(c(ct = input$continent, co = input$country)))
      

      然后:

      params <- callModule(gapModule, "all")
      ct <- params()['ct']
      co <- params()['co']