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)
Related
I have an R shiny app with different download buttons as illustrated in the code below. The issue is that the position of the download button within fluidRow is not automatically aligned with the positions of other input elements like dateInput below.
ui <- dashboardPage(
title = "Test Dashboard", # this is the name of the tab in Chrome browserr
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
sidebarMenu(
menuItem('Retail', tabName = "retail", icon = icon("th"),
menuItem('Dashboard', tabName = 'retail_dashboard'))
)
),
dashboardBody(
tabItem(tabName = "retail_dashboard",
tabsetPanel(type = "tabs",
tabPanel("Dashboard",
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt", label = "Start Date:", value = Sys.Date()-10)), # 1yr ago
column(2,
dateInput("idx_muni_tot_ret_end_dt", label = "End Date:", value = Sys.Date())),
column(2,
downloadButton("download_idx_muni_TR_data","Download Data"))
)
)
)
)
)
)
server <- function(input, output, session) {
# code...
}
cat("\nLaunching 'shinyApp' ....")
shinyApp(ui, server)
I found similar questions here How do I align downloadButton and ActionButton in R Shiny app? and here Change download button position in a tab panel in shiny app but they don't seem to answer my questions. I also attach a screenshot with the current button position as well as the expected one.
A workaround is to simulate a label on top of the download button and add 5px of margin-bottom.
column(
width = 2,
div(tags$label(), style = "margin-bottom: 5px"),
div(downloadButton("download_idx_muni_TR_data", "Download Data"))
)
A bit of css does the trick:
ui <- dashboardPage(
title = "Test Dashboard",
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
),
dashboardBody(
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt",
label = "Start Date:", value = Sys.Date() - 10)),
column(2,
dateInput("idx_muni_tot_ret_end_dt",
label = "End Date:", value = Sys.Date())),
column(2,
div(style = "margin-bottom:15px",
downloadButton("download_idx_muni_TR_data","Download Data")))
, style = "display:flex;align-items:end")
)
)
Update
If you want to add a selectInput you need yet some new css tweaks to get the input on the same line:
ui <- dashboardPage(
title = "Test Dashboard",
dashboardHeader(title = "Web Portal"),
dashboardSidebar(),
dashboardBody(
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt",
label = "Start Date:", value = Sys.Date() - 10)),
column(2,
dateInput("idx_muni_tot_ret_end_dt",
label = "End Date:", value = Sys.Date())),
column(2,
tagAppendAttributes(selectInput("slc", "Select", LETTERS), style="margin-bottom:10px")),
column(2,
div(style = "margin-bottom:15px",
downloadButton("download_idx_muni_TR_data","Download Data"))),
style = "display:flex;align-items:end")
)
)
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.
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")
),
I am working with shinydashboard and using tabsetPanel, however strange name/number appears on the each tabPanel in the upper-left corner (like: tab-4750-1 and the number changes).
Does anyone know how i can remove it?
Hint: The problem appears in the menuItem: Tabelle & Plots
Code:
library(shiny)
library(shinydashboard)
library(ggplot2)
library(scales)
library(reshape2)
library(plyr)
library(dplyr)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Tabelle & Plots", icon = icon("area-chart"), tabName = "tabelle")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard"
),
tabItem(tabName = "tabelle",
tabsetPanel(id="tabs",width = NULL, height = "800px", selected = 1,
tabPanel(value=1,title="Tabelle filtern",
fluidRow(
column(12,
box(width = NULL, div(style = 'overflow-y: scroll; overflow-x: scroll;max-height: 650px; position:relative;',
dataTableOutput("tabelle")))))),
tabPanel("Plots", value = 2,
fluidRow(
column(12,
box(width = NULL, plotOutput("plot", height=650)),
box(status = "danger",width = NULL,div(style = 'overflow-x: scroll;position:relative;',
dataTableOutput("tabelle2")))))))
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui, server)
Thanks for help!
Cheers
This is a simplification of my Shiny UI. My issue is that the pull-down menu from the SelectizeInput is hidden. It is a bit of a pain having to scroll down. Also, it just does not look very nice. I have tried playing with the z-index to bring it up front but have not had any success.
This is my code:
library(shiny)
runApp(list(
ui = fluidPage(
tabsetPanel(id = "tabs",
tabPanel("Search",
fluidRow(
column(12,
inputPanel(
selectizeInput("s1", h4("Select State:"),
choices = state.name),
tags$head(tags$style(".selectize-control.single { width: 400px; z-index: 1; }")),
dateInput("day", h4("Input Date:"), value = Sys.Date())
)
)
)
)
)),
server = function(input,output,session)
{
})
)
Basically, I want the SelectizeInput menu to display on top like the DateInput calendar.
Thanks for the help!
Carlos
You can use the options from the selectize.js library https://github.com/brianreavis/selectize.js/blob/master/docs/usage.md . dropdownParentmaybe what you are looking for:
library(shiny)
runApp(list(
ui = fluidPage(
tabsetPanel(id = "tabs",
tabPanel("Search",
fluidRow(
column(12,
inputPanel(
selectizeInput("s1", h4("Select State:")
, options = list(dropdownParent = 'body')
, choices = state.name),
tags$head(tags$style(".selectize-control.single { width: 400px; z-index: 1; }")),
dateInput("day", h4("Input Date:"), value = Sys.Date())
)
)
)
)
)),
server = function(input,output,session)
{
})
)
Alternatively you can look at CSS and something like the overflow attribute. See Dropdowns not extending in shiny tabPanel . So in this case use
tags$head(tags$style(".tab-content {overflow: visible;}")),