I would like to customize the color of the box status of my shiny app.
I find a css way to change the box background color of these box but not to customize the status color, but I do not see the equivalent argument of "status" in css?
I thus print the source code of a simple page containing the considered argument "status" and I was lookin at its class (I think class="box box-solid box-primary") but I do not manage to reach it in the several .css provided in this webpage... :(
Do you have an idea ?
Here is this simple code :
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(width = 6, title = "youhou", status = "primary", solidHeader = TRUE,
"Box content"
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
Thank you in advance for any help !
Cha
I finally found the answer (long and tough but always gratifying :D)
One of my friend (Thank you so much my friend !!!) shows me how to display all css parameters of each element of a web page (and particularly of a shiny page: go to the appropriate page and right click, something like "examine the element"!!
So AMAZING !!
Then, I look deeper (very very very deeper, there is so much classes !!) and I managed to access to any css parameter of the boxes !
Here is the code for the next people :
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$style(HTML("
.box.box-solid.box-primary>.box-header {
color:#fff;
background:#666666
}
.box.box-solid.box-primary{
border-bottom-color:#666666;
border-left-color:#666666;
border-right-color:#666666;
border-top-color:#666666;
}
")),
fluidRow(
box(width = 6, title = "youhou", status = "primary", solidHeader = TRUE,
"Box content"
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
Have a good week-end !!
Cheers !
This is brilliant and worked really well for me! I just wanted to add that there is a small bit of code you can add if you want to be able to use the new color with solidHeader = FALSE (to get at Dmitri's question). You need to change the color of the text in the header (I am now using black) and my new 'status' is purple. Here is an example below (where I am replacing the danger status rather than primary):
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$style(HTML("
.box.box-solid.box-danger>.box-header {
color:#fff;
background:#9966ff
}
.box.box-solid.box-danger{
border-bottom-color:#9966ff;
border-left-color:#9966ff;
border-right-color:#9966ff;
border-top-color:#9966ff;
}
.box.box-danger>.box-header {
color:#000000;
background:#fff
}
.box.box-danger{
border-bottom-color:#9966ff;
border-left-color:#9966ff;
border-right-color:#9966ff;
border-top-color:#9966ff;
}
")),
fluidRow(
box(width = 6, title = "youhou", status = "danger", solidHeader = FALSE,
"Box content"
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
(I found the right argument for this kind of box by following the OP's instructions to display all the css parameters.)
As I was trying to change the status color for hours now, I think I'd share my solution here, if anyone ever runs into the same problem again.
I was trying to edit the CSS code in a dedicated CSS file but that was not working. But when I added the CSS code directly into the shiny app file via tags$style (like the solutions provided by Charlotte Sirot and Michelle Ross) it worked.
Could have something to do with prioritizing the source of CSS style code, and directly adding the code with tags$style overrides all other sources.
I'm just building from #Michelle Ross and #Charlotte Sirot excellent answers and hoping that someone else also will benefit from this variation: I wanted to customize different colors for different statuses, here I chose "danger" and "info". I also wanted the box content background to be filled with color. To acheive that I used the following code:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$style(HTML("
.box.box-solid.box-danger>.box-header {
color:#9966ff;
background:#9966ff
}
.box.box-solid.box-danger{
border-bottom-color:#9966ff;
border-left-color:#9966ff;
border-right-color:#9966ff;
border-top-color:#9966ff;
}
.box.box-danger>.box-header {
color:#fff;
background:#9966ff
}
.box.box-danger{
border-bottom-color:#9966ff;
border-left-color:#9966ff;
border-right-color:#9966ff;
border-top-color:#9966ff;
background: #9966FF;
}
.box.box-solid.box-info>.box-header {
color:#000000;
background:#FFAE66
}
.box.box-solid.box-info{
border-bottom-color:#FFAE66;
border-left-color:#FFAE66;
border-right-color:#FFAE66;
border-top-color:#FFAE66;
}
.box.box-info>.box-header {
color:#fff;
background:#FFAE66
}
.box.box-info{
border-bottom-color:#FFAE66;
border-left-color:#FFAE66;
border-right-color:#FFAE66;
border-top-color:#FFAE66;
background: #FFAE66;
}
")),
fluidRow(
box(width = 6, title = "youhou", status = "danger", solidHeader = FALSE,
"Box content"
),
box(width = 6, title = "Hanna", status = "info", solidHeader = F,
"blabla")
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
And generated a shinydashboard with boxes like this:
Related
For the dropdownMenu in the header, I want to change the icon reactively, so I have to place the code into server. However the styling goes bonkers, is there a way to keep the original styling? I've tried manually copying styles and setting everything important but it still doesn't work.
In this example, there are two dropdownMenu blocks, one in the ui (looks good) and one in the server (looks bad). I want to make the bad one look the same as the good one.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
uiOutput("my_dropdown"),
dropdownMenu(
type = "tasks",
badgeStatus = "danger",
icon = "Looks good"
)
),
sidebar = dashboardSidebar(),
body = dashboardBody(),
rightsidebar = rightSidebar()
),
server = function(input, output) {
output$my_dropdown <- renderUI({
dropdownMenu(
type = "tasks",
badgeStatus = "danger",
icon = "Looks bad"
)
})
}
)
This is what it looks like
This is what it should look like
So my question is very related to this one : R shinyDashboard customize box status color
However, the problem is that the provided solution does not add an available color but only replace an existing one. Thus, we are limited to only 5 colors for boxes in one shiny apps. In other words, I would like to add a customized color while keeping the existing ones
So i thought about a similar solution but it didn't work...
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$style(HTML("
.box.box-solid.box-primary2>.box-header {
color:#fff;
background:#666666
}
.box.box-solid.box-primary2{
border-bottom-color:#666666;
border-left-color:#666666;
border-right-color:#666666;
border-top-color:#666666;
}
")),
fluidRow(
box(width = 6, title = "youhou", status = "primary2", solidHeader = TRUE,
"Box content"
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
Error in validateStatus(status) :
Invalid status: primary2. Valid statuses are: primary, success, info, warning, danger.
The below is a hacky way of doing it. Essentially you need to create a custom div and use it's id tag so that the css styling takes precedence over the original box styling and use renderUI to generate this new custom box.
However, you also do not want to inadvertently style the other box so you use the id to apply the styling specifically to your box of choice.
Finally you use uiOutput and renderUI on the server side to create this new div and the respective styled box.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(width = 6, title = "youhou", status = "primary", solidHeader = TRUE,
"Box content"
),
uiOutput("primary2")
)
)
)
server <- function(input, output) {
output$primary2 <- renderUI({
tags$div(class = "another-box", id = "primariy2",
box(width = 6, title = "youhou", status = "primary", solidHeader = TRUE,
"Box content"
),
tags$style(HTML("
#primariy2 .box.box-solid.box-primary>.box-header {
color:#fff;
background:#666666
}
.box.box-solid.box-primary {
border-bottom-color:#666666;
border-left-color:#666666;
border-right-color:#666666;
border-top-color:#666666;
}
"))
)
})
}
I am using awesomeCheckboxGroup from the package shinyWidgets to create checkboxes in a shiny app. As default, they have a blue background. I can change the background colour with the argument status = but this is limited to the five status colours.
I believe I should be able to make a custom status using CSS, and pass this through to the argument. However, when I inspect the page, it is totally eluding me which the relevant bit is to change. I can't see the blue colour mentioned anywhere! I've also tried changing the status in case I can see the relevant code change there, but that hasn't helped me either.
I have only ever used CSS in the context of an app like this, so apologies if I am missing something obvious. Also happy with a solution that uses an alternative approach, of course!
EDIT: I have now identified the element, so I can change the colour! The downside is that it also affects another part of the page. In my actual work, this doesn't matter because I am actually changing to the same colour as the header, so this is not noticeable - but is there a way to be more specific and colour only the checkboxes?
library(shiny)
library(shinydashboard)
library(shinyWidgets)
sidebar <- dashboardSidebar()
body <- dashboardBody(
fluidRow(class ="rowhide",
box(width = 12, solidHeader = TRUE,
awesomeCheckboxGroup(inputId = "checkbox",
label = "Filter",
choices = c("A", "B", "C"),
selected = c("A", "B", "C"))
)
),
# theme styling ####
tags$head(tags$style(HTML('
:after, :before{
background-color:#bff442;
}'
))))
ui <- dashboardPage(dashboardHeader(title = "Example"),
sidebar,
body
)
server <- function(input, output) {
}
shinyApp(ui, server)
Success! By adding the id of the checkbox input, I was able to isolate it to just that one element. However, it me a while to figure this out because the id needs to be added to both the before and after parts.
Here is my working code:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
sidebar <- dashboardSidebar()
body <- dashboardBody(
fluidRow(class ="rowhide",
box(width = 12, solidHeader = TRUE,
awesomeCheckboxGroup(inputId = "checkbox",
label = "Filter",
status = "warning",
choices = c("A", "B", "C"),
selected = c("A", "B", "C"))
)
),
# theme styling ####
tags$head(tags$style(HTML('
#checkbox :after, #checkbox :before{
background-color:#bff442;
}'
))))
ui <- dashboardPage(dashboardHeader(title = "Example"),
sidebar,
body
)
server <- function(input, output) {
}
shinyApp(ui, server)
Check out this link: How to change the background color on a input checkbox with css? - you'll have to wrap anything within a tag call from shiny though
You can also change the “primary” colors of awesomeCheckbox inputs by adding this to your css file:
tags$style(".checkbox-bs-primary input[type='checkbox']:checked + label::before,
.checkbox-bs-primary input[type='radio']:checked + label::before {
background-color: #FFBB00;
border-color: #FFBB00;
}
.checkbox-primary input[type='checkbox']:checked + label::before,
.checkbox-primary input[type='radio']:checked + label::before {
background-color: #FFBB00;
border-color: #FFBB00;
}"),
I have a problem with shiny tabs. I want to create a navigation page with two tabs. Right to them, I would like to insert some user's login details. There is no option "text" or other to insert a text in the navbarPage. But I created an additionnal tab instead:
library(shiny)
runApp(list(
ui = navbarPage(
title="My App",
tabPanel("tab1 title"),
tabPanel("tab2 title"),
tabPanel("User: Madzia")),
server = function(input, output) { }
))
It is OK like this, but I do not want the third tab to be "selectible": I want it to be disabled, so that we cannot click on it - the same as on "My App" text. Do you have any idea about how to handle this problem?
Thank you! Best, Madzia
You can achieve disabling a tab with a tiny bit of javascript. I have an example of how to hide a tab (not disable) in recent blog post, you can see the code for that here. I modified that code a bit for disabling instead.
This code is hacky because it was done in 2 minutes but will work for a basic use case
library(shiny)
library(shinyjs)
jscode <- '
shinyjs.init = function() {
$(".nav").on("click", ".disabled", function (e) {
e.preventDefault();
return false;
});
}
'
css <- '
.disabled {
background: #eee !important;
cursor: default !important;
color: black !important;
}
'
shinyApp(
ui = fluidPage(
useShinyjs(),
extendShinyjs(text = jscode, functions = "init"),
tags$style(css),
checkboxInput("foo", "Disable tab2", FALSE),
tabsetPanel(
id = "navbar",
tabPanel(title = "tab1",
value = "tab1",
h1("Tab 1")
),
tabPanel(title = "tab2",
value = "tab2",
h1("Tab 2")
),
tabPanel(title = "tab3",
value = "tab3",
h1("Tab 3")
)
)
),
server = function(input, output) {
observe({
toggleClass(condition = input$foo,
class = "disabled",
selector = "#navbar li a[data-value=tab2]")
})
}
)
Edit I didn't fully read the question when I posted my answer, I just saw that you wanted a way to disable a tab and that was my answer. Your specific usecase (creating a tab only to show the name of a user) is a bit strange, but I suppose this will still work...
I would like to keep my previous answer in existence because it may be useful for someone in the future who wants to know how to disable a tab.
But for this specific problem, disabling the tab is not the correct approach. It makes more sense to simply add text to the tab (as Valter pointed out in a comment). If you look at the documentation for bootstrap, it says you can add text into the navbar by adding an html element with class navbar-text. I experimented with the HTML a little bit to figure out exactly where this needs to be done, and created a little function that will wrap around navbarPage() to allow you to add text to it.
Here's an example:
library(shiny)
navbarPageWithText <- function(..., text) {
navbar <- navbarPage(...)
textEl <- tags$p(class = "navbar-text", text)
navbar[[3]][[1]]$children[[1]] <- htmltools::tagAppendChild(
navbar[[3]][[1]]$children[[1]], textEl)
navbar
}
ui <- navbarPageWithText(
"Test app",
tabPanel("tab1", "tab 1"),
tabPanel("tab2", "tab 2"),
text = "User: Dean"
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
I am using R-3.2.0 hosted on Red Hat Linux version 6.5 with shiny package (version 0.12.0). I am trying to utilize shinydashboard functionality to design a few reports. The RStudio version is 0.98.1103
I have successfully setup ui.R and server.R
ui.R - :
ibrary(shinydashboard)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
dashboardPage(
dashboardHeader(title="Reports",
dropdownMenu(type = "task",
messageItem(
from = "Download",
message = "test",
icon = icon("gear")
),
messageItem(
"Download",
message = "TEST",
icon = icon("life-ring"),
href= "http://www.google.com"
)
)
),
dashboardSidebar(
sidebarMenu(
menuItem("Srts", tabName = "ServiceItems", icon = icon("dashboard"))
)
),
dashboardBody(
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')
)
)
server.R -:
library(shiny)
library(ggplot2)
library(wordcloud)
library(devtools)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)
shinyServer(function(input, output) {
PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
output$PivotTable <- rpivotTable::renderRpivotTable({
rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",
vals="Ar", rendererName="Table")})
tableFirst<-as.data.frame(sort(table(PivotTable$Area),decreasing=TRUE))
})
The following code to enable scrolling in the dashboard body was taken from https://github.com/smartinsightsfromdata/rpivotTable/issues/19 :-
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')
The issue I face is that the code added to help scrolling does not work. I have stripped my code of all tabs , layouts etc but I am still enable to get scrolling to work.
I have observed that if I remove the dashboardPage command, scrolling does work but the display is very awkward and not really presentable.
However, when I combine the codes as follows (in RStudio) and run the scrolling works just fine.
library(shiny)
library(shinydashboard)
library(rpivotTable)
library(ggplot2)
PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
header <- dashboardHeader(title="Reports",
dropdownMenu(type = "task",
messageItem(
from = "Download",
message = "test",
icon = icon("gear")
),
messageItem(
"Download",
message = "TEST",
icon = icon("life-ring"),
href= "http://www.google.com"
)
)
)
sidebar <- dashboardSidebar()
body <- dashboardBody(
tags$head(tags$style(HTML('
.skin-blue.main-header .logo {
background-color: #3c8dbc;
}
.skin-blue .main-header .logo:hover {
background-color: #3c8dbc;
}
'))
),
tags$head(tags$style(type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput("test")
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) {
output$test <- rpivotTable::renderRpivotTable({
rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",vals="Ar", rendererName="Table")})
})
However, I cannot provide this as a final solution because the business users that need this are not adept at copying and pasting code on RStudio (If there is a possible way that I can use the combined code just like the usual one I can consider that as well).
Can someone please help me understand the issue with my original code that prevents scrolling.
Thanks a lot !
The problem is your CSS selector otherwise everything looks OK. Your setting the scroll-property on a element with ID test but I can't find a element with this ID in your example. Try something like this:
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
HTML("
#myScrollBox{
overflow-y: scroll;
overflow-x: hidden;
height:120px;
}
")
)
),
# Boxes need to be put in a row (or column)
fluidRow(
div(id="myScrollBox",
plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
You need to change the CSS selector to the element you want to put the scroll on, in the example this is "myScrollBox".
The only thing which you should be taking in to consideration is to pass the exact same id before CSS code, so in this code replace #test to #PivotTable and bingo... your code should work...
tags$head(tags$style(
type = 'text/css',
'#test{ overflow-x: scroll; }')),
rpivotTableOutput('PivotTable')