Related
I have a shiny app and I would like to change the font typeand the background color of the navbar menu.
I have used 'Inspect' on this after running the app and I found that this element is:
a href="#" class="dropdown-toggle" data-toggle="dropdown" data-value="More">
More
<b class="caret"></b>
</a>
but im not familiar with css.
ui <- function(){
bootstrapPage('',
navbarPage(title = 'Hello colour changed',
navbarMenu("More",
tabPanel("Table"
),
tabPanel("About"
)
)),
tags$style(type = 'text/css', '.navbar { background-color: #252525;
font-family: Arial;
font-size: 13px;
color: #FF0000; }',
'.navbar-dropdown { background-color: #252525;
font-family: Arial;
font-size: 13px;
color: #FF0000; }',
'.navbar-default .navbar-brand {
color: #cc3f3e;
}'
))
}
server <- function(input, output, session){
}
shinyApp(ui = ui, server = server)
Below will change the background colour, text colour of the nav-bar, and you can also set the font-family to change font type.
library(shiny)
library(shinydashboard)
ui <- function(){
navbarPage(title = 'Hello colour change',
tabPanel("title2"),
tabPanel("title3"),
tags$style(type = 'text/css',
'.navbar { background-color: red;}',
'.navbar-default .navbar-brand{color: white;}',
'.tab-panel{ background-color: red; color: white}'
))
}
server <- function(input, output, session){
}
shinyApp(ui = ui, server = server)
I have 2 textInput and 2 selectInput functions. One on the dark background on my sidebar and the other on the white (inside the bsModal). My question is: is there a way to style them in different ways? Ideally, I would like to keep the ones on the sidebar the way I styled, and for the ones inside bsModal at least change font color and a border color.
Code:
## Shiny
library(shiny)
library(shinydashboard)
library(shinyBS)
ui <- dashboardPage(
## Header ----
dashboardHeader(
disable = TRUE
),
## Sidebar ----
dashboardSidebar(
sidebarMenu(
div(style = "border-left-color: #1e282c; padding: 10px",
menuItem(text = div(HTML("<left>Search</left>")),
tabName = "search",
icon = icon("search", "fa-2x"))
)
)
),
## Body ----
dashboardBody(
## when header is disabled need to compensate for the missing 50px
## to avoid empty space on the bottom
tags$script('window.onload = function() {
function fixBodyHeight() {
var el = $(document.getElementsByClassName("content-wrapper")[0]);
var h = el.height();
el.css("min-height", h + 50 + "px");
};
window.addEventListener("resize", fixBodyHeight);
fixBodyHeight();
};'),
tags$style(HTML(
"
.well{
background-color: #222C3C;
color: #FFFFFF;
}
.form-control {
background-color: transparent;
border: 0px;
border-bottom: 1px solid #ffffff;
color: #ffffff;
}
.selectize-input{
background: transparent;
}
.selectize-input.items.not-full.has-options {
border: 0px;
border-bottom: 1px solid #ffffff;
border-radius: 0;
}
.selectize-dropdown, .selectize-input, .selectize-input input{
color: #FFFFFF;
}
.selectize-control.multi .selectize-input > div{
background: rgb(9, 231, 178, 0.3);
color: #ffffff;
}
.selectize-dropdown-content {
background: #1B2431;
color: #ffffff;
border-radius: 4px;
}
.selectize-input.full{
background-color: transparent;
color: #FFFFFF;
border: 0px;
border-bottom: 1px solid #ffffff;
border-radius: 0;
}
.selectize-input, .selectize-control.single, .selectize-input.input-active{
background: transparent !important;
}
"
)),
# includeCSS("www/style.css"),
tabItems(
tabItem(
tabName = "search",
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel(div("Search task"),
textInput("searchTextIn", HTML("<i class='fa fa-search'></i> KEYWORDS"), value = ""),
selectizeInput("productFilter", HTML("<i class='fa fa-share-alt gly-rotate-135'></i> PRODUCT OR COMPONENT"),
choices = c("A", "AAA", "B", "BBBBBB", "C", "CCCCCC"),
multiple = TRUE,
selected = c("A", "AAA")),
actionLink("saveToGroup", HTML("<u> Save to group </u>"), style = "color: #d3d3d3cf"),
width = 3)
)),
mainPanel(
bsModal("saveToGroupPopup", "Save to group", "saveToGroup",
div(selectizeInput("saveToGroupSelection",
"Add this search to a search group:",
choices = c("Category A", "Category B", "Category C",
"Batman"),
selected = NULL,
multiple = TRUE,
options = list(maxItems = 1))),
textInput("saveToGroupNew", label = NULL, value = "",
placeholder = "Create new…")
)
)
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
you can use glamor to style your inputs differently. Basically glamor allows you to write css using javascript like conditions. just pass a boolean variable along with the class and on the basis of that variable choose the style of text field for example
const descDiv = **isDark** => css({
color: isDark ? color.white : colors.gray,
marginBottom: isDark? '0rem' :'1rem',
letterSpacing:isDark ? '0px' :'-0.6px', //if isDark true 0px else -0.6px
width:isDark? '10rem' :'13.5rem'
});
One solution that worked for me is for the textInput is actually quite easy, all I needed to do is in my css:
textInput(id, "")
tags$style(HTML("
#id.form-control{color:gray;}
"))
For the selectize input is a bit more confusing:
selectizeInput(id, ....)
tags$style(HTML("
#id + div>.selectize-input.items.not-full.has-options{border-bottom: 1px solid #F2F2F2;}
#id + div>.selectize-dropdown, #id+ div>.selectize-input, #id+ div>.selectize-input input{ color: gray;}
#id + div> div> .item {color: gray;}
"))
Below is the part of UI code.I am not able to see all the selectinput in the sidebarpanel,
i suspect,it is not able to scroll further or may be if the font size of the
sidebarpanel has to be reduced.Any different approach which can be implemented to solve the problem?
dashboardPage(title = "title",
dashboardHeader(title="title1"
),
dashboardSidebar(tags$head(tags$style(HTML("
.selectize-input, .selectize-dropdown {
font-size:40%;
} }
"))),
radioButtons("filetype", "Select file type",choices=c("csv file","xlsx file")),
tags$div(title="Date format should be mm/dd/YYYY",fileInput("file1", "Upload Data File", accept = c("text/csv","text/comma-separated-values,text/plain",".csv",".xlsx",".xls"))),
uiOutput("col"),
uiOutput("covariate"),
uiOutput("dimensions1"),
uiOutput("levels1"),
uiOutput("dimensions2"),
uiOutput("level2"),
uiOutput("dimensions3"),
uiOutput("level3"),
uiOutput("dimensions4"),
uiOutput("level4")
),
dashboardBody(tags$head(
tags$style(HTML(".my_class {
font-weight: bold;
color:white;
}")
))
,uiOutput("All_tab_Display")
)
)
You'd better provide a reproducible example of your work.
test this and notify me whether it helped or not:
tags$head(
tags$style(HTML("
.sidebar { height: 90vh; overflow-y: auto; font-size: 10px;}
" )
)
)
I am developing a R Shiny Application that use the shinyWidgets library. I use 2 times the radioGroupButtons widget. I would like to make it green the first time, and red the second time, using CSS. (In reality I want to make more customisation).
Here is a basic code, applying CSS to every buttons. How can I apply 2 CSS classes?
Thank you very very much for your help !
library("shinyWidgets")
library(shiny)
# Useless server
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$button1), col = 'skyblue', border = 'white')
})
}
# Ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# A CSS for every .btn button
tags$style(HTML("
.btn {
color: #2ecc71;
border: 2px #2ecc71 solid;
}
.btn:hover {
color: #fff;
background-color: #2ecc71;
}
.btn-default.active, .btn-default:active, .open > .dropdown-toggle.btn-default {
color: #fff;
background-color: #2ecc71;
border-color: #2ecc71;
}
")),
# first radio button, it is green!
radioGroupButtons("button1", label = "It's green !!", choices=c("choice1"=50, "Choice2"=100, "Choice3"=150), selected=100),
# second radio button, I wish it is red!
radioGroupButtons("button2", label = "I wish I was red :( ...", choices=c("choice1"=1, "Choice2"=2), selected=1)
),
mainPanel(plotOutput("distPlot"))
)
)
shinyApp(ui = ui, server = server)
So you want to add some specific classes to your radioGroupButtons. Well, ShinyWidgets doesn't let you, so why not create your own radioButtons widget function.
(Well, this function will be almost entirely copied from radioGroupButtons)
Hint: Type radioGroupButton into the R Console to view the source code.
And lets tweak that function, such that it accepts a class argument, which will be applied to the html element. Then, you can easily access the different radioGroupButton-classes with your CSS.
Working code below:
library("shinyWidgets")
library(shiny)
# Defining the new Widget.
customRadioGroupButtons <- function (inputId, label = NULL, choices, selected = NULL, status = "default", size = "normal", direction = "horizontal", justified = FALSE, individual = FALSE, checkIcon = list(), class=NULL) {
choices <- shinyWidgets:::choicesWithNames(choices)
if (!is.null(selected) && length(selected) > 1)
stop("selected must be length 1")
if (is.null(selected))
selected <- choices[1]
size <- match.arg(arg = size, choices = c("xs", "sm", "normal",
"lg"))
direction <- match.arg(arg = direction, choices = c("horizontal",
"vertical"))
status <- match.arg(arg = status, choices = c("default",
"primary", "success", "info", "warning", "danger"))
divClass <- if (individual)
""
else "btn-group"
if (!individual & direction == "vertical") {
divClass <- paste0(divClass, "-vertical")
}
if (justified) {
divClass <- paste(divClass, "btn-group-justified")
}
if (size != "normal") {
divClass <- paste0(divClass, " btn-group-", size)
}
# Below here, the paste call is the only difference to the original function.
radioGroupButtonsTag <- tagList(tags$div(id = inputId, class = paste("radioGroupButtons", class),
if (!is.null(label))
tags$label(class = "control-label", `for` = inputId, label),
if (!is.null(label))
br(), style = "margin-top: 3px; margin-bottom: 3px; ", style = if (justified) "width: 100%;",
tags$div(class = divClass, role = "group",
`aria-label` = "...", `data-toggle` = "buttons",
class = "btn-group-container-sw", shinyWidgets:::generateRGB(inputId, choices, selected, status, size, checkIcon))))
shinyWidgets:::attachShinyWidgetsDep(radioGroupButtonsTag)
}
# Useless server
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$button1), col = 'skyblue', border = 'white')
})
}
# Ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# Note: Consider making a function if you use this more often.
tags$style(HTML("
.radioGroupButtons.green .btn {
color: #2ecc71;
border: 2px #2ecc71 solid;
}
.radioGroupButtons.green .btn:hover {
color: #fff;
background-color: #2ecc71;
}
.radioGroupButtons.green .btn-default.active, .radioGroupButtons.green .btn-default:active, .radioGroupButtons.green .open > .dropdown-toggle.btn-default {
color: #fff;
background-color: #2ecc71;
border-color: #2ecc71;
}
.radioGroupButtons.red .btn {
color: #EE102B;
border: 2px #EE102B solid;
}
.radioGroupButtons.red .btn:hover {
color: #fff;
background-color: #EE102B;
}
.radioGroupButtons.red .btn-default.active, .radioGroupButtons.green .btn-default:active, .radioGroupButtons.green .open > .dropdown-toggle.btn-default {
color: #fff;
background-color: #EE102B;
border-color: #EE102B;
}
")),
# first radio button, it is green!
customRadioGroupButtons("button1", class="green", label = "It's green !!", choices=c("choice1"=50, "Choice2"=100, "Choice3"=150), selected=100),
# second radio button, I wish it is red!
customRadioGroupButtons("button2", class="red", label = "I wish I was red :( ...", choices=c("choice1"=1, "Choice2"=2), selected=1)
),
mainPanel(plotOutput("distPlot"))
)
)
shinyApp(ui = ui, server = server)
You can add a Bootstrap status then overwrite the class, for example if you add status = "danger", buttons will have class btn-danger :
I can remove the limitation to valid Bootstrap status in the function, it could be useful for such styling (fill an issue here so i remenber).
library("shinyWidgets")
library("shiny")
# Useless server
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$button1), col = 'skyblue', border = 'white')
})
}
# Ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
# A CSS for every .btn button
tags$style(HTML("
.btn-success.btn {
color: #2ecc71;
background-color: #fff;
border: 2px #2ecc71 solid;
}
.btn-success.btn:hover {
color: #fff;
background-color: #2ecc71;
}
.btn-success.active {
color: #fff;
background-color: #2ecc71;
border-color: #2ecc71;
}
.btn-danger.btn {
color: #EE102B;
background-color: #fff;
border: 2px #EE102B solid;
}
.btn-danger.btn:hover {
color: #fff;
background-color: #EE102B;
}
.btn-danger.active {
color: #fff;
background-color: #EE102B;
border-color: #EE102B;
}
")),
# first radio button, it is green!
radioGroupButtons("button1", label = "It's green !!", status = "success", choices=c("choice1"=50, "Choice2"=100, "Choice3"=150), selected=100),
# second radio button, I wish it is red!
radioGroupButtons("button2", label = "I wish I was red :( ...", status = "danger", choices=c("choice1"=1, "Choice2"=2), selected=1)
),
mainPanel(plotOutput("distPlot"))
)
)
shinyApp(ui = ui, server = server)
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!