I am working on a Shiny dashboard and using valueBoxes to display current KPI's. What I am noticing though, is depending on how long some of the text is, it elongates the box to fit the text which then screws up the look.
How do I make it so the text is always only on it's 1 line (i.e. change the font to be the width of the box) no matter what the screen size is?
Also, if you have any HTML or CSS pointers to make the information in a better layout, let me know.
I have to display:
value
description of what the value represents
estimation of future
value
In my actual dashboard:
I have the box background color changed
rounded out the edges
Have the value font color change based on thresholds
Code:
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBoxOutput("vbox", width = 2),
valueBoxOutput("vbox2", width = 2),
valueBoxOutput("vbox3", width = 2),
valueBoxOutput("vbox4", width = 2),
valueBoxOutput("vbox5", width = 2),
valueBoxOutput("vbox6", width = 2)
)
)
)
server <- function(input, output) {
output$vbox <- renderValueBox({
valueBox(
"55%",
HTML(paste("test_value that is super long like this",br(),"Estimated: 98%")),
icon = icon("credit-card")
)
})
output$vbox2 <- renderValueBox({
valueBox(
"70%",
HTML(paste("this one is just as long, maybe even longer",br(),"Estimated: 100%")),
icon = icon("credit-card")
)
})
output$vbox3 <- renderValueBox({
valueBox(
"80%",
HTML(paste("this one is short",br(),"Estimated: 50%")),
icon = icon("credit-card")
)
})
output$vbox4 <- renderValueBox({
valueBox(
"100%",
HTML(paste("medium length like here",br(),"Estimated: 95%")),
icon = icon("credit-card")
)
})
output$vbox5 <- renderValueBox({
valueBox(
"90%",
HTML(paste("test_value that is super long like this",br(),"Estimated: 80%")),
icon = icon("credit-card")
)
})
output$vbox6 <- renderValueBox({
valueBox(
"40%",
HTML(paste("test_value that is super long like this",br(),"Estimated: 70%")),
icon = icon("credit-card")
)
})
}
shinyApp(ui, server)
}
Related
I am trying to fix my width on my R Shiny map. Also, I am not succeeding in making the panel faded. The width and faded panel I want to replicate is here at this link:
https://shiny.rstudio.com/gallery/superzip-example.html
I am using their style css file, this link: https://github.com/rstudio/shiny-examples/blob/master/063-superzip-example/styles.css
I have written my code:
library(shiny)
library(tidyverse)
library(leaflet.extras)
library(leaflet)
library(RColorBrewer)
library(scales)
library(lattice)
library(dplyr)
fake_data <- read.csv("https://raw.githubusercontent.com/gabrielburcea/stackoverflow_fake_data/master/gather_divided.csv")
# Define UI for application that draws a histogram
ui <- fluidPage(
navbarPage("Covid-19 Symptom Tracker", id = "nav",
tabPanel("Interactive map",
div(class = "outer",
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "style.css")
),
leafletOutput("map", width = "100%", height = "96vh"), #height = "99vh"
#Floating panel
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
width = 330, height = "auto",
h4("SARS-Covid-19 symptoms"),
selectInput("symptom", "Select symptom", c("Chills",
"Cough", "Diarrhoea",
"Fatigue",
"Headache",
"Loss of smell and taste",
"Muscle ache",
"Nasal congestion",
"Nausea and vomiting",
"Shortness of breath",
"Sore throat",
"Sputum",
"Temperature")
),
tags$div(id="cite",
'Data provided by Your.md'
)
)))
)
)
server <- function(input, output) {
filtered_data <- reactive({
fake_data %>%
dplyr::filter(Symptom %in% input$symptom)
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by Mapbox') %>%
addMarkers(data = filtered_data(), clusterOptions = markerClusterOptions())
})
}
# Run the application
shinyApp(ui = ui, server = server)
And the css style I am using (just the same as theirs) is here:
https://github.com/gabrielburcea/stackoverflow_fake_data/blob/master/style.css
The panel I have is this which is obviously different than the one in the link I provided:
I get the following output:
when I run your code. I like the floating dialog box which fades. There is some white space along the title, and some more when I zoom out completely. It looks fine to me. Also, I saved the CSS file via Notepad. I don't think that should make any difference if you saved it via RStudio.
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'm building a Shiny app with this UI. Here is nhl-logo.png
ui <- fluidPage(
titlePanel(tagList(
img(src = "nhl-logo.png", height = 60, width = 60),
"PLAY-BY-PLAY"),
windowTitle = "NHL Play-by-Play"),
div(style = "position:absolute;right:2em;",
actionButton('load_inputs', 'Load inputs'),
actionButton('save_inputs', 'Save inputs')
),
hr(),
fluidRow(...)
Unfortunately, the style is not what I want since it puts those actionButtons on a lower level than the title (NHL LOGO PLAY-BY-PLAY)
How do I change the style so that my actionButtons appear on the same horizontal level as the titlePanel?
You can add the title in a span which includes the buttons. The difference between a span and a div is that the span is inline (a div is a block).
ui <- fluidPage(
titlePanel(tagList(
img(src = "nhl-logo.png", height = 60, width = 60),
span("PLAY-BY-PLAY",
span(actionButton('load_inputs', 'Load inputs'),
actionButton('save_inputs', 'Save inputs'),
style = "position:absolute;right:2em;")
)
),
windowTitle = "NHL Play-by-Play"
),
hr(),
fluidRow()
)
server <- function(input, output, session) {
}
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"))
Strangely enough I am getting a scrollbar on the right side of the page when I run the below shiny app:
shinyUI(
fluidPage(
tabsetPanel(
tabPanel("Plot", htmlOutput("test")),
tabPanel("Summary"),
tabPanel("Table")
)
)
)
library(googleVis)
library(shiny)
shinyServer(function(input, output, session) {
output$test <- renderGvis({
gvisBubbleChart(Fruits, idvar="Fruit",
xvar="Sales", yvar="Expenses",
colorvar="Year", sizevar="Profit",
options=list(
hAxis='{minValue:75, maxValue:125}',
vAxis='{minValue:0, maxValue:250}'
,height=600,width=600)
)
})
})
If I change from tabsetPanel layout to a pageWithSidebar layout the plot appears normally without the scrollbars.
On a seperate note, if I do not specify the width and height in the options list I am getting two scrollbars, one vertical and one horizontal.
Is it possible to use googleVis charts within tabsetPanels without the scrollbars?
You can set the overflow to hidden by adding a style argument to the tabPanel call:
library(googleVis)
library(shiny)
runApp(
list(ui = fluidPage(
tabsetPanel(
tabPanel("Plot", htmlOutput("test"), style = "overflow:hidden;"),
tabPanel("Summary"),
tabPanel("Table")
)
)
, server = function(input, output, session) {
output$test <- renderGvis({
gvisBubbleChart(Fruits, idvar="Fruit",
xvar="Sales", yvar="Expenses",
colorvar="Year", sizevar="Profit",
options=list(
hAxis='{minValue:75, maxValue:125}',
vAxis='{minValue:0, maxValue:250}'
,height=600,width=600)
)
})
})
)