I have a very basic infoBox like this, and want to adjust the height as the current height is just way too much for what I am incorporating.
Any idea how I can do it? I tried what was suggested here: r shinydashboard - change height of valueBox. But, that is not having any change.
sidebar <- dashboardSidebar(
sidebarMenu(id = 'sidebarmenu',
menuItem('About', tabName = 'about'))
)
about <- tabItem('about', fluidPage(
fluidRow(
infoBoxOutput('age')
)
)
)
body <- dashboardBody(
tabItems(
about
)
)
ui <- dashboardPage(
dashboardHeader(
title = 'My App'
),
sidebar = sidebar,
body = body
)
server <- function(input, output) {
output$age <- renderInfoBox({
infoBox('Age: ', 50, icon = icon('list'), width = 6)
})
}
shinyApp(ui = ui, server = server)
You need to apply some CSS rules.
body <- dashboardBody(
tags$head(tags$style(HTML('.info-box {min-height: 45px;} .info-box-icon {height: 45px; line-height: 45px;} .info-box-content {padding-top: 0px; padding-bottom: 0px;}'))),
tabItems(
about
)
)
Related
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.
I have the shiny dashboard below and I need to change the color of the header that includes the title permanently. Now when I hover over it returns to previous color.
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
width=400
),
dashboardBody(
tags$head(tags$style(HTML('
/* logo */
.skin-blue .main-header .logo {
background-color: #E7FF6E;
}')))
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
You can create a custom theme to use with {shinydashboard} with the {fresh} package, more documentation here : https://dreamrs.github.io/fresh/articles/vars-shinydashboard.html
Here an example to modify header background color:
library(fresh)
# Create the theme
mytheme <- create_theme(
adminlte_color(
light_blue = "#E7FF6E"
)
)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
header = dashboardHeader(title = "My dashboard"),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Settings", tabName = "settings", icon = icon("sliders"))
)
),
body = dashboardBody(
use_theme(mytheme) # <-- use the theme
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I have developed a shiny app, where we are using various box object in the ui. Currently the boxes expand/Collapse by clicking on the "+/-" sign on the right of the box header, but we need the expand/collapse on click on the header (anywhere on the box header).
Below code (sample code)
If you look at the box with chart, I want the expansion & collapse to be performed on clicking the header i.e. "Histogram box title" and not just the "+/-" sign on right side of the header:
## Only run this example in interactive R sessions
if (interactive()) {
library(shiny)
# A dashboard body with a row of infoBoxes and valueBoxes, and two rows of boxes
body <- dashboardBody(
# Boxes
fluidRow(
box(title = "Histogram box title",
status = "warning", solidHeader = TRUE, collapsible = TRUE,
plotOutput("plot", height = 250)
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(rnorm(50))
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
}
This is easily achievable using javascript. You just have to create a javascript function and call the same in your header code. Refer to below code for better understanding. I have provided 3 options, let me know if this works for you.
## Only run this example in interactive R sessions
if (interactive()) {
library(shiny)
# javascript code to collapse box
jscode <- "
shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"
# A dashboard body with a row of infoBoxes and valueBoxes, and two rows of boxes
body <- dashboardBody(
# Including Javascript
useShinyjs(),
extendShinyjs(text = jscode),
# Boxes
fluidRow(
box(id="box1",title = actionLink("titleId", "Histogram box title",icon =icon("arrow-circle-up")),
status = "warning", solidHeader = TRUE, collapsible = T,
plotOutput("plot", height = 250)
),
box(id="box2",title = p("Histogram box title",
actionButton("titleBtId", "", icon = icon("arrow-circle-up"),
class = "btn-xs", title = "Update")),
status = "warning", solidHeader = TRUE, collapsible = T,
plotOutput("plot1", height = 250)
),
box(id="box3",title = actionButton("titleboxId", "Histogram box title",icon =icon("arrow-circle-up")),
status = "warning", solidHeader = TRUE, collapsible = T,
plotOutput("plot2", height = 250)
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(rnorm(50))
})
output$plot1 <- renderPlot({
hist(rnorm(50))
})
output$plot2 <- renderPlot({
hist(rnorm(50))
})
observeEvent(input$titleId, {
js$collapse("box1")
})
observeEvent(input$titleBtId, {
js$collapse("box2")
})
observeEvent(input$titleboxId, {
js$collapse("box3")
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
}
You can do this for all boxes in an app with a few lines of external css and javascript.
The JS triggers a click on the widget when you click on the header title. It has to be the h3 element because the widget is inside .box-header, which would cause infinite recursion.
$('.box').on('click', '.box-header h3', function() {
$(this).closest('.box')
.find('[data-widget=collapse]')
.click();
});
But then we need to make the h3 element fill the full .box-header, so get rid of the header padding (except on the right), add it to the h3, and make the h3 fill 100% of the width of the box.
.box-header {
padding: 0 10px 0 0;
}
.box-header h3 {
width: 100%;
padding: 10px;
}
I think Lisa DeBruine answer is the better one since you can click the whole header and not just the title.
Pasted it into a small example:
if (interactive()) {
body <- dashboardBody(
useShinyjs(),
tags$style(HTML("
.box-header {
padding: 0 10px 0 0;
}
.box-header h3 {
width: 100%;
padding: 10px;
}")),
fluidRow(
box(id="box1", title = "Histogram box title",
status = "warning", solidHeader = TRUE, collapsible = T,
plotOutput("plot", height = 250)
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(rnorm(50))
})
runjs("
$('.box').on('click', '.box-header h3', function() {
$(this).closest('.box')
.find('[data-widget=collapse]')
.click();
});")
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
}
I would like to display Shinydashboard input fields as a type of menuSubItem, however I'm finding it difficult to write the solution.
Household Penetration(dropdown on click)
Store-filters
Button
Sales(Household Penetration Menu collapses on click and Sales Menu drops)
filter x
Do you have any solution for this?
ui.R
library(shiny)
library(shinydashboard)
library(leaflet)
source("R/load_metadata.R", chdir=TRUE)
# Header of the dashboard
header <- dashboardHeader(
title = "x",
titleWidth = 350,
dropdownMenuOutput("task_menu")
)
# Sidebar of the dashboard
sidebar <- dashboardSidebar(
sidebarMenu(
id = "menu_tabs",
menuItem("Household Penetration", tabName = "menutab1", icon = icon("percent")),
selectInput("storeInput", label = "Store",
choices = STOREFILTER$STORE_NAME,
selected = STOREFILTER$STORE_NAME[1]),
actionButton("Button", "Filter Map"),
menuItem("Sales", tabName = "menutab2", icon = icon("euro"))
)
)
# Body of the dashboard
body <- dashboardBody(
tabItems(
tabItem(
tabName = "menutab1",
tags$style(type = "text/css", "#mymap {height: calc(100vh - 80px) !important;}"),
leafletOutput("mymap")),
tabItem(
tabName = "menutab2",
tags$style(type = "text/css", "#mymap {height: calc(100vh - 80px) !important;}"),
h2("Dashboard tab content")
)
)
)
# Shiny UI
ui <- dashboardPage(
header,
sidebar,
body,
tags$head(
tags$style(HTML(type='text/css', "#Button { width:40%; margin-left: 30%; margin-right: 30%; background-color: #3C8DBC; color: black; font-weight: bold; border: 0px}")))
)
You can show/hide your inputs fields with a conditionalPanel according to the selected menu:
conditionalPanel(
condition = "input.menu_tabs == 'menutab1'",
selectInput("storeInput", label = "Store",
choices = STOREFILTER$STORE_NAME,
selected = STOREFILTER$STORE_NAME[1]),
actionButton("Button", "Filter Map")
)
I created a dashboard using shinyDashboard and I have a map with leaflet. The box element used in shinyDashboard creates a fixed height of 400px for the map.
I would like the map to be 90vh so that it covers most of the screen, and so I wrote this on the UI file:
tabItem(tabName = "widgets",
fluidPage(
fluidRow(
tags$head(tags$style(type = "text/css",'
#geomap {
height: 90vh;
}
')),
box(title = "Geographical distribution",
leafletOutput("geomap")
)
)
)
)
Now, when I inspect the page, I can see that the property was passed onto the #geomap id, but it is overridden for some reason
!
Also, here is the node
.
I have overridden classes before successfully, so I don't understand how an ID can't be overridden. Any ideas?
Thank you!
EDIT: Here's an example code:
library(shiny)
library(shinydashboard)
library(leaflet)
server <- function(input, output, session) {
output$geomap <- renderLeaflet({
m <- leaflet(data) %>%
addProviderTiles("CartoDB.Positron")
})
}
ui <- dashboardPage(skin = "black",
dashboardHeader(title = "Test"),
dashboardSidebar(
sidebarMenu(
menuItem("Map distribution", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "widgets",
fluidPage(
fluidRow(
tags$head(tags$style(HTML('
.col-sm-6 {
width: 100%;
}
'))),
box(title = "Geographical distribution",
leafletOutput("geomap")
)
)
)
)
)
)
)
shinyApp(ui, server)