поместите кнопку раскрывающегося списка в заголовок блестящей панели для выбора темы - PullRequest
1 голос
/ 06 мая 2020

Я хочу разместить раскрывающееся меню в заголовке shinydashboard для изменения темы панели. Мое блестящее приложение показано ниже. Я не мог заставить приложение работать. Я получил сообщение об ошибке:

Error in FUN(X[[i]], ...) : Expected tag to be of type li

Кажется, что область панели управления не принимает эти типичные блестящие виджеты? Область заголовка - лучшее место для размещения этой функции. Кто-нибудь знает, как я могу заставить это работать? Большое спасибо.

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


header <- dashboardHeader(
    title = "Dashboard Demo",
    dropdownButton(

        tags$h3("List of Themes:"),

        radioButtons(inputId = 'theme',
                     label = 'Dashboard Theme',
                     choices = c('blue_gradient', 'boe_website', 'grey_light','grey_dark',
                                 'onenote', 'poor_mans_flatly', 'purple_gradient'),
                     selected = 'grey_dark',
                     inline=FALSE),

        circle = TRUE, status = "primary",
        icon = icon("window-maximize"), width = "300px",

        tooltip = tooltipOptions(title = "Click to change dashboard theme")
    )
)

shinyApp(
    ui = dashboardPage(
        header,
        dashboardSidebar(),
        dashboardBody(
            shinyDashboardThemes(
                theme = input$theme
            ),
        )
    ),
    server = function(input, output) { }
)

1 Ответ

1 голос
/ 07 мая 2020

Вы не можете поместить dropdownButton в dashboardHeader.

Вместо этого вы можете поместить его в dashboardBody или dashboardSidebar и обновить его следующим образом:

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

shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "Dashboard Demo"),
    dashboardSidebar(),
    dashboardBody(
      dropdownButton(
        radioButtons(inputId = 'theme',
                     label = 'Dashboard Theme',
                     choices =  c('blue_gradient', 'boe_website', 'grey_light','grey_dark',
                                  'onenote', 'poor_mans_flatly', 'purple_gradient'))
      ),
      uiOutput("myTheme")
    )
  ),
  server = function(input, output) { 
    output$myTheme <- renderUI( shinyDashboardThemes(theme = input$theme))
    }
)
...