Shiny navbarpage draws over elements from below - r

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)

Related

How to replace fluidRow with a horizontally scrollable non-wrapping row in tab panel?

The reproducible code below uses a fluidRow() to house several user selections using radio buttons. Works fine in this limited example of only 2 radio button groupings. But I need to fit more radio button groupings into this row, without any wrapping. To do this, I'd like to replace this combination of fluidRow()/column() with a horizontally scrollable, non-wrapping row that is not subject to the limitations of the 12-wide grid system currently used in this code.
Also, all objects viewed in the scrolling row need to be left aligned without "fluid" expansion. Currently, using this fluidRow()/column() combo, if the viewing pane is expanded, the 2 columns housing each radio button grouping also expanded which doesn't look good. They need to remain fixed width and stay to the left.
Is this possible?
I prefer sticking with this sidebar/main panel/tab panel/conditional panel layout as I find it very user friendly for navigating the type of data we work with.
The image at the bottom further explains.
Reproducible code:
library(dplyr)
library(DT)
library(shiny)
library(shinyWidgets)
ui <-
fluidPage(
titlePanel("Summary"),
sidebarLayout(
sidebarPanel(
selectInput("selectData", h5("Select data to view:"),
choices = list("Beta"),
selected = "Beta"),
),
mainPanel(
tabsetPanel(
tabPanel("Private data", value = 1,
conditionalPanel(condition = "input.selectData == 'Beta'",
fluidRow(div(style = "margin-top:15px"),
column(width = 6, offset = 0,
wellPanel(
radioButtons(inputId = 'group1',
label = NULL,
choiceNames = c('By period','By MOA'),
choiceValues = c('Period','MOA'),
selected = 'Period',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
),
column(width = 6, offset = 0,
wellPanel(
radioButtons(inputId = 'group2',
label = NULL,
choiceNames = c('Exclude CT','Include CT'),
choiceValues = c('Exclude','Include'),
selected = 'Exclude',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
)
),
DTOutput("plants")
)
),
id = "tabselected"
)
)
)
)
server <- function(input, output, session) {
output$plants <- renderDT({iris %>% datatable(rownames = FALSE)})
}
shinyApp(ui, server)
How about using a carousel instead e.g. via shinyglide or slickR:
library(dplyr)
library(DT)
library(shiny)
library(shinyWidgets)
library(shinyglide)
ui <-
fluidPage(
titlePanel("Summary"),
sidebarLayout(
sidebarPanel(
selectInput("selectData", h5("Select data to view:"),
choices = list("Beta"),
selected = "Beta"),
),
mainPanel(
tabsetPanel(
tabPanel("Private data", value = 1,
conditionalPanel(condition = "input.selectData == 'Beta'",
fluidRow(div(style = "margin-top:15px"),
column(12, glide(
height = "25",
controls_position = "top",
screen(
p(strong("Group 1")),
wellPanel(
radioButtons(inputId = 'group1',
label = NULL,
choiceNames = c('By period','By MOA'),
choiceValues = c('Period','MOA'),
selected = 'Period',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
),
screen(
p(strong("Group 2")),
wellPanel(
radioButtons(inputId = 'group2',
label = NULL,
choiceNames = c('Exclude CT','Include CT'),
choiceValues = c('Exclude','Include'),
selected = 'Exclude',
inline = TRUE
),
style = "padding-top: 12px; padding-bottom: 0px;"
)
)
))
),
DTOutput("plants")
)
),
id = "tabselected"
)
)
)
)
server <- function(input, output, session) {
output$plants <- renderDT({iris %>% datatable(rownames = FALSE)})
}
shinyApp(ui, server)

SelectInput choices are hidden behind downloadButton in Shiny App

I am having issues with the UI of a shiny app. In my app, the choices for my selectInputs are hidden behind a downloadButton.
library(shiny)
ui <- navbarPage(
tabPanel("View Archive",
sidebarLayout(
sidebarPanel(
tags$h4("Archive Filter", style = "font-weight: 450; margin-top: 0; text-decoration: underline; text-align: center",
radioButtons(
inputId = "archive.choice",
label = "Select Tasks to Display",
choices = c("Completed" = "archive.completed", "Scheduled" = "archive.scheduled")
),
tags$h4("Create Archive Report", style = "font-weight: 450; margin-top: 0; text-decoration: underline; text-align: center"),
splitLayout(cellWidths = c("50%", "50%"),
selectInput(
inputId = "report.month",
label = "Select Month",
choices = as.list(month.name)
),
selectInput(
inputId = "report.year",
label = "Select Year",
choices = (2020:format(Sys.Date(), "%Y"))
)
),
downloadButton('downloadData', 'Download Report')
)
))
)
server <- function(input, output, session) {}
shinyApp(ui, server)
I've tried changing the z-index of the selectInputs but haven't had any success with that. Does anyone know a way to resolve this issue? It seems like it should be simple but I haven't been able to find a solution. Thanks in advance.
I changed the splitLayout approach and used a fluidRow() with two columns instead.
library(shiny)
ui <- navbarPage(
title = 'StackOverFlow App',
tabPanel(
title = "First Panel",
sidebarLayout(
sidebarPanel = sidebarPanel(
tags$h4("Archive Filter", style = "font-weight: 450; margin-top: 0; text-decoration: underline; text-align: center"),
radioButtons(
inputId = "archive.choice",
label = "Select Tasks to Display",
choices = c("Completed" = "archive.completed", "Scheduled" = "archive.scheduled")
),
tags$h4("Create Archive Report", style = "font-weight: 450; margin-top: 0; text-decoration: underline; text-align: center"),
fluidRow(
column(
width = 6,
selectInput(
inputId = "report.month", label = "Select Month",
choices = as.list(month.name)
)
),
column(
width = 6,
selectInput(
inputId = "report.year", label = "Select Year",
choices = (2020:format(Sys.Date(), "%Y")))
)
),
downloadButton('downloadData', 'Download Report', style='z-index:1;')
),
mainPanel = mainPanel()
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
To get the job down using splitLayout it would be necesary to change the css z-index property of the selectImput.

Adjusting the title

Is there a R function to adjust the title " Factors under the dataset " and "Numbers under the dataset". Below is the code I have tried. So I need the title at the middle of the grey coloured bar
library(shiny)
ui <- fluidPage(
tabsetPanel(tabPanel(
"Factor_Univariate_Analysis",sidebarLayout(
sidebarPanel(
column(h6(selectInput("se1","Factors under the dataset",choices =
c("","Add","sub"))),width = 11,height= 20,offset = 0),width = 1000),
mainPanel(h5(plotOutput("Plot1",width = 1000,height = 1500)))
)
),
tabPanel(
"Numeric_Univariate_Analysis",sidebarLayout(
sidebarPanel(
column(h6(selectInput("se2","Numbers under the dataset",choices =
c("","mean","median","standard_deviation","Data Distribution"))),width
= 11,height= 20,offset = 0),width = 1000),
mainPanel(h5(plotOutput("Plot2",width = 1500,height = 500)))
)
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Here is some code which I think is close to what you want to do, I'll just explain a few things first:
I have five years experience as a web developer, so I enjoy using CSS, and I would recommend using it where ever possible. What I beleive you were trying to do is give the label a background, this can be done with CSS. In this case I have put it in the style and html tags. label {} applies styles to all labels. You might want to agust the background color.
I have removed the side panel layouts.
Hopefully you find this helpful.
library(shiny)
ui <- fluidPage(
tags$style(HTML("
label {
width: 100%;
background: lightgrey;
padding: 5px;
border-radius: 5px;
}
")),
tabsetPanel(
tabPanel(
"Factor_Univariate_Analysis",
div(
column(width = 12,
h6(
selectInput(
"se1",
label = "Factors under the dataset",
choices = c("","Add","sub"),
width = "100%"
)
)
),
div(plotOutput("Plot1",width = 1000,height = 1500))
)
),
tabPanel(
"Numeric_Univariate_Analysis",
column(width = 12,
h6(
selectInput(
"se2",
"Numbers under the dataset",
choices = c("","mean","median","standard_deviation","Data Distribution"),
width = "100%"
)
)
),
div(plotOutput("Plot2",width = 1500,height = 500))
)
)
)
server <- function(input, output, session) {
observe({
print(input$se1)
updateSelectInput(session, input$se1, label = "Factors under the dataset replaced")
})
}
# https://shiny.rstudio.com/reference/shiny/latest/updateSelectInput.html
shinyApp(ui, server)

splitLayout in shinydashboard::box

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")
),

R shiny Dashboard: How to add vertical scrollbar to dashboard sidebar?

I have a couple of questions regarding R shiny Dashboard.
ui.R
library(shinydashboard)
library(shiny)
dashboardPage(
dashboardHeader(title = 'Test Interface'),
dashboardSidebar(width = 600,
h3('-------Input Data-------'),
fluidRow(
column(6, div(style = "height:10px"), fileInput(inputId = 'FileInput', label = 'Upload Input:', accept = c('csv','tsv','txt'))),
column(2, div(style = "height:3px"), checkboxInput(inputId = 'header', label = 'Header', value = FALSE)),
column(2, div(style = "height:12px"), radioButtons(inputId = 'sep', label = 'Separator', choices = c(comma=',',tab="\t",space=' '), selected = ","),offset = 1)
),
fluidRow(column(6, div(style = "height:1px"), fileInput(inputId = 'FileInput1', label = 'Upload Second Input:'))),
br(),
h3('-------Select Foreground-------'),
fluidRow(
column(5, div(style = "height:17px"), radioButtons(inputId = 'cutoff', label = 'Selection', choices = c('Up'='pos','Down'='neg','Both'='both'))),
br(),
column(3, div(style = "height:1px"), textInput(inputId = 'fc', label = "Fold Change", value = '0')),
column(3, div(style = "height:1px; margin-left:10cm"), height = 6,textInput(inputId = 'pvalue', label = "Adj. Pvalue",value = '0.05'))
),
fluidRow(column(2, h1(" "), actionButton(inputId = 'select', label = "Select Data"))),
fluidRow(column(5, div(style = "height:25px;font-color:blue"), downloadButton('download', 'Download Plot')))),
dashboardBody(
tabsetPanel(type="tabs", id = "tabvalue",
tabPanel(title = "Input Table", value = 'tab1', DT::dataTableOutput('table')),
tabPanel(title = "Plot", value = 'tab7', plotOutput('plot',width = 800,height = 800)))))
server.R
library(shiny)
shinyServer(function(input, output, session){
})
I couldn't figure out how to add a vertical scroll bar to the dashboardSidebar. In my actual app, the last elements are not visible when I run the app.
Thanks!
I ran into this and came up with the following hack (and I do mean hack).
shinyDashboard(
tags$head(
tags$style(HTML(".sidebar {
height: 90vh; overflow-y: auto;
}"
) # close HTML
) # close tags$style
), # close tags#Head
# ...
The 90vh sets the sidebar height at 90% of the viewport height. You may want to adjust this to taste. Too large a percentage and some of the sidebar still drops below the horizon; too small a percentage and the sidebar ends noticeably before the main body (with the scrollbar appearing prematurely).

Resources