I want to change the name of the photo in front of the photo by changing each photo from the slide.
But using the following codes, the input id is not displayed at all. The codes are as follow
library(shinydashboardPlus)
ui<- dashboardPagePlus(title="Sample",
dashboardHeaderPlus(title="Sample"),
dashboardSidebar(),
dashboardBody(
fluidRow(column(width=6,
carousel(
id = "AA",
carouselItem(
caption = "Image1",
tags$img(src = "https://cdn.sstatic.net/Sites/stackoverflow/company/Img/logos/so/so-logo.svg?v=a010291124bf", height = 400, width = 400, align="center")
),
carouselItem(
caption = "Image2",
tags$img(src = "https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png", height = 400, width = 400, align="center")
))),
column(width=6, uiOutput("Text"))
)
)
)
server<- function(input, output, session) {
output$Text<-renderText({
Text<-input$AA
as.character(Text)
})
}
shinyApp(ui, server) ```
I do see them showing up. It's easier to see if you change the font size and color:
library(shinydashboardPlus)
library(shinydashboard)
ui<- dashboardPagePlus(title="Sample",
dashboardHeaderPlus(title="Sample"),
dashboardSidebar(),
dashboardBody(
htmltools::tags$style(
".carousel-caption{
font-size: 48px;
color: black;
}"
),
fluidRow(column(width=6,
carousel(
id = "AA",
carouselItem(
caption = "Image1",
tags$img(src = "https://cdn.sstatic.net/Sites/stackoverflow/company/Img/logos/so/so-logo.svg?v=a010291124bf", height = 400, width = 400, align="center")
),
carouselItem(
caption = "Image2",
tags$img(src = "https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png", height = 400, width = 400, align="center")
))),
column(width=6, uiOutput("Text"))
)
)
)
server<- function(input, output, session) {
output$Text<-renderText({
Text<-input$AA
as.character(Text)
})
}
shinyApp(ui, server)
As you are using uiOutput, try renderUI on the server side. Also, to show different text in each image, you need to define renderText and output it in carouselItem. Try this code
library(shinydashboardPlus)
library(shinydashboard)
ui<- dashboardPagePlus(title="Sample",
dashboardHeaderPlus(title="Sample"),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(HTML("
#AA{
width:900px;
height:600px;
}
.carousel-control{
color:#FF0000;
}
.carousel-caption{
font-size: 48px;
color: red;}
"))
),
fluidRow(column(width=6,
carousel(
id = "AA",
carouselItem(
caption = "Image1",
textOutput("text1"),
tags$img(src = "https://cdn.sstatic.net/Sites/stackoverflow/company/Img/logos/so/so-logo.svg?v=a010291124bf", height = 400, width = 400, align="center")
),
carouselItem(
caption = "Image2",
textOutput("text2"),
tags$img(src = "https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png", height = 400, width = 400, align="center")
))),
column(width=6, uiOutput("Text"))
)
)
)
server<- function(input, output, session) {
output$Text<-renderUI({
#Text<-as.character(input$AA)
tagList(
p("I like to print something over all images", style = "color:blue")
)
})
output$text1 <- renderText("Print something in image 1")
output$text2 <- renderText("Print something in image 2")
}
shinyApp(ui, server)
Related
I have the following code to build a Shinydashboard app. I'm trying to change the background color in the box on the top of my screen to a custom color (a color hex code color), however the options for the argument background only allow for a set of default colors. Is there a way to change the background color of this box specifically while keeping the white background for the remainder of my boxes?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = 'Dashboard'),
dashboardSidebar(sidebarMenu
(menuItem(tabName = 'Panel1', text = 'Panel 1'),
dateInput("Start_Date", "Start Date", min = '2000-01-01', max = Sys.Date(), value = '2020-01-01',format = "yyyy-mm-dd")
)
),
dashboardBody(
tabItems(tabItem(tabName = 'Panel1',
fluidRow(box(selectizeInput('select_mean', 'Select Number',
choices = c(12,24,36,48,60,120)),height=80,width=4,
background = 'black')),
fluidRow(box(width = 13, height = 655))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
You can use htmltools::tagQuery to add a style:
library(htmltools)
library(shinydashboard)
library(shiny)
b <- box(selectInput("id", "label", c("a", "b", "c")))
b <- tagQuery(b)$find(".box")$addAttrs(style = "background-color: pink;")$allTags()
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(b)
)
server <- function(input, output, session) {}
shinyApp(ui, server)
You can do the following steps :
put your box into a tags$div and give it an ID (here : "toto")
add some CSS to the box, which is two div childs after your div toto
You can also put the CSS in a separate file, see https://shiny.rstudio.com/articles/css.html
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = 'Dashboard'),
dashboardSidebar(sidebarMenu
(menuItem(tabName = 'Panel1', text = 'Panel 1'),
dateInput("Start_Date", "Start Date", min = '2000-01-01', max = Sys.Date(), value = '2020-01-01',format = "yyyy-mm-dd")
)
),
dashboardBody(
tags$head(
tags$style(HTML("
#toto > div:nth-child(1) > div:nth-child(1) {
background-color: rgb(128, 0, 0);
}"))),
tabItems(tabItem(tabName = 'Panel1',
fluidRow(
tags$div(
id = "toto",
box(selectizeInput('select_mean', 'Select Number',
choices = c(12,24,36,48,60,120)),height=80,width=4)
)
),
fluidRow(box(width = 13, height = 655))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
I am trying to change the color tone of the login page from the shinymanager package.
I have seen these posts:
Change Text and Colors in Shinymanager Login Page
Change the color tone of a shinytheme
How to style shimymanager login screen with CSS only?
How to modify the themes of shinythemes?
However, since I don't know much about CSS, I am struggling with this.
This is a reproducible example:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinymanager)
credentials <- data.frame(
user = c("shiny"),
password = c("shiny"),
stringsAsFactors = FALSE
)
css <- HTML(" body {
background-color: #0dc5c1;
}")
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("App1", tabName = "App1", icon = icon("th"))
)
),
dashboardBody(
fluidRow(
tabItems(
tabItem(tabName = "App1",
sidebarPanel(
numericInput("num",
"Select a number",
min = 1,
value = 10),
sliderInput("slider1",
"Number of bins:",
min = 1,
max = 50,
value = 30),
checkboxInput("remove", "Remove...", value = FALSE),
),
mainPanel(
verbatimTextOutput("value"),
plotOutput("plot1"),
)
)
)
)
)
)
ui <- secure_app(ui,
# changing theme for the credentials
theme = shinythemes::shinytheme("united"),
tags_top = tags$div(
tags$head(tags$style(css)),
tags$img(
src = "https://marketplace.egi.eu/101-large_default/the-r-project-for-statistical-computing.jpg", width = 200, height = 200, alt="Logo not found", deleteFile=FALSE
))
)
server <- function(input, output, session) {
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
}
shinyApp(ui, server)
My objective is to change the colour of the login page to the following tone #0dc5c1, in particular the border and the button of the page.
I tried adding:
css <- HTML(" body {
background-color: #0dc5c1;
}")
But it doesn't work.
Does anyone know how to solve it?
Thanks very much in advance
Please check the following:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinymanager)
credentials <- data.frame(
user = c("shiny"),
password = c("shiny"),
stringsAsFactors = FALSE
)
css <- HTML(".btn-primary {
color: #ffffff;
background-color: #0dc5c1;
border-color: #0dc5c1;
}
.panel-primary {
border-color: #0dc5c1;
}")
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("App1", tabName = "App1", icon = icon("th"))
)
),
dashboardBody(
fluidRow(
tabItems(
tabItem(tabName = "App1",
sidebarPanel(
numericInput("num",
"Select a number",
min = 1,
value = 10),
sliderInput("slider1",
"Number of bins:",
min = 1,
max = 50,
value = 30),
checkboxInput("remove", "Remove...", value = FALSE),
),
mainPanel(
verbatimTextOutput("value"),
plotOutput("plot1"),
)
)
)
)
)
)
ui <- secure_app(ui,
# changing theme for the credentials
theme = shinythemes::shinytheme("united"),
tags_top = tags$div(
tags$head(tags$style(css)),
tags$img(
src = "https://marketplace.egi.eu/101-large_default/the-r-project-for-statistical-computing.jpg", width = 200, height = 200, alt="Logo not found", deleteFile=FALSE
))
)
server <- function(input, output, session) {
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
}
shinyApp(ui, server)
I modified the CSS.
ui <- secure_app(ui,
# changing theme for the credentials
theme = shinythemes::shinytheme("united"),
tags_top = tags$div(
tags$head(
tags$style(
".row {
background-color: #0dc5c1;"
),
tags$style(
".panel-body {
background-color: #0dc5c1;"
),
tags$style(
".panel-auth {
background-color: #0dc5c1;"
)
),
tags$img(
src = "https://marketplace.egi.eu/101-large_default/the-r-project-for-statistical-computing.jpg", width = 200, height = 200, alt="Logo not found", deleteFile=FALSE
))
)
I am not sure where exactly the background color should be changed. If it's too much, just remove some of the CSS.
I wish to center a small form below a table that is also centered.
I center the table using, fluidRow and column like so:
fluidRow(
column(12, align="center", reactableOutput("table")),
),
If I do the same with the form, each component of the form becomes centered in the page which is wrong. How do I center a correct looking form beneath the centered table?
Example Code
library(shiny)
library(reactable)
ui <- fluidPage(
fluidRow(
column(12, align="center", reactableOutput("table")),
),
fluidRow(
column(12,
div(id = "form",
textInput("email", "Email", width = "250px", placeholder = "joe#example.com"),
radioButtons(inputId = "pref",
label ="Here's a label:",
choiceNames = list(
"First choice",
"Second choice"),
choiceValues = list(
"v1", "v2"
)),
actionButton("submit", "Enter", class = "btn-primary", width = 250,
style="color: #FFF; background-color: #132EBA;"),
)
)
)
)
server <- function(input, output, session) {
output$table <- renderReactable({
reactable(iris,
fullWidth = FALSE)
})
observeEvent(input$submit, {
# Do something!
})
}
shinyApp(ui, server)
You need to create 2 div elements and give them CSS properties :
first one is centered
second one is an inline-block and aligned left
Source : CSS: Center block, but align contents to the left
So it gives
library(shiny)
library(reactable)
ui <- fluidPage(
fluidRow(
column(12, align="center", reactableOutput("table")),
),
fluidRow(
column(12,
div(id = "form",
style = "text-align: center;",
div(
id = "form_content",
style = "display:inline-block; text-align: left;",
textInput("email", "Email", width = "250px", placeholder = "joe#example.com"),
radioButtons(inputId = "pref",
label ="Here's a label:",
choiceNames = list(
"First choice",
"Second choice"),
choiceValues = list(
"v1", "v2"
)),
actionButton("submit", "Enter", class = "btn-primary", width = 250,
style="color: #FFF; background-color: #132EBA;")
)
)
)
)
)
server <- function(input, output, session) {
output$table <- renderReactable({
reactable(iris,
fullWidth = FALSE)
})
observeEvent(input$submit, {
# Do something!
})
}
shinyApp(ui, server)
I am currently developing a dashboard. I need to place the logo at the either side of the title. The expected output is:
But the output which I am getting is
The code used is as follows:
Ui.r
library(shiny)
shinyUI(
fluidPage(
titlePanel(
fluidRow(
column(3, img(height = 50, width = 30, src = "favicon.png")),
column(9, "DDIM Use case Dashboard"),
column(2, img(height = 50, width = 30, src = "favicon.png"))
)
)
)
)
Server.r
shinyServer(function(input, output, session) {
})
Can anyone help me with this issue? Thanks in advance!!
You could do something like this:
library(shiny)
ui <- shinyUI(
fluidPage(
titlePanel(
fluidRow(
column(3, img(height = 50, width = 30, src = "https://upload.wikimedia.org/wikipedia/commons/thumb/1/1b/R_logo.svg/32px-R_logo.svg.png")),
column(8, "DDIM Use case Dashboard"),
column(1, img(height = 50, width = 30, src = "https://upload.wikimedia.org/wikipedia/commons/thumb/1/1b/R_logo.svg/32px-R_logo.svg.png"))
)
)
)
)
server <- shinyServer(function(input, output, session) {
})
shinyApp(ui, server)
which would give you an output that looks like this:
Hope it helps!
[EDIT]:
With a little css as shown below you can get amazing outputs:
library(shiny)
ui <- shinyUI(
fluidPage(
tags$head(tags$style(".header{background-color:black}
#title{
color: white;
text-align: center;
} ")),
tags$div(class="header",
titlePanel(
fluidRow(
column(3, img(height = 50, width = 30, src = "https://upload.wikimedia.org/wikipedia/commons/thumb/1/1b/R_logo.svg/32px-R_logo.svg.png")),
column(6, tags$div(id="title","DDIM Use case Dashboard")),
column(2),
column(1, img(height = 50, width = 30, src = "https://upload.wikimedia.org/wikipedia/commons/thumb/1/1b/R_logo.svg/32px-R_logo.svg.png"))
)
)
)
)
)
server <- shinyServer(function(input, output, session) {
})
shinyApp(ui, server)
The output you get is:
I have several boxes that will be filled with plots and tables after user input.
Since I have changed the layout to be column-based, the background color seem to be cut under the first box like this:
I am not sure why is this happening.
Here is a sample code to reproduce the layout:
library(shiny)
library(shinydashboard)
sidebar <- dashboardSidebar(
sidebarMenu(
busyIndicator(text="Loading..."),
tags$head(
tags$style(
HTML('
#uploadfile{height: 25px}
#rat{height: 25px; font-size: 10px}
#pnum{height: 25px; font-size: 10px}
#mytext{width: 50px}
.content-wrapper,
.right-side {
background-color: #EBE5D0;
}
li { cursor: pointer; cursor: hand; }
')
)
),
menuItem("Network", icon = icon("table"), tabName = "network", badgeColor = "green")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "network",
column( width = 2,
box(
title="INPUT FILES",solidHeader = TRUE, status="primary",
fileInput('file1',"file 1", multiple=F,accep=".Rdata"),
fileInput('file2',"file 2", multiple=F,accep=".Rdata"),
fileInput('file3',"file 3", multiple=F,accep=".Rdata"),
fileInput('file4',"file 4", multiple=F,accep=".Rdata"),
uiOutput("phenoselect"),
uiOutput("phenolog"),
tags$div(align = 'left',
class = 'multicol', uiOutput("covarselect")),
uiOutput("snpPlotButton"),
height = 800,
width = NULL
)
),
column(width = 8,
box(
title="PLOT",solidHeader = TRUE, status="primary",
plotOutput('plotSNPmaf',height="500px"),
height = 800,
width = NULL
),
box(
title="TABLE",solidHeader = TRUE, status="primary",
dataTableOutput("seqMetaGene"),
uiOutput("BoxPlotButton"),
width = NULL
),
box(
title="BOXPLOT",solidHeader = TRUE, status="primary",
plotOutput("boxplotSnps"),
width = NULL
)
)
)
))
ui<- dashboardPage(
dashboardHeader(title = "Results"),
sidebar,
body
)
server <- function(input, output,session) {}
shinyApp(ui = ui, server = server)
You need to wrap your columns in a fluidRow, this way it will work.
Like this:
fluidRow(column( ... ),
column( ... ))
Screenshot of the working example:
Using this code you can set the background color. You just have to find the color that matches.
dashboardBody(
tags$head(tags$style(HTML('
.skin-blue .left-side, .skin-blue .wrapper {
background-color: #ecf0f5;
}
')))