I am building one UI in R Shiny and struggling with the layout part. I want to plot ValueBoxes and Table together. Following is the current output but, the rows are coming with the gap. So, could you suggest what can be done to remove this gap and get the desired layout. Here is the code
tabItem("overall_current_performance",
fluidRow(
column(width = 12,
valueBoxOutput("vlue", width = 3),
valueBoxOutput("vlue1", width = 3),
valueBoxOutput("win_loose", width = 3),
box(
title = "Box title", width = 3,
div(style = "height:200px"), status = "primary",
"Box content"
)
),
column(width = 12,
valueBoxOutput("performance", width = 3),
valueBoxOutput("performance1", width = 3),
valueBoxOutput("win_loose1", width = 3)
)
)
)
Current Layout with row gap:
Following changes gives correct layout,
column(
width = 3,
valueBoxOutput(
"vlue", width = NULL
),
valueBoxOutput(
"vlue1", width = NULL
)
),
column(width = 3,
valueBoxOutput(
"performance", width = NULL
),
valueBoxOutput(
"performance1", width = NULL
)
),
column(width = 3,
valueBoxOutput(
"win_loose", width = NULL
),
valueBoxOutput(
"win_loose1", width = NULL
)
),
column(width = 3,
box(
title = "Box title", width = NULL, div(style = "height:150px"),
status = "primary","Box content"
)
Desired Layout:
Related
I have a shiny dashboard with many tabs - now there are enough tabs that when the window size is small enough, the tabs wrap into a second row. For some reason, this second row overlaps the content of my sidebar, but the content in my main panel adjusts to accomodate the navbar's new size.
ui11 <- shinyUI(navbarPage("Beasts of Bellevue",
tabPanel("Head to Head", fluid = TRUE,
useShinydashboard(),
dashboardSidebar(
sidebarMenu(),
# Select variable for left plot
selectInput(inputId = "left",
label = "Manager 1:",
choices = c("Kevin", "Jake", "Lyons",
"Nipples", "Dan", "Shuds",
"Karp", "Mills", "Joey",
"Raffy", "Oster", "Scott", "Sam"),
selected = "Kevin"),
# Select variable for right plot
selectInput(inputId = "right",
label = "Manager 2:",
choices = c("Kevin", "Jake", "Lyons",
"Nipples", "Dan", "Shuds",
"Karp", "Mills", "Joey",
"Raffy", "Oster", "Scott", "Sam"),
selected = "Lyons"),
# Select which game type to include
checkboxGroupInput(inputId = "selected_gametype",
label = "Select game type(s):",
choices = c("Regular Season", "Playoffs", "Consolation"),
selected = c("Regular Season", "Playoffs", "Consolation")),
# Select which seasons to include
sliderInput(inputId = "slider",
label = "Seasons",
min = 2012,
max = max(h2h$Year),
value = c(2012, max(h2h$Year)),
sep = "",
ticks = FALSE,
dragRange = TRUE),
br(),
tags$img(src = "bob.png", height = 225, width = 225)),
#Header
header <- dashboardHeader(
disable = TRUE
),
mainPanel(width = 12,
dashboardBody(tags$head(tags$meta(name = "viewport", content = "width=1600")),
shinyDashboardThemes(
theme = "grey_light"
),
fluidRow(
# Row 1, Column 1
column(width = 6,
h3(textOutput("left"))
),
#Row 1, Column 2
column(width = 6,
h3(textOutput("right"))
)
),
fluidRow(
# Row 2, Column 1
column(width = 6,
withLoader(valueBoxOutput(
outputId = "leftnumber",
width = NULL), type = "html", loader = "loader7")),
# Row 2, Column 2
column(width = 6,
valueBoxOutput(
outputId = "rightnumber",
width = NULL))
),
fluidRow(
column(width = 12,
valueBoxOutput(
outputId = "leftnumberavg",
width = 2),
valueBoxOutput(
outputId = "leftnumberavg2",
width = 2),
valueBoxOutput(
outputId = "leftmargofvic",
width = 2),
valueBoxOutput(
outputId = "rightnumberavg",
width = 2),
valueBoxOutput(
outputId = "rightnumberavg2",
width = 2),
valueBoxOutput(
outputId = "rightmargofvic",
width = 2))
),
plotlyOutput(outputId = "plot")
)
)
)))
Here is an image of how the issue renders: Overlapping navbar
I ran into a bit of trouble in my app. I have a fluidrow, which contains 2 colums, and these columns again contain fluid rows.
I have a textinput in the left column and a selectInput (with selectize = TRUE) on the right side.
While the contents of that row are on exactly one level, the contents of the next row are sadly pushed further down. This only happens with a selectInput in that location, so I assume that it has a larger margin below than for example a textInput.
I hope somebody had a similar problem an a solution before!
edit:
fluidRow(
column(
width = 4,
offset = 2,
h3("Unsere Kontaktdaten"),
fluidRow(
column(
width = 12,
disabled(
textInput(
inputId = "Kontakt",
label = "Firma",
value = "Digitale Giganten",
width = "100%"
)
),
)
),
fluidRow(
column(
width = 9,
disabled(
textInput(
inputId = "unsere_straße",
label = "Straße",
value = "Mohnstraße",
width = "100%"
)
),
),
column(
width = 3,
disabled(
textInput(
inputId = "unsere_hausnummer",
label = "Hausnummer",
value = 123,
width = "100%"
)
),
)
),
),
column(
width = 4,
offset = 1,
h3("Ansprechpartner"),
fluidRow(
column(
width = 3,
disabled(
selectInput(
inputId = "unsere_anrede",
label = "Anrede",
choices = c("Herr", "Frau", "Divers"),
width = "100%" )
)
),
column(
width = 9,
disabled(
textInput(
inputId = "unser_ansprechpartner",
label = "Ansprechpartner",
width = "100%",
value = "name"
)
)
)
),
disabled(
textInput(
inputId = "unsere_nummer",
label = "Telefon",
width = "100%",
value = 123456789
)
),
)
),
You can fix this via css. I wrapped the selectinput in a div() to style it:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
column(
width = 4,
offset = 2,
h3("Unsere Kontaktdaten"),
fluidRow(
column(
width = 12,
disabled(
textInput(
inputId = "Kontakt",
label = "Firma",
value = "Digitale Giganten",
width = "100%"
)
),
)
),
fluidRow(
column(
width = 9,
disabled(
textInput(
inputId = "unsere_straße",
label = "Straße",
value = "Mohnstraße",
width = "100%"
)
),
),
column(
width = 3,
disabled(
textInput(
inputId = "unsere_hausnummer",
label = "Hausnummer",
value = 123,
width = "100%"
)
),
)
),
),
column(
width = 4,
offset = 1,
h3("Ansprechpartner"),
fluidRow(
column(
width = 3,
disabled(
div(selectInput(
inputId = "unsere_anrede",
label = "Anrede",
choices = c("Herr", "Frau", "Divers"),
width = "100%"),
style = "margin-bottom: -5px;")
)
),
column(
width = 9,
disabled(
textInput(
inputId = "unser_ansprechpartner",
label = "Ansprechpartner",
width = "100%",
value = "name"
)
)
)
),
disabled(
textInput(
inputId = "unsere_nummer",
label = "Telefon",
width = "100%",
value = 123456789
)
),
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
If you have multiple selectInputs you need to style and don't want to wrap each in a div, you can add:
tags$style("
.selectize-input {
margin-bottom: -5px !important;
}
")
somewhere in your UI.
Using bs4Dash, I am trying to create a box that contains several other boxes, have them horizontally aligned, and span equal-distances across the page no matter how big or small the window is. I was able to get the boxes in-line using a div(), but cannot seem to make them equidistant in width.
This is my reproducible example:
if (interactive()) {
library(shiny)
library(bs4Dash)
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(width = 12, div(style="display: inline-block;vertical-align:top;", box(
solidHeader = FALSE,
title = "Status summary",
background = NULL,
width = 12,
status = "danger",
footer = fluidRow(
descriptionBlock(
number = "17%",
numberColor = "pink",
numberIcon = icon("caret-up"),
header = "$35,210.43",
text = "TOTAL REVENUE",
rightBorder = TRUE,
marginBottom = FALSE
),
descriptionBlock(
number = "18%",
numberColor = "secondary",
numberIcon = icon("caret-down"),
header = "1200",
text = "GOAL COMPLETION",
rightBorder = FALSE,
marginBottom = FALSE
)
)
)),
div(style="display: inline-block;vertical-align:top;", box(title = "second box", width = 12))
)
)
),
title = "Description Blocks"
),
server = function(input, output) { }
)
}
I'm not sure if you've answered this question since you posted it, but it might be useful for others.
In bs4Dash, the key is to use constant combinations of fluidRow(column(width = X, box(width = NULL))) even within boxes.
For example, a box with two boxes inside of it might look like this:
column(width = 12,
box(width = NULL, title = "Main box",
fluidRow(
column(width = 6,
box(width = NULL, title = "Internal box 1")
),
column(width = 6,
box(width = NULL, title = "Internal box 2")
)
)
)
)
Here's a reproducible example that should achieve your outcomes:
library(shiny)
library(bs4Dash)
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
column(width = 12,
box(width = NULL,
fluidRow(
column(width = 6,
box(
solidHeader = FALSE,
title = "Status summary",
background = NULL,
width = NULL,
status = "danger",
footer = fluidRow(
column(width = 6,
descriptionBlock(
number = "17%",
numberColor = "pink",
numberIcon = icon("caret-up"),
header = "$35,210.43",
text = "TOTAL REVENUE",
rightBorder = TRUE,
marginBottom = FALSE
)
),
column(width = 6,
descriptionBlock(
number = "18%",
numberColor = "secondary",
numberIcon = icon("caret-down"),
header = "1200",
text = "GOAL COMPLETION",
rightBorder = FALSE,
marginBottom = FALSE
)
)
)
)
),
column(width = 6,
box(title = "second box", width = NULL))
)
)
)
)
)
)
server = function(input, output) { }
shinyApp(ui = ui, server = server)
I have a question regarding adding a horizontal and vertical scroll bars to my R Shiny App to display a complete heatmap plot (382 rows and 800 columns). I managed to configure most of the features in the app, however I am confused and stuck how to add a scroll bars since only partial plots are being displayed. After going through few questions in Stack Overflow, I learnt that this issue could be related to html, css and javascript which I am not familiar and some suggested to try with adding options = list(scrollX = TRUE) or 'overflow-x': 'scroll', and 'overflow-y': 'scroll',for horizontal and vertical scroll bar. Please assist me with how the scroll bars can be added horizontally and vertically to view the complete heatmap plot.
Thank you,
Toufiq
Example code UI and Server code is provided below along with the example screenshot of the plot4:
Define UI
ui <- dashboardPage(skin = "green",
dashboardHeader(title = "Test") ,
dashboardSidebar(
sidebarMenu(
menuItem("MENU")
),
sidebarMenuOutput("menu")
),
dashboardBody(
tabItems(
tabItem("gridfingerprint",
fluidRow(
box(width = NULL,solidHeader = TRUE,
plotOutput("plot2", height = 500)
),
fluidRow(
box(width = NULL,solidHeader = TRUE,
plotOutput("plot_map", height = 500))
),
fluidRow(
column(width = 4,
box(width = NULL,status = "warning",
downloadButton("gridplot",label = "Download image")
)
),
column(width = 3, offset = 1,
box(width = NULL, status = "warning",
downloadButton("downloadlist",label = "Download table")
))
)
)
),
tabItem(tabName = "individualfingerprint",
h5("Fingerprint heatmap displaying patterns of annotated modules across individual study subjects"),
fluidRow(
box(width = 12,solidHeader = TRUE,
plotOutput("plot4",height = 1200)
),
fluidRow(
column(width = 4,
box(width = NULL,status = "warning",
downloadButton("downloadindplot",label = "Download image")
)
),
column(width = 3, offset = 1,
box(width = NULL, status = "warning",
downloadButton("individualtable",label = "Download table")
))
)
)),
tabItem("complexplot",
fluidRow(
column(width = 12,
box(width = NULL,solidHeader = TRUE,
plotOutput("plot3",height = 800)),
fluidRow(
column(width = 4,
box(width = NULL,status = "warning",
downloadButton("aggregateplot",label = "Download image")
)
),
column(width = 3, offset = 1,
box(width = NULL, status = "warning",
downloadButton("downloadaggregate",label = "Download table")
))
)
)
))
)
)
)
I added the below code to the plot4 and this resolved the issue.
fluidRow(
box(width = 12,solidHeader = TRUE, (div(style='width:1400px;overflow-x: scroll;height:800px;overflow-y: scroll;',
plotOutput("plot4",height = 1200, width = 2000)))
ui <- dashboardPage(
dashboardHeader(title = "Sales"),
dashboardSidebar(),
dashboardBody(
tags$style(HTML(".box-header{background:#d2d2d2; color:#d83000; text-align:center;}")),
shinyUI(fluidPage(
fluidRow(
box(fluidRow(column(width = 12,
valueBox(1000,"Total Sales", width = 2),
valueBox(500,"Existing Sales", width = 2),
valueBox(300,"New Sales", width = 2),
valueBox(100,"Lost Sales", width = 2),
valueBox(100,"Unclassified Sales", width = 2))),
fluidRow(column(width=12, offset = 2,valueBox(250, "within existing sales", width = 2))),
width = 12, title = tags$b("BUSINESS MODEL"), solidHeader = TRUE)
)#,
#box(title = "Title", height = 20, width = 8, solidHeader = TRUE)
))))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
})
# Run the application
shinyApp(ui = ui, server = server)
Result
As you can see the "within existing sales" valuebox is not in align with "existing sales" valuebox. I tried offsetting with as 3.5 but it does not work. I even tried inspecting the result but I not much of a programmer.
The second row is not aligned because you are adding a offset of 2 to a column with a width of 12. On Bootstrap, you can not use more than 12 column in a row.
To solve that you should use a column-based layout, using a column for each valueBox and setting width = NULL. The follow example is using to separate rows, but you can also use only one row.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Sales"),
dashboardSidebar(),
dashboardBody(
tags$style(HTML(".box-header{background:#d2d2d2; color:#d83000; text-align:center;}")),
shinyUI(fluidPage(
fluidRow(
box( width = 12, title = tags$b("BUSINESS MODEL"), solidHeader = TRUE,
fluidRow(
column(width = 2, valueBox(1000,"Total Sales", width = NULL)),
column(width = 2, valueBox(500,"Existing Sales", width = NULL)),
column(width = 2, valueBox(300,"New Sales", width = NULL)),
column(width = 2, valueBox(100,"Lost Sales", width = NULL)),
column(width = 2, valueBox(100,"Unclassified Sales", width = NULL))
),
fluidRow(
column(width = 2, offset = 2,
valueBox(250, "within existing sales", width = NULL)
)
)
)
)#,
#box(title = "Title", height = 20, width = 8, solidHeader = TRUE)
))))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
})
# Run the application
shinyApp(ui = ui, server = server)