I have a basic shiny app in which I want to be able to set the height of the Navbar menu named Navnar! I do not see any choice for setting its height.
#ui.r
library(markdown)
navbarPage("Navbar!",
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
),
mainPanel(
)
)
),
tabPanel("Summary"
),
navbarMenu("More",
tabPanel("Table"
)
)
)
#server.r
function(input, output, session) {
}
To adjust the height of the navbar menu, you have to differentiate between bootstrap versions. Probably in your shiny application bootstrap version 3.3.4 is used.
Then you can use:
tags$style(HTML('.navbar-nav > li > a, .navbar-brand {
padding-top:4px !important;
padding-bottom:0 !important;
height: 25px;
}
.navbar {min-height:25px !important;}'))
see Decreasing height of bootstrap 3.0 navbar.
To modify the height you can modify this CSS code adjust the numbers within height: 25px and min-height:25px.
Reproducbile example:
library(shinydashboard)
library(shiny)
ui <- navbarPage("Navbar!",
tags$head(
tags$style(HTML('.navbar-nav > li > a, .navbar-brand {
padding-top:4px !important;
padding-bottom:0 !important;
height: 25px;
}
.navbar {min-height:25px !important;}'))
),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
),
mainPanel(
)
)
),
tabPanel("Summary"
),
navbarMenu("More",
tabPanel("Table"
)
)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
Related
Is there a way to change the color of the following slide of the CRAN package shinyWidgets? Thanks in advance. I need to do it also in within the update function.
library("shiny")
library("shinyWidgets")
ui <- fluidPage(
br(),
sliderTextInput(
inputId = "mySliderText",
label = "Month range slider:",
choices = month.name,
selected = month.name[c(4, 7)]
),
verbatimTextOutput(outputId = "result")
)
server <- function(input, output, session) {
output$result <- renderPrint(str(input$mySliderText))
}
shinyApp(ui = ui, server = server)
This can be achieved with CSS applied to the input.
Here I changed the color properties of the CSS class of the input. Which mean it will apply to all slider text input of your app. If you want to apply the color only on one input, you need to apply the CSS properties on the class children of the input ID.
The easiest way to find out how to change an element in CSS is to play with the browser inspector (CTRL+shift+i) when your app is running.
library("shiny")
library("shinyWidgets")
ui <- fluidPage(
tags$style(HTML("
.irs--shiny .irs-bar {
background: blueviolet;
border-top: 1px solid blueviolet;
border-bottom: 1px solid blueviolet;
}
.irs--shiny .irs-to, .irs--shiny .irs-from {
background-color: blueviolet;
}
.irs--shiny .irs-handle {
border: 1px solid #c41818;
background-color: #c41818;
}")),
br(),
sliderTextInput(
inputId = "mySliderText",
label = "Month range slider:",
choices = month.name,
selected = month.name[c(4, 7)]
),
verbatimTextOutput(outputId = "result")
)
server <- function(input, output, session) {
output$result <- renderPrint(str(input$mySliderText))
}
shinyApp(ui = ui, server = server)
I managed to put an action button in the shiny dashboard's header. However, when applying styling using tags$li, it only applies to the sidebar. When removing the tags$a portion, the styling gets applied throughout the header. Not sure how to fix it, so the styling is consistent across the header- was hoping to get some hint/directions in stack overflow.
I have seen these posts:
Home Button in Header in R shiny Dashboard
Login Button in shinydashboard dashboardHeader
This question is extension of my previous question: resizing an action button causes misalignment in the header in shinydashboard
Here is a reprex (with an image below):
library(shiny)
library(shinydashboard)
library(htmltools)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(
tags$li(class = "dropdown",
tags$a(actionButton(inputId = "email1", label = "",
icon = icon("envelope", lib = "font-awesome")
#Also tried to adjust the width and height of transparent, no luck
# ,
# style='height: 20px;
# background: transparent;
# border: none;
# font-size: 2rem;
# transform: translate(5%, -30%);'
),
href="mailto:have_a_nice_day#yep.com;"),
# has no effect on the main header bar (the header in which button is placed)
tags$style(".main-header {max-height: 20px}"),
tags$style(".main-header .logo {height: 20px;}"),
tags$style(".sidebar-toggle {height: 20px; padding-top: 1px !important;}"),
tags$style(".navbar {min-height:20px !important}")
)
),
dashboardSidebar(
),
dashboardBody()
)
server <- function(input, output){}
shinyApp(ui, server)
Thank you very much for your help!
Your code works fine if you don't have an email icon in the header. Try this
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
# tags$li(class = "dropdown",
# tags$a(actionButton(inputId = "email1", label = "",
# icon = icon("envelope", lib = "font-awesome")
#
# #Also tried to adjust the width and height of transparent, no luck
# # ,
# # style='height: 20px;
# # background: transparent;
# # border: none;
# # font-size: 2rem;
# # transform: translate(5%, -30%);'
#
# ),
# href="mailto:have_a_nice_day#yep.com;"),
# ),
tags$li(class = "dropdown",
# has effect on the main header bar
tags$style(".main-header {max-height: 20px !important;}"),
tags$style(".main-header .logo {height: 20px !important;}"),
tags$style(".sidebar-toggle {height: 20px; padding-top: 1px !important;}"),
tags$style(".navbar {min-height:20px !important}")
)
),
dashboardSidebar(
# Adjust the sidebar
tags$style(".left-side, .main-sidebar {padding-top: 20px}")
),
dashboardBody()
)
server <- function(input, output){}
shinyApp(ui, server)
That's because of the paddings of the button and the a tag. You can do:
tags$a(actionButton(inputId = "email1", label = "",
icon = icon("envelope", lib = "font-awesome"),
style = "padding-top: 0; padding-bottom: 0;"),
href="mailto:have_a_nice_day#yep.com;",
style = "padding-top: 0; padding-bottom: 0;")
If you don't use the action button, it is better to do:
library(fontawesome)
and
tags$li(class = "dropdown",
tags$a(fa("envelope"),
href="mailto:have_a_nice_day#yep.com;",
style = "padding-top: 0; padding-bottom: 0;"),
I'm trying to add absolutePanel to my shiny dashboard app. I want the panel to be at the bottom of the page with the width of the window and adjust to it when the sidebar is visible or not. The problem is that when the sidebar is opened some of the panel is not visible:
On the other hand if I set the width from the left side of a panel and close the sidebar it's far from the left end of the window:
Here is a reproducible code:
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
absolutePanel(
bottom = 0, left = 0, right = 0, # or left = 300
fixed = TRUE,
wellPanel(
style = "padding: 8px; border-bottom: 1px solid #CCC; background: #FFFFEE;",
HTML("Save changes?"),
actionButton("save", "Save"),
actionButton("cancel", "Cancel")
)
)
)
)
server <- function(input, output) { }
shinyApp(ui, server)
Try removing absolutePanel with div that it produces with added high enough z-index to style:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
div(
style = "left:0px; right:0px; bottom:0px; position:fixed; cursor:inherit; z-index: 10000;",
wellPanel(
style = "padding: 8px; border-bottom: 1px solid #CCC; background: #FFFFEE;",
HTML("Save changes?"),
actionButton("save", "Save"),
actionButton("cancel", "Cancel")
)
)
)
)
server <- function(input, output) { }
shinyApp(ui, server)
I would like some inputs to have their label inline with the input box, and others to exhibit the standard Shiny standard behaviour. Consider the answer (and minimal example) given by SBista here: How to put a box and its label in the same row? (shiny package)
library(shiny)
ui <- fluidPage(
fluidRow(
tags$head(
tags$style(type="text/css", "label{ display: table-cell; text-align: center; vertical-align: middle; }
.form-group { display: table-row;}")
),
textInput(inputId = "txtInp", label = "Label:"),
textInput(inputId = "txtInp2", label = "A_longer_label:"),
numericInput(inputId = "numInp", label = "Third_label:", value = 0)
)
)
server <- function(input, output){}
shinyApp(ui, server)
This gives the very neat output like so:
Here the input boxes are neatly aligned. If I only want some of the labels to exhibit this behaviour (and others to do the normal Shiny thing), I can create the id "inline" and add it to divs around the labels in question, like so:
library(shiny)
ui <- fluidPage(
fluidRow(
tags$head(
tags$style(type="text/css", "#inline label{ display: table-cell; text-align: left; vertical-align: middle; }
#inline .form-group { display: table-row;}")
),
tags$div(id = "inline", textInput(inputId = "txtInp", label = "Label:")),
tags$div(id = "inline", textInput(inputId = "txtInp2", label = "Label2_not_inline:")),
numericInput(inputId = "numInp", label = "Third_label:", value = 0)
)
)
server <- function(input, output){}
shinyApp(ui, server)
Now the third label behaves as expected, but the first two labels are not neatly aligned. I guess this is because an id can only be used once. How can a class be used to achieve the desired result for multiple inputs?
To achieve what you want you could modify the css as follows:
tags$style(type="text/css", ".inline label{ display: table-cell; text-align: left; vertical-align: middle; }
.inline .form-group{display: table-row;}")
The code would look something like this:
library(shiny)
ui <- fluidPage(
fluidRow(
tags$head(
tags$style(type="text/css", ".inline label{ display: table-cell; text-align: left; vertical-align: middle; }
.inline .form-group{display: table-row;}")
),
tags$div(class = "inline", textInput(inputId = "txtInp", label = "Label:"),
textInput(inputId = "txtInp2", label = "Label2:")),
numericInput(inputId = "numInp", label = "Third_label:", value = 0)
)
)
server <- function(input, output){}
shinyApp(ui, server)
With this code you will get the labels which looks a lot cleaner, something like this:
Hope it helps!
How do I add text to the right of a dashboard header sidebar icon? It seems that previous similar solutions no longer work under updates to dashboardHeader().
This is what I am trying to do in a basic shinydashboard setting:
I can use the strategy from this answer to get text in the header, but it's right-justified (which I can likely fix custom css) and also feels pretty hacky.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(dashboardHeader(title = "demo",
tags$li(class = "dropdown",
tags$p("foo")
)
), dashboardSidebar(), dashboardBody())
server <- function(input, output) { }
shinyApp(ui, server)
Is there a better way to do this?
The dashboardHeader is expecting elements of type dropdownMenu. So it will be hard to find a not hacky solution. The possible (hacky) options are: a) Modify the dashboardHeader function, or b) use some JavaScript code to add the text after creating the header. Below is my attempt to solve your problem using JavaScript, maybe it could help you.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "demo"
),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(HTML(
'.myClass {
font-size: 20px;
line-height: 50px;
text-align: left;
font-family: "Helvetica Neue",Helvetica,Arial,sans-serif;
padding: 0 15px;
overflow: hidden;
color: white;
}
'))),
tags$script(HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<span class="myClass"> Text Here </span>\');
})
'))
)
)
server <- function(input, output) { }
shinyApp(ui, server)
Adding to Geovany & Tiffany's answers, if you'd like the text content to be dynamic, you can have it change based on user input with the shinyjs::html function.
For example, I'm using it to display the name of the selected tab in the header. You can access the selected tab name in the server function as long as you have given the sidebar menu an id, in my case this is tabs.
I also had to add an id to the div that is appended to the header in Geovany's code, in this case pageHeader.
Then adding this to the server function will change the header text to display the selected tab, with switch being used to create a more presentable header format. Note the useShinyJs() in dashboardPage parameters:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "demo"
),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(HTML(
'.myClass {
font-size: 20px;
line-height: 50px;
text-align: left;
font-family: "Helvetica Neue",Helvetica,Arial,sans-serif;
padding: 0 15px;
overflow: hidden;
color: white;
}
'))),
tags$script(HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<div id="pageHeader" class="myClass"></div>\');
})
'))
),
useShinyjs()
)
server <- function(input, output) {
observeEvent(input$tabs, {
header <- switch(input$tabs,
tab1 = "Tab 1",
tab2 = "Tab 2",
tab3 = "Tab 3")
# you can use any other dynamic content you like
shinyjs::html("pageHeader", header)
})
}
shinyApp(ui, server)
A slightly modified version of Geovany's code to customize font auto-sizing, placement etc. would be:
ui.R file in directory1 containing:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "demo"
),
dashboardSidebar(),
dashboardBody(
tags$script(HTML('
$(document).ready(function() {
$("header").find("nav").append(\'<div class="myClass"> Text Here </div>\');
})
')),
tags$head(
# Include our custom CSS
includeCSS("styles.css"),
)
)
)
server.R file in directory1 containing:
library(shiny)
library(shinydashboard)
server <- function(input, output) { }
a css style sheet (style.css in directory1) that controls the text parameters on resizing windows with a defined maximum size and unlimited shrink with the following code:
.myClass {
line-height: 50px;
text-align: center;
font-family: "Arial";
padding: 0 15px;
color: black;
font-size: 2vw;
}
#media (min-width: 1200px) {
.myClass {
line-height: 50px;
text-align: center;
font-family: "Arial";
padding: 0 15px;
color: black;
font-size: x-large
}
}
run using:
shiny::runApp("path to directory1")
Adding the padding properties can be a possible fix. Other options such as width, border and margin can be explored based on your requirements.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(dashboardHeader(title = "demo",
tags$li(class = "dropdown",
style = "padding: 10px 1200px 0px 0px;",
tags$p("foo")
)
), dashboardSidebar(), dashboardBody())
server <- function(input, output) { }
shinyApp(ui, server)
Hope this helps!