嵌套模块中的闪亮按钮未显示;命名空间问题?

时间:2018-09-27 16:15:01

标签: r shiny shinydashboard shinyjs shiny-reactivity

我正在尝试使用shinymaterial程序包(https://ericrayanderson.github.io/shinymaterial/)将基本仪表板组装在一起,但是我的下拉菜单(通常是常规闪亮应用程序中的selectInput)没有出现一个小问题不会显示在嵌套的UI模块中。

此屏幕截图中“设置”按钮上方应有两个下拉菜单:enter image description here

这是到目前为止我的脚手架的代码段:

library(shiny)
library(shinymaterial)

# Wrap shinymaterial apps in material_page
ui <- material_page(
  title = "App Title",
  nav_bar_fixed = FALSE,
  nav_bar_color = "black",
  background_color = "white",
  # font_color = "black",

  # Place side-nav in the beginning of the UI
  material_side_nav(
    fixed = FALSE,
    # Place side-nav tabs within side-nav
    material_side_nav_tabs(
      side_nav_tabs = c(
        "Home" = "home",
        "About" = "about"
      ),
      icons = c("home", "help")
    ),
    background_color = "white"
  ),

  # Define side-nav tab content
  material_side_nav_tab_content(
    side_nav_tab_id = "home",

    material_row(
      material_column(
        material_card(title = NULL,
                      sidebarCharts("main"),
                      depth = NULL),
        width = 2,
        offset = 0
      ),
      material_column(
        material_card(title = NULL,
                      "Chart goes here",
                      depth = NULL),
        width = 10,
        offset = 0
      )
    )


  ),
  material_side_nav_tab_content(
    side_nav_tab_id = "about",
    tags$h1("About")
  )
)

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

  callModule(chartSettings, "main")

}

# Server modules
chartSettings <- function(input, output, session) {

  ## 'Home' tab -- Sidebar
  output$selectRootSymbol <- renderUI({
    .choices <- c('a','b','c')  
    tagList(
      helpText("Root Symbol:"),  # Note: helpText() looks a little cleaner versus using the 'label' parameter in selectInput() below
      # selectInput(session$ns("reactiveRootSymbol"), label = NULL, choices = .choices, selected = NULL, width = '100%')
      material_dropdown(session$ns("reactiveRootSymbol"), label = NULL, choices = .choices, selected = NULL, width = '100%')
    )
  })

  output$selectSymbol <- renderUI({
    req(input$reactiveRootSymbol)
    .choices <- c('d', 'e', 'f') 
    tagList(
      helpText("Symbol:"),
      # selectInput(session$ns("reactiveSymbol"), label = NULL, choices = toupper(.choices), selected = NULL, width = '100%')
      material_dropdown(session$ns("reactiveSymbol"), label = NULL, choices = toupper(.choices), selected = NULL, width = '100%')
    )
  })

}

sidebarCharts <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("selectRootSymbol")),
    uiOutput(ns("selectSymbol")),
    # actionButton(ns("settings"), "Settings", icon = icon("cogs"), width = '100%', class = "btn btn-primary"),p()
    material_button(ns("settings"), "Settings", icon = "settings")
  )
}

shinyApp(ui = ui, server = server)

我认为我有一个名称空间问题,但是我不确定(因为按钮确实显示在嵌套模块中)。我在做什么错了?

非常感谢您的帮助!

1 个答案:

答案 0 :(得分:1)

这里至少有两个问题。

1。 material_dropdown不显示(已解决)

这似乎是由于width = 100%中未使用的material_dropdown()选项引起的。删除此选项将显示某些下拉列表和所有标签。

2。连续的material_dropdown不显示(未解决)

具有两个连续的material_dropdown的结果仅显示第一个下拉列表,即使两个标签都显示。 material_dropdown软件包中存在shinymaterial的先前错误,因此这可能是相关问题的一部分。

这是我探索后的代码:

library(shiny)
library(shinymaterial)

# submodule UI
sidebarCharts <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("selectRootSymbol")),
    uiOutput(ns("selectSymbol")),
    # actionButton(ns("settings"), "Settings", icon = icon("cogs"), width = '100%', class = "btn btn-primary"),p()
    material_button(ns("settings"), "Settings", icon = "settings")
  )
}

# submodule server
chartSettings <- function(input, output, session) {

  ## 'Home' tab -- Sidebar
  output$selectRootSymbol <- renderUI({
    .choices <- c('a','b','c')
    material_dropdown(session$ns("reactiveRootSymbol"), label = "Root Symbol:", choices = .choices)
  })

  output$selectSymbol <- renderUI({
    # req(input$reactiveRootSymbol)
    .choices <- c('d', 'e', 'f')
    material_dropdown(session$ns("reactiveSymbol"), label = "Symbol:", choices = .choices)
  })

}


## Wrap shinymaterial apps in material_page ----
ui <- material_page(
  title = "App Title",
  nav_bar_fixed = FALSE,
  nav_bar_color = "black",
  background_color = "white",
  # font_color = "black",

  # Place side-nav in the beginning of the UI
  material_side_nav(
    fixed = FALSE,
    # Place side-nav tabs within side-nav
    material_side_nav_tabs(
      side_nav_tabs = c(
        "Home" = "home"
      ),
      icons = c("home")
    ),
    background_color = "white"
  ),

  # Define side-nav tab content
  material_side_nav_tab_content(
    side_nav_tab_id = "home",

    material_row(
      material_column(
        material_card(title = NULL,
                      sidebarCharts("main"),
                      depth = NULL),
        width = 2,
        offset = 0
      ),
      material_column(
        material_card(title = NULL,
                      "Chart goes here",
                      depth = NULL),
        width = 10,
        offset = 0
      )
    )
  )
)

## main server ----
server <- function(input, output, session) {
  callModule(chartSettings, "main")
}

## run ----
shinyApp(ui = ui, server = server)