Related
I am trying to add a navlistPanel to a box() in bs4Dash and when I set the column width to 12, the tabItems squeeze next to each other like this:
Adding the widths = c(4,8) argument to navlistPanel also gives me the same result. If I set the column width to 4 or less, the navlistPanel is properly formatted.
My goal is to have a box() with column = 12 and a vertical tab menu inside it with width = 4 and have the tabs look correct.
I've also tried using tabsetPanel with vertical = TRUE, but the content doesn't show up in the right location, it shows up below. See picture #2:
Reprexes for both are below:
library(shiny)
library(bs4Dash)
ui <- dashboardPage(
header = dashboardHeader(
title = dashboardBrand(
title = "My dashboard",
color = "primary",
href = "https://adminlte.io/themes/v3",
image = "https://adminlte.io/themes/v3/dist/img/AdminLTELogo.png"
)),
sidebar = bs4DashSidebar(),
controlbar = dashboardControlbar(),
body = dashboardBody(fluidRow(column(
12,
box(
title = "Title",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
maximizable = TRUE,
color = "white",
height = 175,
width = NULL,
navlistPanel(
"Header",
tabPanel("First"),
tabPanel("Second"),
tabPanel("Third")
)
)
))),
help = FALSE,
dark = NULL,
scrollToTop = FALSE
)
server = function(input, output, session) {
}
shinyApp(ui, server)
library(shiny)
library(bs4Dash)
ui <- dashboardPage(
header = dashboardHeader(
title = dashboardBrand(
title = "My dashboard",
color = "primary",
href = "https://adminlte.io/themes/v3",
image = "https://adminlte.io/themes/v3/dist/img/AdminLTELogo.png"
)),
sidebar = bs4DashSidebar(),
controlbar = dashboardControlbar(),
body = dashboardBody(fluidRow(column(
12,
box(
title = "Title",
status = "primary",
solidHeader = TRUE,
collapsible = FALSE,
maximizable = TRUE,
color = "white",
height = 175,
width = NULL,
tabsetPanel(
id = NULL,
vertical = TRUE,
tabPanel("First",
"The content is below and I want it to the right of the tabset"),
tabPanel("Second"),
tabPanel("Third")
)
)
))),
help = FALSE,
dark = NULL,
scrollToTop = FALSE
)
server = function(input, output, session) {
}
shinyApp(ui, server)
I'm struggling to get my dashboard layout to be formatted in a way that looks good.
I have a box that is not the full width of my dashboard and the plot that is inside of it is actually wider and sticks out of it. (although I do believe once I make a plotly graph it will work fine).
I'm using fillRow but it does not fill the entire row and only half of the page.
Here is my code.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Overview",tabName = "Overview", icon = icon("tachometer-alt")),
menuItem("Assessments",tabName = "Assessments", icon = icon("list"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "Overview",
# Boxes need to be put in a row (or column)
fluidRow(
valueBoxOutput("rate"),
valueBoxOutput("count"),
valueBoxOutput("users"),
),
fluidRow(
box(title = "Title",
status = "primary",
),
box(align = "center",
title = "Select Inputs",status = "warning", solidHeader = F,
selectInput("dropdown1", "Select Drilldown:", c(50,100,200)))
),
fillRow(width = "100%",
box(
title = "Graph 1", status = "primary", solidHeader = TRUE,
plotOutput("plot1", height = "50vh", width = "100vh")))
),
tabItem(tabName = "Assessments",
h2("Assessmnents tab content")
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$dropdown1)]
hist(data)
})
output$instructions <- renderText("Company Name")
output$rate <- renderValueBox({
valueBox(
value = 130,
subtitle = "Overview 1",
icon = icon("area-chart"),
color = "aqua"
)
})
output$count <- renderValueBox({
valueBox(
value = 120,
subtitle = "Overview 2",
icon = icon("download"),
color = "red"
)
})
output$users <- renderValueBox({
valueBox(
value = 85,
subtitle = "Overview 3",
icon = icon("users"),
color = "purple"
)
})
}
shinyApp(ui, server)
And a screen shot
My desired goal would be something like this
Is there any reccomended resources I can read to get better at shiny dashboard layouts and controlling the view?
You need to use width = 12 in the box function. Additionally, to make sure the plot is always using the entire width of the box use width = "100%" in plotOutput.
fillRow(
box(
width = 12,
title = "Graph 1",
status = "primary",
solidHeader = TRUE,
plotOutput(
"plot1",
height = "50vh",
width = "100%")
)
)
The Shiny Dashboard documentation is a good place to start learning the structure, appearance, and behavior of Shiny Dashboard. You can also get some extra functionality by using shinydashboardPlus. Finally, shinyWidgets provides a great selection of custom widgets with an improved visual look.
It's all about layout. Here I provide shinydashboard skeleton and some explanation that might suits your problem'. You can put this code inside dashboardBody(tabItems(tabItem(tabName = "Overview",...)))
fluidPage(
fluidRow(
column(width = 4,valueBoxOutput(width = 12,"blue_value_box")) ,
column(width = 4,valueBoxOutput(width = 12,"red_value_box")) ,
column(width = 4,valueBoxOutput(width = 12,"purple_value_box"))
),
fluidRow(
column(width = 6,box(width = 12,"Title")),
column(width = 6,box(width = 12,"Select Inputs",
selectInput("someinputhere")))
),
fluidRow(
column(width = 12,
box(width = 12,plotOutput("histogramofdata"))
)
)
)
First of all the column is not necessary for your case, its just very helpful to explain shiny layout. Keep in mind shiny have a strict width value, 12 maximum. If you define width in something like box or column(), everything inside that will follow its width rather than global width. For example in my example, i put valueboxoutput() inside column(). you can see that the column has width = 4 and the valueboxoutput has 12. The column() will follow the page width and the valuebox will follow column width. I don't know if this is the best practice but i like to use fluidrow() to make a separation by row between an shiny object.
For more clearer example, in the image above, i highlighted the fluidrow() in red and blue for column().
I would require an action button icon on the top right corner of the shiny dashboard box. The below code appends the icons 'refresh' and 'plus' adjacent to the 'Title1'. However, I would require the icons to be placed at the right side end of the header bar (Similar to the positions of minimize, restore and close button in windows application).
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(
box(
title = p("Title 1",
actionButton("titleBtId", "", icon = icon("refresh"),
class = "btn-xs", title = "Update"),
actionButton('titleBtid2', '', icon = icon('plus'),
class='btn-xs', title = 'update')
),
width = 4, solidHeader = TRUE, status = "warning",
uiOutput("boxContentUI2")
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Row layout"),
dashboardSidebar(),
body
)
server = function(input, output, session) {
output$boxContentUI2 <- renderUI({
input$titleBtId
pre(paste(sample(LETTERS,10), collapse = ", "))
})
}
shinyApp(ui = ui, server = server)
Add a style declaration with absolute positioning to your action buttons.
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(
box(
title = p("Title 1",
actionButton("titleBtId", "", icon = icon("refresh"),
class = "btn-xs", title = "Update", style = "position: absolute; right: 40px"),
actionButton('titleBtid2', '', icon = icon('plus'),
class = 'btn-xs', title = 'update', style = "position: absolute; right: 10px")
),
width = 4, solidHeader = TRUE, status = "warning",
uiOutput("boxContentUI2")
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Row layout"),
dashboardSidebar(),
body
)
server = function(input, output, session) {
output$boxContentUI2 <- renderUI({
input$titleBtId
pre(paste(sample(LETTERS,10), collapse = ", "))
})
}
shinyApp(ui = ui, server = server)
I am in the process of creating a shiny app for a process at work and am struggling to figure something out on the UI side of the app. I would like to display a data table next to a sidebar menu containing options for the app. The issue is that when I do so, the data table is pushed down below the sidebar panel instead of beside it (see the original data tab).
I found a work around as seen in the suggested tab, but that comes with its own issues. I need to be able to lock the column headers while scrolling through the app and when the data table is inside the box element, I am unable to find a way to do so.
Here is the code to a simplified version of the app.
library(shiny)
library(lubridate)
library(tidyverse)
library(DT)
library(shinydashboard)
library(shinythemes)
library(sortable)
library(reactlog)
ui<- dashboardPage(
#this gives you the name displayed on the tab
dashboardHeader(title = "HHS Resin Purchasing 0.99"),
#this gives you your sidebar (page) options
dashboardSidebar(
sidebarMenu(
menuItem("Original Data", tabName = "original"),
menuItem("Suggested", tabName = "suggested")
)
),
#this is the body of the webpages
dashboardBody(
#this gives you the body options that are displayed on every page
sidebarPanel(width = 2,
h2("Menu Options"),
h4(strong("Upload Data:")),
fileInput("file", "Data", buttonLabel = "Upload..."),
textInput("delim", "Delimiter (leave blank to guess)", ""),
numericInput("skip", "Rows to skip", 0, min = 0),
h4(strong("User Options:")),
selectInput("plant", "Select a Plant", choices =
c("All")),
dateInput("latest_date", "Select the latest W_LEAD date in the data",
value = Sys.Date()),
numericInput("avg_multiple", "Multiple of Daily Useage for Cuttoff",21, min = 1, max = 50),
h4(strong("Download Options:")),
actionButton("complete_orders", "Analysis for plant orders complete"),
actionButton("complete_checks", "Mid month check complete"),
downloadButton("downloadData1", label = "Download Suggested Orders...", class = "btn-block"),
downloadButton("downloadData2", label = "Download Flags...", class = "btn-block"),
downloadButton("downloadData3", label = "Download Full Suggested Orders Data...", class = "btn-block")
),
#This is the actual data that fills those page options listed above
tabItems(
tabItem(tabName = "original",
DT::dataTableOutput(outputId = "preview1")
),
tabItem(tabName = "suggested",
box(title = "Suggested Orders",width = 9, status = "primary", height = "auto",
solidHeader = T, dataTableOutput("preview2"), style = "max-height:800px; overflow-y: scroll;overflow-x: scroll;")
)
)
)
)
server <- function(input, output) {
output$preview1 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20))
})
output$preview2 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20))
})
}
shinyApp(ui, server)
Help in fixing either of the issues outlined above would be very appreciated! Thanks in advance.
I think using the column() function will support your first question of the datatable moving under the sidebar sidebarPanel. Please see example below.
I think the second request of freezing the row header in the datatable can be resolved with the advice found at Freezing header and first column using data.table in Shiny
library(shiny)
library(lubridate)
library(tidyverse)
library(DT)
library(shinydashboard)
library(shinythemes)
library(sortable)
library(reactlog)
ui<- dashboardPage(
#this gives you the name displayed on the tab
dashboardHeader(title = "HHS Resin Purchasing 0.99"),
#this gives you your sidebar (page) options
dashboardSidebar(
sidebarMenu(
menuItem("Original Data", tabName = "original"),
menuItem("Suggested", tabName = "suggested")
)
),
#this is the body of the webpages
dashboardBody(
#this gives you the body options that are displayed on every page
fluidRow(
column(width = 2,
sidebarPanel(width = 2,
h2("Menu Options"),
h4(strong("Upload Data:")),
fileInput("file", "Data", buttonLabel = "Upload..."),
textInput("delim", "Delimiter (leave blank to guess)", ""),
numericInput("skip", "Rows to skip", 0, min = 0),
h4(strong("User Options:")),
selectInput("plant", "Select a Plant", choices =
c("All")),
dateInput("latest_date", "Select the latest W_LEAD date in the data",
value = Sys.Date()),
numericInput("avg_multiple", "Multiple of Daily Useage for Cuttoff",21, min = 1, max = 50),
h4(strong("Download Options:")),
actionButton("complete_orders", "Analysis for plant orders complete"),
actionButton("complete_checks", "Mid month check complete"),
downloadButton("downloadData1", label = "Download Suggested Orders...", class = "btn-block"),
downloadButton("downloadData2", label = "Download Flags...", class = "btn-block"),
downloadButton("downloadData3", label = "Download Full Suggested Orders Data...", class = "btn-block")
)
),
#This is the actual data that fills those page options listed above
column(width = 6,
tabItems(
tabItem(
tabName = "original",
DT::dataTableOutput("preview1",
options = list(dom = 't',
scrollX = TRUE,
paging=FALSE,
fixedHeader=TRUE,
fixedColumns = list(leftColumns = 1, rightColumns = 0)))
),
tabItem(tabName = "suggested",
box(title = "Suggested Orders",width = 9, status = "primary", height = "auto",
solidHeader = T, dataTableOutput("preview2"), style = "max-height:800px; overflow-y: scroll;overflow-x: scroll;")
)
)
)
)
)
)
server <- function(input, output) {
output$preview1 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20)))
})
output$preview2 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20)))
})
}
shinyApp(ui, server)
I'm just starting using R and Shiny App and I'm a bit confused about how to achieve what I'm trying to do. I want to change the UI of my Shiny App. As a C# developer, I work with HTML/CSS, AdminLTE and so on. I can't find a proper documentation how to change the UI in a Shiny App.
What I want to achieve in the UI is something like the following image:
First, I removed the sidebar. Now, my problem is to box the UI. In the header, I want to add a dropdown menu with few options. Then, I want in the middle of the page to have a panel with 2 column: in the first column first row I desire to see the graph generate by R, then same text around it to explain the graph.
On top of that, I want to change the style for example of tabs or buttons.
After 2 days of work, I wrote this code but it is very far from what I want to achieve.
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui <- navbarPage(
"Test",
tabPanel(
"Introduction",
titlePanel(
div(
windowTitle = "Test window"
)
),
div(class = "my-class",
h3("LAI287 basal insulin study"),
p("Lorem ipsum dolor sit amet..."),
p("Lorem ipsum dolor sit amet..."),
actionButton(
inputId = "btnStart",
label = "Start analysis",
className = "btn-primary"
)
)
),
tabPanel(
"Attribute specification"
),
tabPanel(
dropdownMenu(type = "notifications",
notificationItem(
text = "5 new users today",
icon("users")
),
notificationItem(
text = "12 items delivered",
icon("truck"),
status = "success"
),
notificationItem(
text = "Server load at 86%",
icon = icon("exclamation-triangle"),
status = "warning"
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
The result of this code is in the following screenshot. The only dropdown I found was for messages or notifications.
I know AdminLTE quite well but I don't understand how to write the code for Shiny App. Do you have any idea or suggestion how I can implement this UI? Is there any good tutorial I can read?
Update
I found some documentation on RStudio Shiny dashboard. First, I don't understand the difference between dashboardPage and navbarPage. Can I add a navbarPage to a dashboardPage?
From the documentation, I added this code:
box(
title = "Histogram", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot3", height = 250)
),
box(
title = "Inputs", status = "warning", solidHeader = TRUE,
"Box content here", br(), "More box content",
sliderInput("slider", "Slider input:", 1, 100, 50),
textInput("text", "Text input:")
)
and I expect something like
but my result is like that (thanks Jan for the menu)
I saw on the other page of the documentation that it is possible to add
dashboardPage(skin = "blue")
but in my case I don't have a dashboardPage.
Are you aware of the navbarMenu function? You can add menu items to the navbarPage with it:
navbarPage("App Title",
tabPanel("Plot"),
navbarMenu("More",
tabPanel("Summary"),
"----",
"Section header",
tabPanel("Table")
)
)
Layouting can be done with fluid layouts, e.g.
fluidRow(
column(width = 4,
"4"
),
column(width = 3, offset = 2,
"3 offset 2"
)
See the layout guide for the necessary details.
If you are familiar with AdminLTE then I strongly recommend using bs4Dash. It is a very robust package that allows for the use of boxes and other features that are regularly a part of AdminLTE (including Bootstrap 4). But the core of the language is still Shiny, so you may need to work through a few basic examples before attempting anything with greater complexity.
You can change colors, font-sizes, etc. in bs4Dash by following the instructions on this page.
For a demo of what is possible, see here.
I've provided a very basic example at the bottom of this answer.
Otherwise adding a dropdown navigation in bs4Dash is a bit tricky, and will require a combination of Javascript, CSS, and HTML. Luckily, you can modify all of these things.
Good luck!
library(shiny)
library(bs4Dash)
ui <- dashboardPage(
header = dashboardHeader(
leftUi = tagList(
dropdownMenu(
badgeStatus = "info",
type = "notifications",
notificationItem(
inputId = "notice1",
text = "Put text here!",
status = "danger"
)
),
dropdownMenu(
badgeStatus = "info",
type = "tasks",
taskItem(
inputId = "notice2",
text = "My progress",
color = "orange",
value = 10
)
)
)
),
dashboardSidebar(disable = T),
body = dashboardBody(
fluidRow(
column(width = 8,
box(width = NULL, title = "Old Faithful Geyser Data",
collapsible = F,
wellPanel( sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)),
plotOutput("distPlot")
),
box(width = NULL, title = NULL, collapsible = F,
fluidRow(
column(width = 5,
tags$img(src = "https://i.stack.imgur.com/EslMF.png", width = '100%')
),
column(width = 7,
tags$h4("Card Title"),
tags$p("Some text here")
)
)
)
),
column(width = 4,
box(width = NULL, title = "Header", status = "info", collapsible = F),
box(width = NULL, title = "Header", status = "success", collapsible = F),
box(width = NULL, title = "Header", status = "secondary", collapsible = F)
)
)
),
controlbar = dashboardControlbar(
collapsed = FALSE,
div(class = "p-3", skinSelector()),
pinned = TRUE
)
)
server <- 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')
})
}
shinyApp(ui = ui, server = server)