how to align tabsetpanel "pills" center in R shiny - css

I am trying to center-align tabsetpanel "pills" on shiny, but it alwais get on left position. Here is the code example, anyone knows how to align this buttons or pills center?
library(shiny)
ui <- fluidPage(
tabPanel(title = "Hello world", value = "HB",
tabsetPanel(id="subtabs", type="pills",
tabPanel(title = "TAB 1", value = "ILPF",
br(),
h4("I like Pink floyd, my favourite album is 'The dark side of the moon'", style = "color:grey", align = "center"),
br()
),
tabPanel(title = "TAB 2", value = "FS",
br(),
h4("But my favourite song is 'Shine on you crazy diamond'", style = "color:grey", align = "center"),
br()
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
The pills should be in the middle of the page

You can do so by adding some CSS to your app. tags$style('ul.nav-pills{display: flex !important;justify-content: center !important;}') does the trick.
library(shiny)
ui <- fluidPage(
tags$head(
tags$style('
ul.nav-pills{
display: flex !important;
justify-content: center !important;
}')
),
tabPanel(title = "Hello world", value = "HB",
tabsetPanel(id="subtabs", type="pills",
tabPanel(title = "TAB 1", value = "ILPF",
br(),
h4("I like Pink floyd, my favourite album is 'The dark side of the moon'", style = "color:grey", align = "center"),
br()
),
tabPanel(title = "TAB 2", value = "FS",
br(),
h4("But my favourite song is 'Shine on you crazy diamond'", style = "color:grey", align = "center"),
br()
)
)
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)

Related

R shiny downloadbutton aligned to other input elements like dateInput

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

How to prevent a popover to stay when changing tabs in shiny app?

I have a shiny app with popovers that contain useful information on interpretation of plot output. However, i have to close the popover "manually" everytime. Otherwise the popover of tab "dash1" will stay even if i switch to tab "dash2".
library(shiny)
library(bs4Dash)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard",
titleWidth = 550,
disable= FALSE,
sidebarIcon = NULL
),
dashboardSidebar(
sidebarMenu(
menuItem("dash1", tabName= "dashboard1"),
menuItem("dash2", tabName= "dashboard2")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard1",
box(
title = "Interpretation",
popover(
actionButton("goButton", "Click here"),
title = "Important information",
placement = "right",
content = "popover text bla bla"
)
)
),
tabItem(tabName = "dashboard2",
box(
title = "Interpretation",
popover(
actionButton("goButton2", "Click here"),
title = "Important information",
placement = "right",
content = "popover text bla bla"
)
)
)
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
How can i prevent this "behavior"? Do i necessarily have to specify addPopover and removePopover within the server part?
I solved the problem with the help of this issue:
Display Text only on hover
What i need is a tooltip rather than a popover.

Adjust spacing between R Shiny's renderText elements

How do I adjust the spacing between the end of the table and the sentence, "Place very close to table".
Here is the default spacing:
Here is the desired spacing:
R Script
library("shiny")
library("shinydashboard")
shinyApp(
ui = dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(width = 0),
body <- dashboardBody(
fluidRow(
tabBox(
id = "tabset1", height = "250px",
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
),
),
fluidRow(htmlOutput("last_updated"))
)
),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
output$last_updated <- renderText({
paste("<font size='1px;'>  Place very close to table</font>")
})
}
)
A possibility:
body <- dashboardBody(
div(
style = "display: flex; flex-direction: column;",
tabBox(
id = "tabset1", height = "250px",
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
),
div(style = "margin-top: -20px;"),
htmlOutput("last_updated")
)
)

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)

Shiny navbarPage combined with fluidRow

I'm having some trouble with setting out the layout of my shiny app. After trying a couple of different options the one to work the best for me was the navbarPage. Although, I managed to solve the majority of my problems(with the help of stackoverflow) I'm stuck in one.
Basically, I have a table that has many columns and it ends up always larger than the wellPanel that contains the table.
Below is some code to illustrate the problem:
require(shiny)
require(shinythemes)
side_width <- 5
sidebar_panel <-
sidebarPanel(
width = side_width,
radioButtons("Radio1",
label = h4("Radio label 1"),
choices = list("Europe" = "EU",
"USA" = "US"),
selected = "EU"),
hr()
br()
radioButtons("Radio 2",
label = h4("Radio label 2"),
choices = list("Annual" = 1, "Monthly" = 12),
selected = 1)
)
main_panel <- mainPanel(
width = 12 - side_width,
wellPanel(
h5(helpText("Figure 1: ..."))
),
wellPanel(
h5(helpText("Table 1: ..."))
),
wellPanel(
h5(helpText("Table 2: ..."))
),
wellPanel(
fluidRow(
column(12,
h5(helpText("Table 3: ..."))
)
)
)
)
# user interface
ui <- shiny::navbarPage("testing shiny",
tabPanel("Tab1",
sidebarLayout(
sidebarPanel = sidebar_panel,
mainPanel = main_panel,
position = "left")
),
tabPanel("Tab2",
verbatimTextOutput("summary")
),
tags$style(type="text/css", "body {padding-top: 70px;}"),
theme=shinytheme("cosmo"),
position ="fixed-top"
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
When you run the code you will see the current layout. All would be fine if it wasn't for that massive wide table 3 which half of it is always out of the wellPanel.
My question is is it possible to extend the wellPanel to the left so it occupies the entire width of the layout?
Any pointers are highly appreciated.
Cheers
The fluidRow and column functions don't do anything inside the wellPanel/mainPanel - you want to put this particular wellPanel as its own fluidRow separate from the sidebar layout.
Additionally, if your table is being made in the DT package, you can add scrollX=TRUE to the render options so that it'll add a scroll bar if the table is too big to fit.
require(shiny)
require(shinythemes)
side_width <- 5
# user interface
ui <- navbarPage(
"testing shiny",
tabPanel("Tab1",
sidebarLayout(position = "left",
sidebarPanel(width = side_width,
radioButtons("Radio1",
label = h4("Radio label 1"),
choices = list("Europe" = "EU",
"USA" = "US"),
selected = "EU"),
hr(),
br(),
radioButtons("Radio 2",
label = h4("Radio label 2"),
choices = list("Annual" = 1, "Monthly" = 12),
selected = 1)),
mainPanel(
width = 12 - side_width,
wellPanel(
h5(helpText("Figure 1: ..."))
),
wellPanel(
h5(helpText("Table 1: ..."))
),
wellPanel(
h5(helpText("Table 2: ..."))
)
)
),
fluidRow(
column(12,
wellPanel(
h5(helpText("Table 3: ..."))
)
)
)
),
tabPanel("Tab2",
verbatimTextOutput("summary")),
tags$style(type = "text/css", "body {padding-top: 70px;}"),
theme = shinytheme("cosmo"),
position = "fixed-top"
)

Resources