I want the text in this valuebox on top of each other and not side by side. Does anyone know how to fix this? You can see my code and an image below.
valueBox(value = "C: 7.07 A: 7.03 B: 6.82", "Durchschnittliche Bewertungen der Filiale", color = "yellow")
tried some layout codes but didn't worked.
It looks like based on tags you're using shiny and shinydashboard. You won't be able to add unicode \n newline for this; instead, you can wrap your text in HTML and then use <br> tag for line breaks. If you need to dynamically render the text in your valueBox, you can use paste. Below is a complete example.
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Value box example"),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBoxOutput("myValueBox")
)
)
)
server <- function(input, output) {
output$myValueBox <- renderValueBox({
valueBox(
value = HTML("C: 7.07<br>A: 7.03<br>B: 6.82"), "Durchschnittliche Bewertungen der Filiale", color = "yellow"
)
})
}
shinyApp(ui, server)
Image
Related
I have an issue with the waiter which I need for an app built with R shiny.
The example below (based on the fantastic website on the waiter package by John Coene: https://waiter.john-coene.com/#/waiter/examples#on-render) helps me illustrate my issue.
The app is made of two tabPanels, the first one which shows a table, and the second one that shows a chart. The table and the chart will appear after some waiting time, and the waiter spinner should, in the meantime, appear in the middle of the rendering areas of both tabPanels.
However, what actually happen is that the waiter spinner only shows up in the middle of the rendering area of the tabPanel I open first, whereas in the other tabPanel it is stuck in the top-left corner of the page.
Many thanks in advance for whoever can help me fix this problem!
library(shiny)
library(highcharter)
library(shinythemes)
library(waiter)
ui <- fluidPage(
theme = shinytheme("cyborg"),
useWaiter(),
actionButton("draw", "render stuff"),
fluidPage(
tabsetPanel(
tabPanel("Table", tableOutput("table")),
tabPanel("Chart", highchartOutput("hc"))
)
)
)
server <- function(input, output){
# specify the id
w <- Waiter$new(id = c("hc", "table"))
dataset <- reactive({
input$draw
w$show()
Sys.sleep(8)
head(cars)
})
output$table <- renderTable(dataset())
output$hc <- renderHighchart({
hchart(dataset(), "scatter", hcaes(speed, dist))
})
}
shinyApp(ui, server)
I would recommend you use shinycssloaders instead. The reason is that loaders' positions in waiter are calculated by current visible height and width. However, there is no visible position in the second tab or the hidden tabs, so waiter can't add the loader to the right spot. There is no fix we can do here. This is a feature that waiter doesn't support currently.
library(shiny)
library(highcharter)
library(shinythemes)
library(shinycssloaders)
ui <- fluidPage(
theme = shinytheme("cyborg"),
actionButton("draw", "render stuff"),
fluidPage(
tabsetPanel(
tabPanel("Table", withSpinner(tableOutput("table"), type = 3, color.background = "#060606", color = "#EEEEEE")),
tabPanel("Chart", withSpinner(highchartOutput("hc"), type = 3, color.background = "#060606", color = "#EEEEEE"))
)
)
)
server <- function(input, output){
dataset <- reactive({
input$draw
Sys.sleep(4)
head(cars)
})
output$table <- renderTable(dataset())
output$hc <- renderHighchart({
hchart(dataset(), "scatter", hcaes(speed, dist))
})
}
shinyApp(ui, server)
I'm trying to build a Shiny dashboard that responds to user inputs by displaying a series of boxes with nicely formatted html content. Because the user's selections determine how many boxes will be displayed, I'm using lapply() to render the boxes on the server side and then pushing the results of that process to uiOutput() on the ui side.
It's working with one crucial exception: the html content isn't appearing in the boxes. I don't get any error messages or warnings; I just don't get any content inside the boxes, other than the reactive titles.
What follows is a simple, reproducible example. What do I need to do differently to get contents to appear inside the boxes in the body of the ui?
library(shiny)
library(shinydashboard)
library(shinyWidgets)
dat <- data.frame(food = c("hamburger", "hot dog", "pizza", "kale salad"),
price = c("$2.50", "$1.50", "$2.00", "$3.50"),
peanut_gallery = c("beefy!", "dachsund!", "pie time!", "healthy!"),
stringsAsFactors = FALSE)
### UI ###
header <- dashboardHeader(title = "My Food App", titleWidth = 400)
sidebar <- dashboardSidebar(width = 400,
fluidRow(column(width = 12,
checkboxGroupButtons(
inputId = "my_food",
label = "Pick a food",
choices = c("hamburger", "hot dog", "pizza", "kale salad"),
selected = NULL
)
))
)
body <- dashboardBody(
fluidRow(
uiOutput("little_boxes")
)
)
ui <- dashboardPage(header, sidebar, body, skin = "black")
### SERVER ###
server <- function(input, output) {
output$little_boxes <- renderUI({
req(input$my_food)
lapply(input$my_food, function(x) {
df <- dat[dat$food == x,]
contents <- div(h4(df$peanut_gallery),
h5(df$price),
p(sprintf("Isn't %s great? I love to eat it.", df$food)))
box(title = df$food,
width = 6,
background = "red",
collapsible = TRUE, collapsed = TRUE,
uiOutput(contents) )
})
})
}
## RUN ##
shinyApp(ui, server)
Try :
htmltools::tagList(contents)
instead of
uiOutput(contents)
I have a Shinydashboard with reactive Dygraph boxes. I successfully setup a reactive box title to display the maximum value in the dataset and I'd like to do the same for the Status option. Here's what I've got so far:
ui <- dashboardPage(
dashboardHeader(title = "Sites", disable = TRUE),
dashboardSidebar(
#collapsed = TRUE,
disable = TRUE,
sidebarMenu()
),
dashboardBody(
fluidRow(
box(title = textOutput('dyermax'), background = "black", status = textOutput('dyerStat'), dygraphOutput("plot1", height = 173))
)
)
)
The title works as expected but the status gives an error: status can only be "primary", "success", "info", "warning", or "danger".
server <- function(input, output, session) {
#reactivePoll code for importing CSV data (datap)
renderTable(datap())
#Plot1
output$plot1 <- renderDygraph({
dyersburgp <- xts(x = datap()$dyersburg, order.by = datap()$date)
dyersburgf <- xts(x = datap()$dyersburg.1, order.by = datap()$date)
dyersburgmain <- cbind(dyersburgf, dyersburgp)
output$dyermax <- renderPrint({
cat("Dyersburg (max:", max(dyersburgp, na.rm = TRUE),"ug/m3)")
})
dyersburgMx <- max(dyersburgp, na.rm = TRUE)
output$dyerStat <- renderPrint({
if(dyersburgMx >60)("danger" else "info")
})
dygraph(dyersburgmain)
})
}
shinyApp(ui, server)
I would prefer to use the Color option instead of the Status option, but adding "color = "red"" to the box doesn't change the color at all for some reason.
Background
This is actually a really good question. To my understanding, the reason textOutput doesn't work is that, by default, text is rendered within an HTML div. So instead of just passing the raw string ('danger', 'info', etc.), it is rendered as raw HTML. For example, if we inspect the textOutput element in our browser when we run the following,
output$my_text <- renderText({
'this is some text'
})
textOutput('my_text')
we can see it actually renders the below HTML, rather than just "this is some text".
<div id="my_text" class="shiny-text-output shiny-bound-output">this is some text</div>
Obviously this is for a very good reason, and enables us to make good-looking Shiny apps without having to worry about any HTML. But it means we have to be careful when passing outputs as arguments to UI functions.
Solution
There may be better ways to do this, but one way would be creating the HTML yourself by using renderUI/uiOutput, and using the HTML function in combination with paste0 to dynamically render out HTML string to be read directly by uiOutput (which is an alias for the more descriptive htmlOutput). This example changes the status of the box when the user changes the numericInput to above 60, and allows the user to change the title of the box as well. Extend this as required for your own project.
library(shiny)
library(shinydashboard)
body <-
dashboardBody(
fluidRow(
numericInput(
inputId = 'status_input',
label = 'numeric input',
value = 50),
textInput(
inputId = 'box_title',
label = 'box title',
value = ''),
uiOutput('my_box')
)
)
server <- function(input, output, session) {
# get box status as string representing html element
box_status <- reactive({
if (input$status_input > 60) {
'box-danger'
} else {
'box-info'
}
})
# get user input for box title
box_title <- reactive({
input$box_title
})
# generate html to display reactive box
output$my_box <- renderUI({
status <- box_status()
title <- box_title()
# generate the dynamic HTML string
HTML(paste0("
'
<div class=\"box box-solid ", status, "\">
<div class=\"box-header\">
<h3 class=\"box-title\">", title, "</h3>
</div>
<div class=\"box-body\">
Box content!
</div>
</div>
'"
))
})
}
shinyApp(ui = dashboardPage(dashboardHeader(), dashboardSidebar(),body), server)
I would ask. Does Shiny do like always-refreshing the code after input ?
First I code this in ui :
box( ##title="Quality Attributes",
selectInput("att_ViewChart", width = '100%',label="Quality Attributes",
##multiple = TRUE,
choices=list(
"-",
"Suitability",
"Security",
)
)
),
dataTableOutput("tabelstatus")
Then I code this in server :
server = function(input, output) {
withProgress(message = "AAAAA",{
DateStatus_Sui<-c(1,2,3,4,NA,5,6,NA,7)
TimeStatus_Sui<-c(11,22,33,44,NA,55,66,NA,88)
status_Sui<-c(11,22,44,55,66,77,88)
jumlah<-7
})
if(input$att_ViewChart=="Suitability"){
Date<-DateStatus_Sui[!is.na(DateStatus_Sui)]
Time<-TimeStatus_Sui[!is.na(TimeStatus_Sui)]
Status<-status_Sui
Observation<-1:jumlah
#output
tabelstatus<-data.frame(Observation,Date,Time,Status)
output$tabelstatus<-renderDataTable(tabelstatus)
}
I hope when I run the app. Shiny will process the code (shown by progress bar 'AAAAA') And after that, if I choose Suitability it will do a little more process and then show the table . But I found that the progress bar appears again. Seems to me it re-runs the code from the beginning. How to fix this? Thank you
In the abscence of a fully reproducible example, I'm guessing this is what you're trying to do (i.e, make the table reactive according to your input$att_ViewChart):
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box( selectInput("att_ViewChart", width = '100%',label="Quality Attributes",
choices=c("-","Suitability","Security"))),
dataTableOutput("tablestatus")
)
)
server = function(input, output) {
withProgress(message = "AAAAA",{
DateStatus_Sui<-c(1,2,3,4,NA,5,6,NA,7)
TimeStatus_Sui<-c(11,22,33,44,NA,55,66,NA,88)
status_Sui<-c(11,22,44,55,66,77,88)
jumlah<-7
})
## make your table reactive on `input$att_ViewChart`
output$tablestatus <- renderDataTable({
if(input$att_ViewChart=="Suitability"){
Date<-DateStatus_Sui[!is.na(DateStatus_Sui)]
Time<-TimeStatus_Sui[!is.na(TimeStatus_Sui)]
Status<-status_Sui
Observation<-1:jumlah
tablestatus <- data.frame(Observation,Date,Time,Status)
}else{
tablestatus <-data.frame()
}
return(tablestatus)
})
}
shinyApp(ui = ui, server = server)
I use the library shinydashboard to write my ui.R. In my dashboardBody part, I wrote:
fluidRow(infoBoxOutput("dri"))
And then in my server.R, I wrote:
output$dri = renderInfoBox({
infoBox(
width = 2,
title = tags$b("Score"),
value = tags$b("100"),
color = "aqua",
fill = TRUE,
icon = icon("edit")
)
})*
But the width won't change to 2; it still uses the default one, i.e. 4 (1/3 of the whole webpage width).
Would someone help me with this? Thank you very much!
Maybe you can style it yourself
rm(list = ls())
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(fluidRow(infoBoxOutput("dri")),tags$style("#dri {width:200px;}"))
)
server <- function(input, output) {
output$dri <- renderInfoBox({
infoBox(
title = tags$b("Score"),
value = tags$b("100"),
color = "aqua",
fill = TRUE,
icon = icon("edit")
)
})
}
shinyApp(ui, server)
200 px
1000px
I found this answer on github and it worked for me aswell:
Instead of using renderInfoBox and infoBoxOutput, you can use renderUI
and uiOutput and that worked for me. This makes me think there is an
issue with the renderInfoBox function.