put a dropdown button on shinydashboard header for theme selection - r

I want to put a dropdown menu on shinydashboard header for dashboard theme change. My shiny app is like below. I could not make the app work. What I got is error message;
Error in FUN(X[[i]], ...) : Expected tag to be of type li
It seems like the dashboard area does not accept those typical shiny widgets? The header area is the best place to put this functionality. Does anyone know how I can make that work? Thanks a lot.
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) { }
)

You can not put the dropdownButton in the dashboardHeader.
Instead you can put it in the dashboardBody or dashboardSidebar and have it updated like this :
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))
}
)

Related

How to align a selectInput with bs4Dash::box()'s title

I want the selectInput on the same line as the box's title, as in the figure below
I'm trying to put the selectInput inside the title of a bs4Dash::box() with code below.
I'm using the tags$p with "display: inline" but it's not getting align with the box's title.
# library
library(shiny)
library(bs4Dash)
#UI
shinyApp(
ui = dashboardPage(
title = "Reproducible example",
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
fluidRow(
bs4Dash::box(
title = p("Header title",
shiny::selectInput("input_1",
"",
choices = c("choice_1", "choice_2")),
style = "display: inline"
),
width = 12
)
)
)
),
#SERVER
server = function(input, output) {
}
)
Anyone have any work arounds?

How to place box title and Info box next to each other in shiny using CSS

I have shiny application with box in the body as shown below:
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(box(
title = "My header1",
id = "box1", solidHeader = TRUE,
infoBox(title = "My header2", value = NULL,
icon = shiny::icon("calendar"),width = 12,
href = NULL)
)
))
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "Boxes"),
dashboardSidebar(),
body
),
server = function(input, output) {
}
)
How can i place the infoBox() next to the box title "My header1" ? so that they are in the same line as indicated below?
so that it looks like:

R - Could not find function "dashboardPagePlus"

I try to create a shiny app using dashboardPagePlus.
I already import shinydashboard and shinydashboardPlus package. But I got an error message when I run UI.
Error in dashboardPagePlus(skin = "black", dashboardHeaderPlus(title =
"title"), : could not find function "dashboardPagePlus"
I don`t know why. I try to run the example code from RDocumentation. But Still have this problem.
Example code:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "gears"
),
sidebar = dashboardSidebar(),
body = dashboardBody(),
rightsidebar = rightSidebar(),
title = "DashboardPage"
),
server = function(input, output) { }
)
How to fix it?
Thank you very much.
As already mentioned in the comments, if you use {shinydashboardPlus} >= 2.0.0, you would need to rewrite your code as follows:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(),
controlbar = dashboardControlbar(
skin = "dark",
controlbarMenu(
id = "menu"
)
),
title = "DashboardPage"
),
server = function(input, output) { }
)

Shiny: Open new dashboard with actionButton

I would like to open a second dashboard by pressing the action button on the first dashboard. I was able to do that using the code below but the dashboards are connected to each other. E.g. if I close the sidebar on the second dashboard, the sidebar of the first one closes, too.
This is the server.R file:
function(input, output, session) {
# some more code
# react to clicking on button show2
observeEvent(input$show2, {
# here is some more code
showModal(settngsModal())
})
settngsModal <- function() {
modalDialog(
withTags({
dashboardPage(
dashboardHeader(
title = "Second Dashboard"
),
dashboardSidebar(
sidebarMenu(
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)),
dashboardBody(
tabItem(tabName = "widgets",
h1("Widgets tab content")
)
)
)
}),
title = "Settings",
fade = TRUE)
}
}
This is the ui.R file:
dashboardPage(
dashboardHeader(
title = "First dashboard"
),
dashboardSidebar(collapsed = TRUE,sidebarMenu()),
dashboardBody(),
h1('Headline'),
actionButton("show2", "Show second dashboard", size = 'lg')
)
)
Is it possible to have an "independent" dashboard?
Maybe even having two dashboards that can be used side by side (because now the second dashboard is a popup and the first dashboard can only be used if the second one is closed)?
You could use shinyjs to toggle between the two dashBoardPage tags.
Below is an example of switching between two Dashboards, there's a decent issue thread around rendering UI dashboardPage elements reactively.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- tagList(
useShinyjs(),
div(id = "dashboard_two",
style = "display:none",
dashboardPage(
dashboardHeader(
title = "Second dashboard"
),
dashboardSidebar(collapsed = TRUE,sidebarMenu()),
dashboardBody(fluidRow(actionButton("show1", "Show first dashboard")),
fluidRow(box(title = "Dash Two", height = 300, "Testing Render")) )
)
),
div(id = "dashboard_one",
style = "display:none",
dashboardPage(
dashboardHeader(
title = "First dashboard"
),
dashboardSidebar(collapsed = TRUE, sidebarMenu()),
dashboardBody(actionButton("show2", "Show second dashboard")
)
)
)
)
server <- function(input, output) {
shinyjs::show("dashboard_one")
observeEvent({ input$show1; input$show2}, {
shinyjs::toggle("dashboard_one")
shinyjs::toggle("dashboard_two")
})
}
shinyApp(ui, server)

Collapse (close) Menu in SidebarMenu of Shinydashboard on button click

I am working in an application similar to one below. I have my input panel in sidebar under a menu which is initally expanded. I want to collapse the menu and hide all the input panel so that my sidebar will be clean. But It should appear when I expand (not permanently hide). I tried the following solution but it is not working. Please help me to find a solution or any alternative approach.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem(
startExpanded = TRUE,
"Menu 1",
column(
width = 12,
actionButton("hideMe", label = "Collapse Me", icon = icon("close"))
)
)
)
),
body = dashboardBody()
)
server <- function(input, output, server){
observeEvent(input$hideMe, {
shinyjs::hide(selector = "ul.menu-open");
})
}
runApp(shinyApp(ui, server))
You need to add useShinyjs() into ui part
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
useShinyjs(),
sidebarMenu(
menuItem(
startExpanded = TRUE,
"Menu 1",
column(
width = 12,
actionButton("hideMe", label = "Collapse Me", icon = icon("close"))
)
)
)
),
body = dashboardBody()
)
server <- function(input, output, server){
observeEvent(input$hideMe, {
shinyjs::hide(selector = "ul.menu-open");
})
}
runApp(shinyApp(ui, server))

Resources