I have the following code that makes a simple shiny app. My goal is to make the image/logo bigger and push the sidebar menu down a little bit.
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = tags$img(src='https://cdn.vox-cdn.com/thumbor/Ous3VQj1sn4tvb3H13rIu8eGoZs=/0x0:2012x1341/1400x788/filters:focal(0x0:2012x1341):format(jpeg)/cdn.vox-cdn.com/uploads/chorus_image/image/47070706/google2.0.0.jpg', height = '60', width ='100')),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody()
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Overview", icon = icon("tachometer"))
)
})
}
shinyApp(ui, server)
This code above yields the following output.
My desired output this something like this where the image is bigger.
Although if I try editing the width/height directly on the tags$img() it will make the image larger but it becomes cut off as seen below.
ui <- dashboardPage(
dashboardHeader(title = tags$img(src='https://cdn.vox-cdn.com/thumbor/Ous3VQj1sn4tvb3H13rIu8eGoZs=/0x0:2012x1341/1400x788/filters:focal(0x0:2012x1341):format(jpeg)/cdn.vox-cdn.com/uploads/chorus_image/image/47070706/google2.0.0.jpg',
height = '120', width ='200')),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody()
)
You can add css elements to override the default css from library(shiny)
https://shiny.rstudio.com/articles/html-tags.html
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = tags$img(src='https://cdn.vox-cdn.com/thumbor/Ous3VQj1sn4tvb3H13rIu8eGoZs=/0x0:2012x1341/1400x788/filters:focal(0x0:2012x1341):format(jpeg)/cdn.vox-cdn.com/uploads/chorus_image/image/47070706/google2.0.0.jpg', height = '120px', width ='200px')),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
tags$head(
tags$style(".skin-blue .main-header .logo {
color: #fff;
border-bottom: 0 solid transparent;
height: 125px;
}"),
tags$style(".skin-blue .sidebar a {
color: #b8c7ce;
padding-top: 50%;
}"),
tags$style(".main-header .navbar{
max-height: 10px;")
)
)
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Overview", icon = icon("tachometer-alt"))
)
})
}
shinyApp(ui, server)
Related
Having this basic shiny app:
I would like to position my title in the header like indicated in red in the image below:
There are already some solutions Add text on right of shinydashboard header
but I am wondering if there is a more "straight" way?
The solution by #matrixloading is appealing but not satisfactory because of the dot in front of the text:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(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)
We can append a child element inside de nav element of the dashboardHeader.
dashboardHeader(title = "Basic dashboard") |>
tagAppendChild(
div(
"This is My Title",
style = "
display: block;
font-size: 1.5em;
margin-block-start: 0.5em;
font-weight: bold;
color: darkred;
margin-right: 50%",
align = "right"
),
.cssSelector = "nav"
)
The CSS text-align property can be used to centre the title. I have used the title argument of the titlePanel function to adjust the code.
Here is the code for the adjustment:
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
titlePanel(title = tags$h2(
tags$b("Title for the Basic Dashboard"),
tags$style(HTML("h2 { text-align: center; }"))
)
),
fluidRow(
box(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)
In the code at the bottom, I successfully justify-align the bullet-point text in the popover when hovering over the information circle. However, I still can't figure out how to justify-align its header immediately above as shown in this image. If I remove the ul from the line tags$style('.popover ul {padding: 15px; text-align: justify;}'), everthing is justified but I lose all other desired formatting. How would I modify this code so I can cleanly justify that header paragraph too?
Code:
library(shiny)
library(shinyBS)
ui <- fluidPage(
tags$style('.popover ul {padding: 15px; text-align: justify;}'),
br(),
uiOutput("uiExample")
)
server <- function(input, output, session) {
output$uiExample <- renderUI({
tagList(
tags$span("Little circle >>"),
tags$span(
popify(
icon("info-circle", verify_fa = FALSE),
"Placeholder",
paste(
"Here is an excerpt from a famous poem Still I Rise:",
"<ul>",
"<li>You may write me down in history With your bitter, twisted lies,</li>",
"<li>You may tread me in the very dirt. But still, like dust, I will rise.",
"Does my sassiness upset you...</li>",
"</ul>"
)
)
)
)
})
}
shinyApp(ui, server)
You can add this to your CSS:
'.popover-content {text-align: justify;}'
library(shiny)
library(shinyBS)
ui <- fluidPage(
tags$style('.popover ul {padding: 15px; text-align: justify;}',
'.popover-content {text-align: justify;}'),
br(),
uiOutput("uiExample")
)
server <- function(input, output, session) {
output$uiExample <- renderUI({
tagList(
tags$span("Little circle >>"),
tags$span(
popify(
icon("info-circle", verify_fa = FALSE),
"Placeholder",
paste(
"Here is an excerpt from a famous poem Still I Rise:",
"<ul>",
"<li>You may write me down in history With your bitter, twisted lies,</li>",
"<li>You may tread me in the very dirt. But still, like dust, I will rise.",
"Does my sassiness upset you...</li>",
"</ul>"
)
)
)
)
})
}
shinyApp(ui, server)
Is it possible to move the logo in the header completely to the right side?
I have attached a pic how I would like it to look like.
here is a MWE
logo to the right
library(shiny)
library(shinydashboard)
ui <- function(){
dashboardPage(
dashboardHeader(title = tags$a(href = 'https://google.com',
tags$img(src = 'https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png', height= 50,width= 50, align = "right"),
'Title')),
dashboardSidebar( sidebarMenu(id="side", menuItem("Option1", tabName="op1"),
menuItem("Option2", tabName="op2"))
),
body=dashboardBody())}
server <- function(input, output, session) {}
shinyApp(ui, server)
You could wrap it in a li wrapper of class dropdown. Try this
library(shiny)
library(shinydashboard)
ui <- function(){
dashboardPage(
dashboardHeader(
title = "Demo",
tags$li(class = "dropdown",
tags$a(href = 'https://google.com',
tags$img(src = 'https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png', height= 50,width= 50, align = "right")
)
),
dropdownMenuOutput('messageMenu')
),
dashboardSidebar( sidebarMenu(id="side", menuItem("Option1", tabName="op1"),
menuItem("Option2", tabName="op2"))
),
body=dashboardBody())}
server <- function(input, output, session) {}
shinyApp(ui, server)
I want to fit Resource Activity text within the given button such that Activity comes below the Resource in the button. Currently the complete word gets hidden because of less space of the button and I do not want to increase the space. Please help.
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton("buttonresinvthree", "Resource Activity",style="color:
#000000; width:8%; ")
)
)
server <- function(input, output) { }
shinyApp(ui, server)
The following works for me:
## app.R ##
library(shiny)
library(shinydashboard)
library(tableHTML)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(make_css(list('.btn', 'white-space', 'pre-wrap')))),
actionButton("buttonresinvthree", HTML("Resource\nActivity"),
style="color: #000000; width:8%; ")
)
)
server <- function(input, output) { }
shinyApp(ui, server)
I added tags$head... to add CSS to the button (class btn) and used \n for the break line between Resource\nActivity.
The result looks like this:
Set white-space to normal:
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
actionButton("buttonresinvthree", "Resource Activity",style="color:
#000000; width:8%;white-space:normal;font-size:.8vw;")
)
)
server <- function(input, output) { }
shinyApp(ui, server)
library(shiny)
library(shinydashboard)
filetime <- format(file.mtime("mydata.csv"), format = "%a %e-%b-%Y %r IST")
ui <- dashboardPage(
dashboardHeader(title = "Recruitment"),
dashboardSidebar(),
dashboardBody(
shinyUI(fluidPage(
box(verbatimTextOutput("final_text"), status = "primary", solidHeader = TRUE, collapsible = TRUE, width = 12, title = "Collapsable text")
))))
server <- shinyServer(function(input, output, session) {
output$final_text <- renderText({
HTML(paste("<center>","Last updated at", filetime, "</center>")) #"<font size=\"2\">",
})
}
In the above code the Last updated at and filetime are not getting center aligned, upon further research I found that center tag does not work on HTML5, not sure if that's causing the problem.
As a workaround, I added a div and class to center align the text via css, here is my 2nd attempt.
#Next to fluidPage
tags$style(HTML(".man_made_class{color:#f2f205; text-align: center;}")),
#Then further in Output
output$final_text <- renderText({
HTML(paste("<div class= man_made_class>","Last updated at", filetime, "</div>")) #"<font size=\"2\">",
})
In both my attepmt, I am able to change color, font size, margin etc, but not able to center align the text. Any help?
You don't need to add custom class, as the textOutput already has a unique id final_text. Working example:
library(shiny)
library(shinydashboard)
filetime <- format(file.mtime("mydata.csv"), format = "%a %e-%b-%Y %r IST")
ui <- dashboardPage(
dashboardHeader(title = "Recruitment"),
dashboardSidebar(),
dashboardBody(
shinyUI(fluidPage(
tags$head(tags$style(HTML("
#final_text {
text-align: center;
}
div.box-header {
text-align: center;
}
"))),
box(verbatimTextOutput("final_text"), status = "primary", solidHeader = TRUE, collapsible = TRUE, width = 12, title = "Collapsable text")
))))
server <- shinyServer(function(input, output, session) {
output$final_text <- renderText({
HTML(paste("Last updated at", filetime))
})
})
shinyApp(ui = ui, server = server)
Do this to changes to ui.R and server.R help?
ui.R
library(shiny)
library(shinydashboard)
#filetime <- format(file.mtime("mydata.csv"), format = "%a %e-%b-%Y %r IST")
ui <- dashboardPage(
dashboardHeader(title = "Recruitment"),
dashboardSidebar(),
dashboardBody(
shinyUI(fluidPage(
tags$style(HTML(".man_made_class{color:#f2f205; text-align: center;}")),
box(htmlOutput("final_text"), status = "primary", solidHeader = TRUE, collapsible = TRUE, width = 12, title = "Collapsable text")
))))
server.R
server <- shinyServer(function(input, output, session) {
output$final_text <- renderText({
"<div class= man_made_class>Last updated at xxxx</div>"
})
})