我正在尝试使用shinymaterial
程序包(https://ericrayanderson.github.io/shinymaterial/)将基本仪表板组装在一起,但是我的下拉菜单(通常是常规闪亮应用程序中的selectInput
)没有出现一个小问题不会显示在嵌套的UI模块中。
这是到目前为止我的脚手架的代码段:
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)
我认为我有一个名称空间问题,但是我不确定(因为按钮确实显示在嵌套模块中)。我在做什么错了?
非常感谢您的帮助!
答案 0 :(得分:1)
这里至少有两个问题。
这似乎是由于width = 100%
中未使用的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)