I'm having issues aligning two input widgets in Shiny.
Specifically, I can't seem to get a password input and an action button (generated using uiOutput()) to be bottom aligned in the same row.
My current approach offsets the two widgets:
when what I want is:
My code:
library(shiny)
ui <- fluidPage(
fluidRow(
column(width = 4,
passwordInput(inputId = "answer.pass", label = "", value = "",
placeholder = "Enter Password for Answer")
),
column(width = 2, offset = 0,
uiOutput("actionBut.out")
)
)
)
server <- function(input, output) {
output$actionBut.out <- renderUI({
actionButton("copyButton1","Copy Code")
})
}
shinyApp(ui = ui, server = server)
I've come across other SO posts and other sites that seem to have similar problems, but none of their solutions work for my example.
Bottom align a button in R shiny
Shiny R Button Alignment
UI: positioning widgets (UI elements) side by side [Google Groups]
Can anyone suggest a working solution? Thanks!
Related
I having trouble understanding the behavior of renderDataTable function using Shiny.
I am trying to extend the width of one specific column.
When I am not using Shiny, and just trying to visualize the output of the table, I write the below and I get the expected output in the plot (Amazon Title column is extended):
Category <- c("Tools & Home Improvement", "Tools & Home Improvement")
AmazonTitle <- c("0.15,Klein Tools NCVT-2 Non Contact Voltage Tester- Dual Range Pen Voltage Detector for Standard and Low Voltage with 3 m Drop Protection", " ABCDFGEGEEFE")
ASIN_url <- c("<a href='https://www.amazon.com/dp/B004FXJOQO'>https://www.amazon.com/dp/B004FXJOQO</a>", "<a href='https://www.amazon.com/dp/B004FXJOQO'>https://www.amazon.com/dp/B0043XJOQO</a>")
ASIN <- c("B004FXJOQO", "B0043XJOQO")
All_ASIN_Information <- data.frame(Category, AmazonTitle, ASIN_url, ASIN)
DT::datatable(All_ASIN_Information, escape=FALSE,
options = list(
pageLength = 20, autoWidth = TRUE,
columnDefs = list(list( targets = 2, width = '600px'))
)
)
But when I use this exact block inside a DT::renderDataTable function for Shiny, the result is different and the column width is not extended....
See behavior for Shiny with below code:
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
DT::dataTableOutput("Table_ASIN")))
server <- function(input, output){
output$Table_ASIN <- DT::renderDataTable(
DT::datatable(All_ASIN_Information, escape=FALSE,
options = list(
pageLength = 20, autoWidth = TRUE,
columnDefs = list(list( targets = 2, width = '600px'))
)))
}
shinyApp(ui, server)
I don't know if this behavior is caused by the hyperlinks created in column 'ASIN_url' but I would really need them anyway.
Any help much appreciated on this !
One option would be to shorten the link like this:
ASIN_url <- c("<a href='https://www.amazon.com/dp/B004FXJOQO'>Link</a>", "<a href='https://www.amazon.com/dp/B004FXJOQO'>Link</a>")
Another would be to add a scroll bar by including scrollX = TRUE in the option list
I have a simple app that uses verbatimTextOutput to display some texts. I am wondering if it is possible to have the width of verbatimTextOutput to be fixed and have the text output change lines?
Please see this example (https://yuchenw.shinyapps.io/verbatimtext_bookmark/). I also attached the code below.
As the attached screenshot shows, when the string is very long, the verbatimTextOutput would not show all the text. Instead, the verbatimTextOutput would show a scroll bar at the bottom.
However, I hope there will be no scroll bar at the bottom of the verbatimTextOutput. I also need that when the texts are long, change lines to fit in the verbatimTextOutput. Taking the following as an example, which is by clicking the bookmark button. We can see that this lengthy URL change lines, and there is no scroll bar at the bottom of the output. If the bookmark button can do that, I hope I can also make the verbatimTextOutput show similar characteristics and appearance of the bookmark.
Please let me know if you have any questions.
Code
library(shiny)
ui <- function(request){
fluidPage(
column(
width = 6,
textInput(inputId = "txt", label = "Type in some texts",
value = paste0(rep(letters, 10), collapse = "")),
strong("Show the texts"),
verbatimTextOutput("txt_out"),
br(),
bookmarkButton()
)
)
}
server <- function(input, output, session){
output$txt_out <- renderText({
input$txt
})
}
enableBookmarking("url")
shinyApp(ui, server)
Please try the following css:
library(shiny)
ui <- function(request){
fluidPage(
tags$style(type='text/css', '#txt_out {white-space: pre-wrap;}'),
column(
width = 6,
textInput(inputId = "txt", label = "Type in some texts",
value = paste0(rep(letters, 10), collapse = "")),
strong("Show the texts"),
verbatimTextOutput("txt_out"),
br(),
bookmarkButton()
)
)
}
server <- function(input, output, session){
output$txt_out <- renderText({
input$txt
})
}
enableBookmarking("url")
shinyApp(ui, server)
I am using multiple navbars on my shiny dashboard page because I plan to create a conditional filter based on which tab is selected. Can the space between the two nav bars be removed?
Also, can the space reserved for the title be removed? I've seen some similar questions on here but I am pretty bad with CSS, so if someone could show me exactly where I can edit my code, that would be awesome.
Code:
library(shiny)
library(shinydashboard)
library(data.table)
library(dplyr)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(width = 325,
uiOutput("filter")),
dashboardBody(
navbarPage(header="",title=NULL,id="trythis" ,
tabPanel("BigTab1",
navbarPage(title = NULL,id="firstbar",
tabPanel("SubTab1",
dataTableOutput("table1")),
tabPanel("SubTab2"))),
tabPanel("BigTab2",
navbarPage(title=NULL,id="secondbar",
tabPanel("SubTab3",
dataTableOutput("table2")),
tabPanel("SubTab4")))
)
)
)
server <- function(input, output){
output$table1<-renderDataTable({
data<-filter(mtcars,cyl %in% input$test)
data.table(data[,1:2])
},options = list(lengthMenu = c(5, 10, -1), pageLength = 5))
output$table2<-renderDataTable({
data<-filter(mtcars,cyl %in% input$test)
data.table(data[,1:2])
},options = list(lengthMenu = c(5, 10, -1), pageLength = 5))
output$filter<-renderUI({
if(input$trythis=="BigTab1"){
selectInput("test","Test",choices = c("4","6","8"),selected=c("4","6"),multiple = TRUE)
}else{
selectInput("test","Test",choices = c("4","6","8"),multiple = FALSE)
}
})
}
shinyApp(ui = ui, server = server)
I want to remove the red, more worried about the space between the bars than the others, but the title space on the navbar is also pretty bad when you make the window smaller. Thanks in advance for any help!
Please can you help me to add company logo on the left top of shiny dashboard besides project name.
I have tried to use the code in the other answers here on stackoverflow but still can't solve my problem. I am a total ignorant in HTML and css.
Here is my code:
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPage(skin = "green",
dashboardHeader(title = "Project name",
# this could show the logo but not where I wanted !
tags$li(a(href = 'http://www.company.com',
img(src = 'logo.jpg',
title = "Company Home", height = 30px"),
style = "padding-top:10px; padding-bottom:10px;"),
class = "dropdown"))),
dashboardSidebar(),
dashboardBody()
),
server = function(input, output) {}
)
The picture that shows how I want to add the logo
Thank you
It is possible to set an image and text side by side as following.
library(shiny)
library(shinydashboard)
header <- dashboardHeader()
anchor <- tags$a(href='http://www.example.com',
tags$img(src='logo.png', height='60', width='50'),
'project name')
header$children[[2]]$children <- tags$div(
tags$head(tags$style(HTML(".name { background-color: black }"))),
anchor,
class = 'name')
ui <- dashboardPage(header, dashboardSidebar(), dashboardBody())
shinyApp(ui, server = function(input, output, session) {})
I want to put multiple links within a dropdown menu in the header panel, but now I can only create it with a flat horizonal layout through tags$li, while I want a vertical grouped dropdown menu.
A minimal repeatable code is as below, I means I want to put the linkA and linkB under grouplinkAB, and users can open one of them in a new window. It may be achieved with dropdownMenu(type='notifications',...) as in the code, but I do not know where to put the group name of "grouplinkAB", and which can not open a new window when clicking on the link, also I have to hide the text "You have 2 notifications", so I want to achieve it with tags$li and tags$ul, but I have little knowledge on HTML, any help will be appreciated.
library(shinydashboard)
library(shiny)
runApp(
shinyApp(
ui = shinyUI(
dashboardPage(
dashboardHeader(title='Reporting Dashboard',
tags$li(class="dropdown",tags$a("grouplinkAB",href="http://stackoverflow.com/", target="_blank")),
tags$li(class="dropdown",tags$a("linkA",href="http://stackoverflow.com/", target="_blank")),
tags$li(class="dropdown",tags$a("linkB",href="http://stackoverflow.com/", target="_blank")),
dropdownMenu(type='notifications',
notificationItem(text='linkA',href="http://stackoverflow.com/"),
notificationItem(text='linkB',href="http://stackoverflow.com/")
)
),
dashboardSidebar(),
dashboardBody()
)
),
server = function(input, output){}
), launch.browser = TRUE
)
Ok, I saw a similar request about a year ago, but didn't look much deeper. This time I tried to get your code to work and couldn't then I looked at the dropdownMenu code and saw it simply wasn't setup to handle this, but could be modified to do so fairly easily.
I choose not to do that though, instead I created a new version of dropdownMenu specialized to do just this.
Here is the code:
library(shinydashboard)
dropdownHack <- function (...,badgeStatus = NULL, .list = NULL,menuname=NULL)
{
if (!is.null(badgeStatus)){
shinydashboard:::validateStatus(badgeStatus)
}
items <- c(list(...), .list)
lapply(items, shinydashboard:::tagAssert, type = "li")
dropdownClass <- paste0("dropdown ", "text-menu")
numItems <- length(items)
if (is.null(badgeStatus)) {
badge <- NULL
}
else {
badge <- span(class = paste0("label label-", badgeStatus), numItems)
}
tags$li(class = dropdownClass, a( href="#", class="dropdown-toggle",
`data-toggle`="dropdown", menuname, badge),
tags$ul(class = "dropdown-menu", items )
)
}
menuitemHack <- function(text,href){
notificationItem(text=text,href=href,icon=shiny::icon("rocket") )
}
runApp(
shinyApp(
ui = shinyUI(
dashboardPage(
dashboardHeader(title='Reporting Dashboard',
dropdownHack(menuname="GroupAB",
menuitemHack(text='linkA',href="http://stackoverflow.com/"),
menuitemHack(text='linkB',href="http://stackoverflow.com/")
),
dropdownMenu(type='notifications',
notificationItem(text='linkA',href="http://stackoverflow.com/"),
notificationItem(text='linkB',href="http://stackoverflow.com/")
)
),
dashboardSidebar(),
dashboardBody()
)
),
server = function(input, output){}
), launch.browser = TRUE
)
And here is the result:
Notes:
It needs an icon, you can select any fontAwesome or Glyphicons, there is probably a blank one there somewhere if you want to have nothing.
I imagine it will break if the ShinyDashboard structure changes much, so keep that in mind.
Maybe the next version will support this option as well, it would just be a few lines of extra code.