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

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?

Related

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:

How to render an image in shiny box and fix the width and height? R

I have this shiny app I am making. My goal is to have a fluid row that has an image and some inputs
# Test Version with google logo
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Dashbaord"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center",
width = "100%",
style="height: 50px")), #I'm trying to change the size here but it doesn't work
box(align = "center",
title = "Select Inputs",status = "warning", solidHeader = F,
selectInput("dropdown1", "Select Drilldown:", c(50,100,200))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Technically this code works, but I don't like how the box with the image changes based off the monitor/view. I would like for both boxes to be the same height and remain uniformed. I posted some screen shots below.
Full Screen
Half Screen
Desire Output (row is the same height no matter what).
Edit:
box_height = "20em"
plot_height = "16em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center",
width = "100%"),
height = box_height),
box(plotOutput("speed_distbn",height = plot_height), height = box_height)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Boxes stay the same height but the image overlaps the box
How about this
library(shinydashboard)
library(shiny)
my_height = "30em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center", style = paste0("width: 100%; height: ", my_height, ";"))
),
box(title = "Plot", plotOutput("speed_distbn", height = my_height))
)
)
)
server <- function(input, output) {
output$speed_distbn <- renderPlot(plot(1))
}
shinyApp(ui, server)
In your first case, if you want to use other random tags on the right side. In order to have the right the same height as left, we can use spsComps::heightMatcher. We can use this function to dynamically match the height of the right side to the left side.
library(shinydashboard)
library(shiny)
my_height = "30em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
id= "box_l",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center", style = paste0("width: 100%; height: ", my_height, ";"))
),
box(
title = "Select inputs",
id= "box_r",
selectInput("dropdown1", "Select Drilldown:", c(50,100,200))
),
spsComps::heightMatcher("box_r", "box_l")
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
In your case, the height on left is fixed, but heightMatcher can do it even with dynamically changed height. try click on spsComps shiny demo and go to the Misc tab and see the dynamic heightMatcher example.

put a dropdown button on shinydashboard header for theme selection

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))
}
)

Make image used as title of shinydashboard fits exactly in the title box

I have put an image as title of my shiny dashboard and I have adjusted its size in order to fit in height and width but there is a small section in the left side which remains empty. How can I make it fit exactly in the box? (The blue part of the attached image remains empty)
# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(shinyWidgets)
library(shinyjs)
dbHeader <- dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "gears",
fixed = T,
title = tags$a(href='http://mycompanyishere.com',
tags$img(src='logo.png',height = "55px",width="232px"))
)
ui <- dashboardPagePlus(
dbHeader,
dashboardSidebar(),
dashboardBody(
useShinyjs(),
tags$hr(),
tabsetPanel(
id ="tabA",
type = "tabs",
tabPanel("Front",icon = icon("accusoft")),
tabPanel("Data", icon = icon("table")
)
)
),
rightsidebar = rightSidebar()
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
In order to do this, you need to modify dashboard CSS (i.e. padding). One way would be to insert
tags$head(tags$style(".skin-blue .main-header .logo { padding: 0px;}")),
inside dashboardBody()
Then the output looks like this (I don't have your logo but from an image below, you can see that blue part is gone).
For more on how to style apps in Shiny see here: https://shiny.rstudio.com/articles/css.html

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