I am trying to vertically align an image in the second column of a tabPanel in Shiny. I have managed to align it horizontally (using align="center"), but cannot align it vertically without inserting several br(). I highly suspect there must be a more elegant solution to do this. An example of my code is below (br()'s not included). Any suggestions would be appreciated. Thanks in advance for your help!
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot",
column(width = 6,
plotOutput("plot")),
column(width = 6, align="center",
img(src = "image.jpg", height=140, width=140),
)),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
A not so great solution that greatly reduces the br() congestion:
library(shiny)
library(purrr)
n_br <- 17
ui <- fluidPage(
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot",
column(width = 6,
plotOutput("plot")),
column(width = 6, align="center",
map(1:n_br, ~br()), #add n number of br()
img(src = "image.jpg", height=140, width=140),
)),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
))
server <- function(input, output, session) {
}
shinyApp(ui, server)
Edit:
Following this tutorial and using shiny's tags function:
library(shiny)
library(tidyverse)
ui <- fluidPage(
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot",
column(width = 6,
plotOutput("plot")),
column(width = 6, align = "center",
tags$style(HTML('
.verticalcenter {
display: table-cell;
height: 400px;
vertical-align: middle;
}')),
tags$div(class = "verticalcenter", img(src = "image.png", height = "140px", width = "140px"))
)),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
))
server <- function(input, output, session) {
output$plot <- renderPlot(plot(iris$Sepal.Length, iris$Petal.Length))
}
shinyApp(ui, server)
Related
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 have an app where the user will generate a bunch of selectizeInputs along with 3 numericInputs for every selectizeInput. The problem I am having is that the selectizeInput does not align well with the numericInputs and once you have about 10 rows, the alignment is completely gone.
I have thought of two ways of solving this problem:
create one renderUI function and include fluidRows in a loop but some searching has led me to believe that isnt possible.
Height adjust the selectizeInput with using tags$style(type = "text/css", ".form-control.shiny-bound-input, .selectize-input {height: 46px;}"), but I dont want to adjust the selectizeInput height universally as the app has selectizeInputs elsewhere.
I can't really hardcode the input name with tags$style(type = "text/css", "#some_id.form-control.shiny-bound-input {height: 46px;}") since the names are dynamically generated by the user.
Will one of these two options work? If not is there a third option?
I have made a demo version of the problem below.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width = 3, br(),br(),br(),br(),br(),br(),br(), h6("something else is here")),
mainPanel(
tabsetPanel(
tabPanel("Problem tab",
br(),
numericInput("inputs_num","Enter Number of Channels to Calibrate", min = 1, value = 10),
hr(),
br(),
fluidRow(
column(width= 3,uiOutput("colname")),
column(width =3, uiOutput("initial_numeric")),
column(width =3, uiOutput("min_numeric")),
column(width =3, uiOutput("max_numeric"))
),
hr()
)
)
)
)
)
server <- function(input, output, server){
output$colname <- renderUI({
req(input$inputs_num)
columns <- colnames(mtcars)
tags <- tagList()
for(i in 1:input$inputs_num){
tags[[i]] = selectizeInput(paste0("colname_",i), paste0("Column ",i), choices = columns, selected = NULL,
options = list(
placeholder = "Enter Column Name",
onInitialize = I('function() { this.setValue(""); }')
))
}
tags
})
output$initial_numeric <- renderUI({
req(input$inputs_num)
tags <- tagList()
for (i in 1:input$inputs_num){
tags[[i]] <- numericInput(paste0("initial_",i), paste("Initial",i), min = 0,value = 1)
}
tags
})
output$min_numeric <- renderUI({
req(input$inputs_num)
tags <- tagList()
for (i in 1:input$inputs_num){
tags[[i]] <- numericInput(paste0("min_",i), paste("Min",i), min = 0,value = 1)
}
tags
})
output$max_numeric <- renderUI({
req(input$inputs_num)
tags <- tagList()
for (i in 1:input$inputs_num){
tags[[i]] <- numericInput(paste0("max_",i), paste("Max",i), min = 0,value = 1)
}
tags
})
}
shinyApp(ui, server)
In Safari everything was aligned fine, and only in Firefox it became visible. I tried wrapping everything in one loop and it seems to work fine, even in Firefox.
So the approach below should correspond to solution 1. Since solution 2 (changing the css of the input universally) is not an option, another approach would be to define custom inputs by wrapping the original inputs in a tag and adding an additional class which can then be targeted in css. But I think that this not necessary, since the approach below works.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(width = 3, br(),br(),br(),br(),br(),br(),br(), h6("something else is here")),
mainPanel(
tabsetPanel(
tabPanel("Problem tab",
br(),
numericInput("inputs_num","Enter Number of Channels to Calibrate", min = 1, value = 10),
hr(),
br(),
uiOutput("all"),
hr()
)
)
)
)
)
server <- function(input, output, server){
output$all <- renderUI({
req(input$inputs_num)
columns <- colnames(mtcars)
tags <- tagList()
for(i in 1:input$inputs_num){
tags[[i]] <- fluidRow(
column(width= 3,
selectizeInput(paste0("colname_",i), paste0("Column ",i), choices = columns, selected = NULL,
options = list(
placeholder = "Enter Column Name",
onInitialize = I('function() { this.setValue(""); }')
))),
column(width= 3,
numericInput(paste0("initial_",i), paste("Initial",i), min = 0,value = 1)),
column(width= 3,
numericInput(paste0("min_",i), paste("Min",i), min = 0,value = 1)),
column(width= 3,
numericInput(paste0("max_",i), paste("Max",i), min = 0,value = 1))
)
}
tags
})
}
shinyApp(ui, server)
The app below contains a fileInput and actionButton. I would like to vertically align the two elements so that the actionButton lines up with the Browse button of the fileInput. In addition to the code included below, I also tried display:flex and align-items:center; as well as fluidRow(column(width = 9, ...), column(width = 3, ...)) to no avail. I'm not sure what I'm missing and any help would be much appreciated.
Here is the app:
library(shiny)
library(shinydashboard)
# UI ----------------------------------------------------------------------
ui = fluidPage(
tagList(
box(
width = 5,
tags$div(style = "display:inline-block; width:75%;",
fileInput(
inputId = 'file',
label = 'Select file:',
accept = c('.txt', '.csv', '.xls', '.xlsx', '.rds', '.dta', '.sas7bdat', '.sav')
)
),
tags$div(style = "display:inline-block; width:20%;",
div(class = 'pull-right',
actionButton('upload', 'Upload')
)
)
)
)
)
# SERVER ------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {})
shinyApp(ui, server)
The result:
The following dashboard page consists of action buttons aligned to the left and the plot and two more zoom and reset buttons. I want to position the box at the center of the screen and zoom and reset buttons to the extreme top-right. Rest all buttons are fine. I tried to use tags$div but no help. Please help and big thanks in advance.
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "My Dashboard"),
dashboardSidebar(
width = 0
),
dashboardBody(
tags$br(actionButton("go", "Log")),
tags$br(),
tags$br(actionButton("go", "Case")),
tags$br(),
tags$br(actionButton("go", "Resource")),
tags$br(),
tags$br(actionButton("go", "Activity")),
tags$br(),
tags$br(actionButton("go", "Resource-activity")),
box(),
tags$br(actionButton("go", "Zoom")),
tags$br(actionButton("go", "Reset"))
))
server <- function(input, output)
{
}
shinyApp(ui, server)
You could play with fluidRow and column:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "My Dashboard"),
dashboardSidebar(
width = 0
),
dashboardBody(
fluidRow(
column(2, offset = 1,
actionButton("go", "Log")
),
column(2, offset = 7,
actionButton("go", "Zoom")
)
),
fluidRow(
column(2, offset = 1,
actionButton("go", "Case")
),
column(2, offset = 7,
actionButton("go", "Reset")
)
),
fluidRow(
column(2, offset = 1,
actionButton("go", "Resource")
),
column(8, offset = 1,
box()
)
),
fluidRow(
column(2, offset = 1,
actionButton("go", "Activity")
)
),
fluidRow(
column(2, offset = 1,
actionButton("go", "Resource-activity")
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
But there might be better alternatives.
Something like this do?
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "My Dashboard"),
dashboardSidebar(
width = 0
),
dashboardBody(
fluidRow(
column(1,
tags$br(actionButton("go", "Log")),
tags$br(),
tags$br(actionButton("go1", "Case")),
tags$br(),
tags$br(actionButton("go2", "Resource")),
tags$br(),
tags$br(actionButton("go3", "Activity")),
tags$br(),
tags$br(actionButton("go4", "Resource-activity"))),
br(),
column(10,
box(width=12,plotOutput("plot"))),
column(1,
tags$br(actionButton("go5", "Zoom")),
tags$br(),
tags$br(actionButton("go6", "Reset"))))
))
server <- function(input, output){
output$plot <- renderPlot(hist(mtcars$disp))
}
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>"
})
})