splitLayout in shinydashboard::box - r

Goal
I want to place an actionButton next to a selectInput in the footer of a shinydashboard::box. According to this SO question splitLayout should do what I want.
Problem
The selectInput does not fill the whole space, when put into the footer. It seems that once in the footer the selectInput always takes a fixed width. Funny enough, when the same elements are put into the body of the box, the controls render as foreseen.
Question
How do I manage that selectInput and the actionButton
are next to each other AND
span the whole line?
Code
library(shiny)
library(shinydashboard)
boxUI <- function(width) {
box(
splitLayout(
selectInput("x", NULL, paste(strrep("x", 10), 1:10)),
actionButton("ok", icon("trash")),
cellWidths = c("85%", "15%"),
cellArgs = list(style = "vertical-align: top")),
footer = splitLayout(
selectInput("y", NULL, paste(strrep("x", 10), 1:10)),
actionButton("ok", icon("trash")),
cellWidths = c("85%", "15%"),
cellArgs = list(style = "vertical-align: top")
), width = width, solidHeader = TRUE, status = "info", title = "Box")
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
HTML(".shiny-split-layout > div {
overflow: visible;
}"))),
fluidRow(
boxUI(4),
boxUI(3))
))
server <- function(input, output) {
}
shinyApp(ui, server)

If you place the selectInput inside a div and set the width to 100%, that should give you what you're looking for.
footer = splitLayout(
tags$div(
selectInput("y", NULL, paste(strrep("x", 10), 1:10), width="100%")
),
actionButton("ok", icon("trash")),
cellWidths = c("85%", "15%"),
cellArgs = list(style = "vertical-align: top")
),

Related

shinyDashboard; Maximizing tabBox with a sidebar will add a horizontal Scrollbar to the box?

I am using a sidebar inside a box in shinyDashboard, which is working perfectly. However when I maximize the box, it will add an unnecessary horizontal scrollbar to the box. I tried disabling it with the following CSS style code:
tags$style("body {overflow-x: hidden !important; }")
But it does not work. Does anyone know how to remove the scrollbar?
Here is a simple reproducible code:
# Toggle a box sidebar
library(shiny)
library(bs4Dash)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
body = dashboardBody(
tags$style("body {overflow-x: hidden !important; }"),
box(
height = "500px",
width = 12,
maximizable = T,
solidHeader = FALSE,
collapsible = TRUE,
sidebar = boxSidebar(
id = "mycardsidebar",
width = 30,
p("Sidebar Content")
)
)
),
sidebar = dashboardSidebar()
),
server = function(input, output, session) {}
)
Any help would be highly appreciated.
I tried refining the css a bit
# Toggle a box sidebar
library(shiny)
library(bs4Dash)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
body = dashboardBody(
tags$style(".card.maximized-card .card-body {overflow-x: hidden !important; }"),
box(
height = "500px",
width = 12,
maximizable = T,
solidHeader = FALSE,
collapsible = TRUE,
sidebar = boxSidebar(
id = "mycardsidebar",
width = 30,
p("Sidebar Content")
)
)
),
sidebar = dashboardSidebar()
),
server = function(input, output, session) {}
)

How to render an image in shiny box and fix the width and height? R

I have this shiny app I am making. My goal is to have a fluid row that has an image and some inputs
# Test Version with google logo
library(shinydashboard)
library(shiny)
ui <- dashboardPage(
dashboardHeader(title = "Dashbaord"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody(
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center",
width = "100%",
style="height: 50px")), #I'm trying to change the size here but it doesn't work
box(align = "center",
title = "Select Inputs",status = "warning", solidHeader = F,
selectInput("dropdown1", "Select Drilldown:", c(50,100,200))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Technically this code works, but I don't like how the box with the image changes based off the monitor/view. I would like for both boxes to be the same height and remain uniformed. I posted some screen shots below.
Full Screen
Half Screen
Desire Output (row is the same height no matter what).
Edit:
box_height = "20em"
plot_height = "16em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center",
width = "100%"),
height = box_height),
box(plotOutput("speed_distbn",height = plot_height), height = box_height)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Boxes stay the same height but the image overlaps the box
How about this
library(shinydashboard)
library(shiny)
my_height = "30em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center", style = paste0("width: 100%; height: ", my_height, ";"))
),
box(title = "Plot", plotOutput("speed_distbn", height = my_height))
)
)
)
server <- function(input, output) {
output$speed_distbn <- renderPlot(plot(1))
}
shinyApp(ui, server)
In your first case, if you want to use other random tags on the right side. In order to have the right the same height as left, we can use spsComps::heightMatcher. We can use this function to dynamically match the height of the right side to the left side.
library(shinydashboard)
library(shiny)
my_height = "30em"
ui <- dashboardPage(
dashboardHeader(title = "Box alignmnent test"),
dashboardSidebar(),
dashboardBody(
# Put boxes in a row
fluidRow(
box(
title = "Image Goes Here",
id= "box_l",
img(src='https://cdn.vox-cdn.com/thumbor/ULiGDiA4_u4SaK-xexvmJVYUNY0=/0x0:640x427/1400x1050/filters:focal(0x0:640x427):format(jpeg)/cdn.vox-cdn.com/assets/3218223/google.jpg',
align = "center", style = paste0("width: 100%; height: ", my_height, ";"))
),
box(
title = "Select inputs",
id= "box_r",
selectInput("dropdown1", "Select Drilldown:", c(50,100,200))
),
spsComps::heightMatcher("box_r", "box_l")
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
In your case, the height on left is fixed, but heightMatcher can do it even with dynamically changed height. try click on spsComps shiny demo and go to the Misc tab and see the dynamic heightMatcher example.

Center form below table in R Shiny

I wish to center a small form below a table that is also centered.
I center the table using, fluidRow and column like so:
fluidRow(
column(12, align="center", reactableOutput("table")),
),
If I do the same with the form, each component of the form becomes centered in the page which is wrong. How do I center a correct looking form beneath the centered table?
Example Code
library(shiny)
library(reactable)
ui <- fluidPage(
fluidRow(
column(12, align="center", reactableOutput("table")),
),
fluidRow(
column(12,
div(id = "form",
textInput("email", "Email", width = "250px", placeholder = "joe#example.com"),
radioButtons(inputId = "pref",
label ="Here's a label:",
choiceNames = list(
"First choice",
"Second choice"),
choiceValues = list(
"v1", "v2"
)),
actionButton("submit", "Enter", class = "btn-primary", width = 250,
style="color: #FFF; background-color: #132EBA;"),
)
)
)
)
server <- function(input, output, session) {
output$table <- renderReactable({
reactable(iris,
fullWidth = FALSE)
})
observeEvent(input$submit, {
# Do something!
})
}
shinyApp(ui, server)
You need to create 2 div elements and give them CSS properties :
first one is centered
second one is an inline-block and aligned left
Source : CSS: Center block, but align contents to the left
So it gives
library(shiny)
library(reactable)
ui <- fluidPage(
fluidRow(
column(12, align="center", reactableOutput("table")),
),
fluidRow(
column(12,
div(id = "form",
style = "text-align: center;",
div(
id = "form_content",
style = "display:inline-block; text-align: left;",
textInput("email", "Email", width = "250px", placeholder = "joe#example.com"),
radioButtons(inputId = "pref",
label ="Here's a label:",
choiceNames = list(
"First choice",
"Second choice"),
choiceValues = list(
"v1", "v2"
)),
actionButton("submit", "Enter", class = "btn-primary", width = 250,
style="color: #FFF; background-color: #132EBA;")
)
)
)
)
)
server <- function(input, output, session) {
output$table <- renderReactable({
reactable(iris,
fullWidth = FALSE)
})
observeEvent(input$submit, {
# Do something!
})
}
shinyApp(ui, server)

Increasing the height of the DateRangeInput and alignment in R shiny

I need the following requirement with the R script below. When you click on the sidebar symbol at the top, when dashboard body expands, all widgets are in one line, however when the dashboard body shrinks, the dateRangeInput widget appears in the below line. I want all widgets to appear in one line and resize accordingly. Please help and thanks.
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(title = "Data", fluidPage(
div(style = "display: inline-block;vertical-align:top; width: 600 px;",
selectInput("select1","select1",c("A1","A2","A3")),selected = "A1"),
div(style = "display: inline-block;vertical-align:top; width: 600 px;",
selectInput("select2","select2",c("A3","A4","A5")),selected = "A3"),
div(style = "display: inline-block;vertical-align:top; width: 600 px;",
selectInput("select2","select2",c("A3","A4","A5")),selected = "A3"),
div(style = "display: inline-block;vertical-align:top; width: 600 px;",
selectInput("select2","select2",c("A3","A4","A5")),selected = "A3"),
div(style = "display: inline-block;vertical-align:top; width: 600 px;",
dateRangeInput("daterange1", "Date range:",
start = "2001-01-01",
end = "2010-12-31")
),
status = "primary", solidHeader = T, width = 12, height = 120)
)
))
server <- function(input, output) { }
shinyApp(ui, server)
Some of your code was off such that one didnt even see the box around your inputs.
Besides that: You're somewhat styled divs were not useful in achieving what you desired. Feel free to browse through the shiny layout guide section on the Fluid Grid to explore what possibilities in styling you have by just using the right functions shiny offers.
For the height issue in daterange widgets: The selects have a min-height of 34 pixels. If you also apply that to daterange objects by css, you can have them be the same size.
Corrected code below:
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2, selectInput("select1","select1",c("A1","A2","A3"), selected = "A1")),
column(2, selectInput("select2","select2",c("A3","A4","A5"), selected = "A3")),
column(2, selectInput("select2","select2",c("A3","A4","A5"), selected = "A3")),
column(2, selectInput("select2","select2",c("A3","A4","A5"), selected = "A3")),
column(4, dateRangeInput("daterange1", "Date range:", start = "2001-01-01",end = "2010-12-31")),
tags$head(
tags$style("
.input-daterange input {
min-height: 34px;
}
")
)
)
)
)
)
)
server <- function(input, output) { }
shinyApp(ui, server)

Shiny navbarpage draws over elements from below

This is the problem I am trying to solve. My navbarpage overlaps other elements from below. Is there any way to put the navbarpage in the background? Or perhaps make the daterange input show it's calendar below its input box?
The documentation mentions using fixed-top or fixed-bottom for the posotion argument will cause the navbar to overlay your body content, unless you add padding.
Adding padding does not solve the problem though.
Here is a reproducible example -
ui <- fluidPage(
fluidRow(class = 'headerrow', column(width = 12, style = "font-size: 30pt; line-height: 8vh; text-align:left; color:#FFFFFF; width = 100", tags$strong('Test')), tags$head(tags$style('.headerrow{height:8vh; background-color:#267dff}'))),
navbarPage(
'Navbar',
tabPanel(
'Menu1',
sidebarPanel(
selectInput('drink', 'Choose your poison', choices = c('Bloody Mary', 'Sex on the beach'), selected = 'Bloody Mary'),
dateRangeInput('period', 'Date range', start = '2016-05-01', end = '2017-04-01',
min = '2013-07-01', max = '2017-06-01', startview = 'year', format = 'mm/yyyy'),
width = 2
),
mainPanel(width = 10)
),
tabPanel('Menu2'),
tabPanel('Menu3'),
tabPanel('Menu4')
)
)
server <- function(input, output){
}
shinyApp(ui, server)
Thank you so much!
Try adding z-index to the div: tags$style(HTML(".datepicker {z-index:99999 !important;}"))
library(shiny)
ui <- fluidPage(
fluidRow(class = 'headerrow', column(width = 12, style = "font-size: 30pt; line-height: 8vh; text-align:left; color:#FFFFFF; width = 100", tags$strong('Test')), tags$head(tags$style('.headerrow{height:8vh; background-color:#267dff}'))),
navbarPage(
'Navbar',
tabPanel(
'Menu1',
tags$style(HTML(".datepicker {z-index:99999 !important;}")),
sidebarPanel(
selectInput('drink', 'Choose your poison', choices = c('Bloody Mary', 'Sex on the beach'), selected = 'Bloody Mary'),
dateRangeInput('period', 'Date range', start = '2016-05-01', end = '2017-04-01',
min = '2013-07-01', max = '2017-06-01', startview = 'year', format = 'mm/yyyy'),
width = 2
),
mainPanel(width = 10)
),
tabPanel('Menu2'),
tabPanel('Menu3'),
tabPanel('Menu4')
)
)
server <- function(input, output){}
shinyApp(ui, server)

Resources