I have the shiny dashboard below and I want to print inside the box "Red1" to "Red21" one below the other using a for() loop like in the screenshot. The box() should be created with renderUI()
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(),
sidebar = dashboardSidebar(minified = TRUE, collapsed = TRUE),
body = dashboardBody(
uiOutput("box1")
),
title = "DashboardPage"
),
server = function(input, output) {
output$box1<-renderUI({
box(
for(i in 1:21){
"Red"[i]
br()
},
height = 300,width = 5
)
})
}
)
box() can take a list as first argument, so your code can be rewritten like this:
...
box({
text <- list()
for(i in 1:21){
text <- append(text, list(paste("Red", i), br()))
}
text
})
...
Doing this with an anonymous function (which this is) isn't that good for readability (at least for me) so I would suggest you build that list beforehand.
Related
I am making an app in shiny and I want the main panel to occupy 100% of the screen, how can I achieve this? In this occasion I am showing a table but I would also like to add a graph so that it can be seen large.
Below I show the code I am using
screen shiny
library(shiny)
library(DT)
shinyUI(fluidPage(
# Application title
titlePanel("Company-Feature Chart"),
mainPanel(
uiOutput("seleccione_col1"),
uiOutput("seleccione_col2"),
DT::dataTableOutput(outputId =
"diagram")
)
)
)
shinyServer(function(input, output) {
datachart <- read.csv("examplechart1.csv", row.names=1, sep=";")
output$seleccione_col1<- renderUI({
selectInput(inputId="columnaD", (("Product")),
choices =names(datachart),
selected = names(datachart)[c(1,2)],multiple = TRUE)
})
output$seleccione_col2<- renderUI({
selectInput(inputId="columnaE", (("Features")),
choices =row.names(datachart),
selected = row.names(datachart)[1],multiple = TRUE)
})
output$diagram<- renderDataTable({
req(input$columnaE)
data <-datachart[input$columnaE,input$columnaD]
DT::datatable(data, escape = FALSE,options = list(sDom = '<"top">lrt<"bottom">ip',lengthChange = FALSE))
}, rownames = TRUE)
})
Use the width option:
mainPanel(
uiOutput("seleccione_col1"),
uiOutput("seleccione_col2"),
DT::dataTableOutput(outputId = "diagram"),
width = 12
)
I'm developing an R Shiny app and am trying to append two output objects side-by-side as part of the same UI element. However, when I use splitLayout() Shiny creates a space between the two objects highlighted below:
Is there a way to get the two objects to appear immediately side-by-side without the space in between? Please see code behind stylized example below:
# define mapping table
col1 <- c("AAAA" , "BBBB" , "CCCC" , "DDDD")
col2 <- c(1:4)
map <- as.data.frame(cbind(col1, col2))
# define and execute app
ui <- fluidPage(
selectInput(inputId = "object_A", label = "Select Object A",
choices = c("AAAA", "BBBB" , "CCCC"), selected = NULL, multiple = FALSE),
actionButton("go","Run Output"),
tags$br(),
fluidRow(
column(width = 4,
uiOutput(outputId = "select_object")
)
)
)
server <- function(input, output) {
observeEvent(input$go, output$select_object <-
renderUI({
splitLayout(
input$object_A,
map[which(map["col1"]==input$object_A),"col2"]
)
})
)
}
shinyApp(ui = ui, server = server)
You can use a flexbox:
observeEvent(input$go, {
output$select_object <-
renderUI({
div(
style = "display:-webkit-flex; display:-ms-flexbox; display:flex;",
div(input$object_A),
div(style = "width: 30px;"), # white space
div(map[which(map["col1"]==input$object_A),"col2"])
)
})
})
To center the flexbox items:
style = "display:-webkit-flex; display:-ms-flexbox; display:flex; justify-content:center;"
More info on flexbox: guide to flexbox.
For text only, you could use paste instead of splitLayout :
observeEvent(input$go, output$select_object <-
renderUI({
paste(
input$object_A,
map[which(map["col1"]==input$object_A),"col2"]
)
})
)
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'm building a Shiny app and I would like to add a dynamic "checkboxGroup" which depends on some other input. More precisely, the user can upload N files, the app makes some calculations, then the output is a table with N columns (one for each file uploaded). At this point I would like the user to be able to select only certain columns, i.e. the ones he/she would like to consider, then the table should update according to the user's choice.
I had a look at some shiny apps on the web, and the closest solution is probably something like
https://shiny.rstudio.com/gallery/datatables-demo.html
but unfortunately in that example we have
checkboxGroupInput("show_vars", "Columns in diamonds to show:",
names(diamonds), selected = names(diamonds))
where diamonds is "known", whereas in my case I don't know how many files the user will upload and so how many columns my table will have.
Any ideas?
Cheers
EDITED:
Here there is the portion of code I'm reffering to. It works, the user can upload N excel files with same number of rows. The app returns a tab with N columns (the second column of each file uploaded).
Ideally, now I would like to add N check boxes (all selected initially), and the user can uncheck the columns he/she doesn't want to consider. Say he/she uncheck 2 columns, then the tab changes into a tab with N-2 columns.
Thanks again
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(data.table)
library(dplyr)
library(xlsx)
sidebar <- dashboardSidebar(
width = 350,
sidebarMenu(
tags$style(HTML(".sidebar-menu li a { color: #f4f8e8; }")),
menuItem("Computations",tabName = "tab1", icon = icon("file-text-o"))
))
body <- dashboardBody(
tags$style(".content-wrapper {background-color: #c3f9fa;}"),
style = "color: black;",
tabItems(
tabItem(
tabName = "tab1",
h2("upload files"),
tags$style(HTML(" .progress-bar { background-color: #1dbcbf; }")),
fileInput("csvs",
label="Upload CSVs here",
multiple = TRUE),
textInput(inputId="num_files",
label="number of files uploaded",
value = "",
width = NULL,
placeholder = NULL),
actionButton(inputId = "display_tab", label = "Display Tab after computations"),
box(title = "tab after computations:",tableOutput("all_cols"),width = 100),
checkboxGroupInput(inputId="show_vars", "Columns to keep:", choices = "selectedData", selected = "selectedData")
)))
dbHeader <- dashboardHeader(title = 'Exercise')
ui <- dashboardPage(
skin = "black",
dbHeader,
sidebar,
body
)
server <- function(input, output) {
options(shiny.maxRequestSize=260*1024^2)
computations <- function(num_files, db){
num_files <- as.numeric(num_files)
N <- nrow(db)/num_files #number of rows for 1 file (they all have same size)
tab_to_be_displayed <- db[1:N,2]
for(j in (1:(num_files - 1))){
left <- j*N+1
right <- (j+1)*N
tab_to_be_displayed <- cbind(tab_to_be_displayed, db[left:right,2])
}
return(tab_to_be_displayed)
}
mycsvs<-reactive({
rbindlist(lapply(input$csvs$datapath, fread),
use.names = TRUE, fill = TRUE)
})
selectedData <- reactive({
names(computations(input$num_files, mycsvs()))
})
observeEvent(input$display_tab,{
numero <- input$num_files
comp_tab <- computations(numero, mycsvs())
output$all_cols <- renderTable(comp_tab, align = 'c', rownames = TRUE, colnames = TRUE, digits = 3)
})
}
shinyApp(ui = ui, server = server)
I simplified the code a bit to demonstrate how the group checkboxes could work.
In simplifying, I kept the data as a list from the csv files. Then for computations extracted the second column from all data frames in the list, then used select to show columns based on the checkboxes.
The checkbox items are based on the names of the second columns of the data, with a default of all selected.
Instead of entering the number of files that were read, it is now computed based on the length of the list of data.
Let me know if this is closer to what you need.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(data.table)
library(dplyr)
library(xlsx)
sidebar <- dashboardSidebar(
width = 350,
sidebarMenu(
tags$style(HTML(".sidebar-menu li a { color: #f4f8e8; }")),
menuItem("Computations",tabName = "tab1", icon = icon("file-text-o"))
))
body <- dashboardBody(
tags$style(".content-wrapper {background-color: #c3f9fa;}"),
style = "color: black;",
tabItems(
tabItem(
tabName = "tab1",
h2("upload files"),
tags$style(HTML(" .progress-bar { background-color: #1dbcbf; }")),
fileInput("csvs",
label="Upload CSVs here",
multiple = TRUE),
textOutput("numfiles"),
box(title = "tab after computations:",tableOutput("all_cols"),width = 100),
uiOutput("checkboxes")
)))
dbHeader <- dashboardHeader(title = 'Exercise')
ui <- dashboardPage(
skin = "black",
dbHeader,
sidebar,
body
)
server <- function(input, output) {
options(shiny.maxRequestSize=260*1024^2)
db <- reactiveVal(list())
computations <- function(){
req(input$checkboxes)
do.call(cbind, lapply(db(), "[", , 2)) %>%
select_if(names(.) %in% input$checkboxes)
}
observeEvent(input$csvs, {
db(lapply(input$csvs$datapath, fread))
})
output$numfiles <- renderText(paste("Number of files: ", length(db())))
output$checkboxes <- renderUI({
choice_list <- unlist(lapply(db(), function(x) colnames(x)[2]))
checkboxGroupInput("checkboxes", "Columns to keep:", choices = choice_list, selected = choice_list)
})
output$all_cols <- renderTable(computations(), align = 'c', rownames = TRUE, colnames = TRUE, digits = 3)
}
shinyApp(ui = ui, server = server)
It sounds like you need your checkboxGroupInput to be reactive. That requires a combination of renderUI on your server script, and uiOutput on your ui script.
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)