I have a simple shiny app which diplays three colourInput() buttons. I would to reduce the blank space between every button and its title in order to be closer to it.
#ui.r
library(shiny)
library(shinydashboard)
shinyUI( dashboardPage(
dashboardHeader(
title="Styling Download Button"
),
dashboardSidebar(
div(style="display: inline-block;vertical-align:top; width: 115px;",colourInput("rightcolor",h5("Left"), value = "#00B2EE")),
div(style="display: inline-block;vertical-align:top; width: 115px;",colourInput("overlapcolor",h5("Overlap"), value = "#7CCD7C")),
div(style="display: inline-block;vertical-align:top; width: 115px;",colourInput("leftcolor",h5("Right"), value = "#FFFACD")),
),
dashboardBody()
))
#server.r
shinyServer(function(input, output) {
})
You have to change the div elements in which the titles are displayed. One way to do this is by adding the style argument to the h5 function. If you reduce the margin to 0 pixels by adding style='margin: 0px' you get the result that you want (you can also use: margin-top, margin-bottom, etc.).
If you want to adapt other Shiny widgets you can always wrap them in a div and adapt them with the style argument (example: div(style='margin: 0px; padding: 15px;', selectInput(...))). Information on other div arguments can be found here.
Your example
library(shiny)
library(shinydashboard)
library(colourpicker)
# Create ui
ui <- shinyUI( dashboardPage(
dashboardHeader(
title="Styling Download Button"),
dashboardSidebar(
div(style="display: inline-block;vertical-align:top; width: 115px;",colourInput("rightcolor",h5("Left", style='margin: 0px;'), value = "#00B2EE")),
div(style="display: inline-block;vertical-align:top; width: 115px;",colourInput("overlapcolor",h5("Overlap", style='margin: 0px;'), value = "#7CCD7C")),
div(style="display: inline-block;vertical-align:top; width: 115px;",colourInput("leftcolor",h5("Right", style='margin: 0px;'), value = "#FFFACD"))),
dashboardBody()
))
# Create Server
server <- shinyServer(function(input, output) {})
# Run app
shinyApp(ui, server)
Related
I'm building out a datatable in R Shiny and part of it will include tooltips unique to each cell. I've accomplished that, however, I seem to be unable to insert HTML content into the tooltip itself. In the example below, I'm inserting HTML content into a cell in the datatable, and then aim to insert that same content into a tooltip, but the HTML only renders in the datatable, and not in the tooltip.
I've played around with a few ideas but can't find any that work. I can get the HTML to appear (as text) in the tooltip by removing the HTML function, but then, obviously, it's escaped and is just text. I am able to bold text within the tooltip using tags$b(), however, I am hoping for a solution more similar to my example below as I have more complex HTML content I would like add to the tooltip beyond just text.
Any ideas? Thanks very much!
library(shiny)
library(shinyBS)
library(DT)
ui <- fluidPage(
bsTooltip('tbutton',''),
mainPanel(dataTableOutput('df'))
)
server <- function(input, output) {
df <- data.frame(A = c(1:5), B = c(LETTERS[1:5]))
output$df <- renderDataTable({
cell <- paste0('<svg width="30" height="30">',
'<text x="1%" y="75%" font-weight="bold" font-size="16" >B</text>',
'</svg>')
df[2,2] <- as.character(popify(tags$div(HTML(cell)),
title = 'Tooltip:',
placement = 'left',
content = paste0(tags$div(HTML(cell))),
trigger = c('hover', 'click')))
datatable(df, escape=FALSE)
})
}
shinyApp(ui = ui, server = server)
To attach a popover to a cell, you can use bsPopover if this cell has an id. To set an id to the cells, you can use the datatables option createdCell.
Then the HTML code works in the popover content, but not the SVG (or at least I didn't manage to make it work).
library(shiny)
library(shinyBS)
library(DT)
df <- data.frame(A = 1:5, B = LETTERS[1:5])
css <- "
.red {color: red;}
"
ui <- fluidPage(
tags$head(tags$style(HTML(css))),
mainPanel(
DTOutput('df'),
bsPopover(
id = "id2",
title = "test",
content = '<p class="red">TEST</p>'
)
)
)
server <- function(input, output) {
output$df <- renderDT({
datatable(
df,
options = list(
columnDefs = list(
list(
targets = 2,
createdCell = JS(
"function (td, cellData, rowData, row, col) {",
" $(td).attr('id', 'id' + (row+1));",
"}"
)
)
)
)
)
})
}
shinyApp(ui = ui, server = server)
How would one go about setting the background color of multiple fileInput() progress bars in one fluidRow(). This is similar to the answer given here, however, this time it's just for multiple fileInput() objects. I want to do something like snippet below, but when I run this, instead of having the three individual colors, they are all the same color (#cfa646). (Disclaimer, my html knowledge is non-existent, so I just wanted to demonstrate the concept with the given snippet.)
library(shiny)
ui <- fluidPage(
fluidRow(column(4,
tags$head(tags$style(".progress-bar{background-color:#3c763d;}")),
fileInput("dataUpload_1","Label 1",width = "400px")),
column(4,
tags$head(tags$style(".progress-bar{background-color:#bf37a4;}")),
fileInput("dataUpload_2","Label 2",width = "400px")),
column(4,
tags$head(tags$style(".progress-bar{background-color:#cfa646;}")),
fileInput("dataUpload_3","Label 3",width = "400px")))
)
server <- function(input, output){
}
shinyApp(ui=ui, server=server)
Nice try, you are close, but as you mentioned, this does require some advanced CSS knowledge. Here is how:
:nth-of-type() selector
library(shiny)
ui <- fluidPage(
tags$head(tags$style(
'
.myfiles .col-sm-4:nth-of-type(1) .progress-bar {background-color:#3c763d;}
.myfiles .col-sm-4:nth-of-type(2) .progress-bar {background-color:#bf37a4;}
.myfiles .col-sm-4:nth-of-type(3) .progress-bar {background-color:#cfa646;}
'
)),
fluidRow(
class = "myfiles",
column(4, fileInput("dataUpload_1","Label 1",width = "400px")),
column(4, fileInput("dataUpload_2","Label 2",width = "400px")),
column(4, fileInput("dataUpload_3","Label 3",width = "400px"))
)
)
server <- function(input, output){}
shinyApp(ui=ui, server=server)
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 have been trying to make the image output hyperlink to a website but I am having trouble having perused the other questions on stack overflow
svg with clickable links in shiny - not clickable
http://www.invisiblecompany.com/shiny%20parts/archives/2004/11/clickable-logo.php
http://www.leahkalamakis.com/add-an-image-to-your-sidebar-make-it-clickable/
the tags are not working
server.r
library(shiny)
library(png)
server <- shinyServer(function(input, output) {
output$image1 <- renderImage({
width<- "100%"
height<- "100%"
list(src = "www/logo.png",
contentType = "image/png",
width = width,
height = height,
)
}, deleteFile = FALSE)
output$text1 <- renderText({ "please help make the image hyperlinked" })
})
ui.r
library(shiny)
ui <- shinyUI(pageWithSidebar(
titlePanel(imageOutput("image1")),
sidebarPanel(
helpText( a("Click Here for the Source Code on Github!", href="https://github.com/Bohdan-Khomtchouk/Microscope",target="_blank"))
),
mainPanel(
tabsetPanel(
tabPanel("Instructions",textOutput("text1"))
))
))
you can replace the logo.png with whatever you want I think the hyperlink goes in the list in server.
Just wrap imageOutput with tags$a so in the UI:
titlePanel(tags$a(imageOutput("image1"),href="https://www.google.com"))
If you want to define the webpage from the server side then you need something like this:
#server
output$example <- renderUI({
tags$a(imageOutput("image1"),href="https://www.google.com")
})
#UI
titlePanel(uiOutput("example"))
I'm trying to scale down a plotOutput with Shiny R.
I have this plot:
from this code:
#In ui:
fluidRow(
column(width = 12,
h4("Diagrama Persistencia"),
plotOutput("Diagrama")
)
)
#In server
output$Diagrama <- renderPlot({
F_PlotDiag(Diag = isolate(values$data), tipoPlot = input$radioPlot, tamEjeNom = input$sliderTamEjeNom)
}, height = input$sliderHeight, width = input$sliderWidth)
Notice the height and width params. This works because all is in an observeEvent context.
As you can see, the hole plot won't fit in the screen. The problem with reducing height and width is that it looks like this:
But actually, if I right click and save the FIRST image, it looks fine unlike the second image:
Is there a way to show the whole plot in the browser by scaling it down? So that I can see it as if I downloaded the image.
I really don't know much about CSS so I can't really provide any logical attempts, but this is what I've tried for my HTML:
tags$style(type="text/css", ".shiny-bound-output { transform: 'scale(.5)' }")
tags$style(type="text/css", ".shiny-plot-output { transform: 'scale(.5)' }")
tags$style(type="text/css", "#Diagrama { height: 20px }")
With no success.
Since you didn't provide a reproducible example, see if this example helps you. Based on https://stackoverflow.com/a/8839678/4190526
The key is the following line, which finds the image under the div with the id distPlot (i.e. the plot name in ui.R), and define the CSS with a max-height but otherwise auto.
tags$style(HTML("div#distPlot img {width: auto; height: auto; max-width: auto; max-height: 400px;}")),
Full code
library(shiny)
ui <- shinyUI(fluidPage(
tags$style(HTML("div#distPlot img {width: auto; height: auto; max-width: auto; max-height: 400px;}")),
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
))
server <- shinyServer(function(input, output) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
}, width=600, height=1200)
})
shinyApp(ui = ui, server = server)