javascriptcssrshinydashboard
How to place InputButtons in the Header of R shinydashboard (using may be CSS,JS,html)
I have the below proto-type of my shiny app with two pages and two selectInput buttons in each page.
ui <- dashboardPage(
dashboardHeader(title = "Header",
dropdownMenuOutput("updatedTimeOutput"),
dropdownMenu(type = "notifications",
badgeStatus = "warning",
icon = icon("bullhorn", "fa-lg"),
notificationItem(icon = icon("bullhorn", "fa-1x"),
status = "info",
text = tags$span(
tags$b("Please notice!")
)
))),
dashboardSidebar( sidebarMenu(id = "tabs",
menuItem("Page1", tabName = "page1"),
menuItem("Page2", tabName = "page2"))),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
fluidRow(column(2,
selectInput("count1", "Select a category", c("1", "2"))),
column(2,selectInput("count2", "Select a subcategory1",
c("cat1", "cat2", "cat3", "cat4")))),
fluidRow(infoBoxOutput("ibox1")),
fluidRow(valueBoxOutput("vbox1"))
)
,
tabItem(
tabName = "page2",
fluidRow(column(2,
selectInput("count3", "Select a category", c("1", "2"))),
column(2, selectInput("count4", "Select a subcategory2",
c("sub1", "sub2", "sub3", "sub4")))),
fluidRow(infoBoxOutput("ibox2")),
fluidRow(valueBoxOutput("vbox2")
)
)
)
)
)
server <- function(input, output) {
output$ibox1 <- renderInfoBox({
infoBox(
"Title",
input$count1,
icon = icon("credit-card")
)
})
output$vbox1 <- renderValueBox({
valueBox(
"Title",
input$count2,
icon = icon("credit-card")
)
})
output$ibox2 <- renderInfoBox({
infoBox(
"Title",
input$count3,
icon = icon("credit-card")
)
})
output$vbox2 <- renderValueBox({
valueBox(
"Title",
input$count4,
icon = icon("credit-card")
)
})
}
shinyApp(ui, server)
If the app is run, we will see two selectInput buttons in the body of each page. Is it possible to move the selectInput buttons in each page to the header so that it looks like:
page 1:
page 2:
The inputButtons should be placed in the header and should show the corresponding inputs of each page. Can someone help if it could be done in shiny application making use of any custom CSS or javascript or html?
Solution
Try these CSS tricks, mobile friendly.
- When the screen is too small, automatically goes back to the tab.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Header"),
dashboardSidebar( sidebarMenu(id = "tabs",
menuItem("Page1", tabName = "page1"),
menuItem("Page2", tabName = "page2"))),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
fluidRow(class = "select-to-top", column(2,
selectInput("count1", "Select a category", c("1", "2"))),
column(2,selectInput("count2", "Select a subcategory1",
c("cat1", "cat2", "cat3", "cat4")))),
fluidRow(infoBoxOutput("ibox1")),
fluidRow(valueBoxOutput("vbox1"))
)
,
tabItem(
tabName = "page2",
fluidRow(class = "select-to-top", column(2,
selectInput("count3", "Select a category", c("1", "2"))),
column(2, selectInput("count4", "Select a subcategory2",
c("sub1", "sub2", "sub3", "sub4")))),
fluidRow(infoBoxOutput("ibox2")),
fluidRow(valueBoxOutput("vbox2")
)
)
),
tags$style(HTML(
"@media (min-width: 767px) {
.select-to-top {
position: fixed;
top: 0;
left: 49%;
width: 1000px;
z-index: 9999;
}
.main-header .logo {
height: 80px;
}
.left-side, .main-sidebar {
padding-top: 80px;
}
}
"
))
)
)
server <- function(input, output) {
output$ibox1 <- renderInfoBox({
infoBox(
"Title",
input$count1,
icon = icon("credit-card")
)
})
output$vbox1 <- renderValueBox({
valueBox(
"Title",
input$count2,
icon = icon("credit-card")
)
})
output$ibox2 <- renderInfoBox({
infoBox(
"Title",
input$count3,
icon = icon("credit-card")
)
})
output$vbox2 <- renderValueBox({
valueBox(
"Title",
input$count4,
icon = icon("credit-card")
)
})
}
shinyApp(ui, server)
Make input stays in header
Method 1
We fixed the header as well. When you scroll, the entire header is fixed on top. Change style to this
tags$style(HTML(
"@media (min-width: 767px) {
.select-to-top {
position: fixed;
top: 0;
left: 49%;
width: 1000px;
z-index: 9999;
}
.main-header .logo {
height: 80px;
position: fixed;
}
.navbar.navbar-static-top {
position: fixed;
height: 80px;
width: 100%;
}
.left-side, .main-sidebar {
padding-top: 80px;
}
.content-wrapper {
padding-top: 80px;
}
}
"
))
Method 2
Both input and header stay on top and don't move.
Use this style, just changed the position
tags$style(HTML(
"@media (min-width: 767px) {
.select-to-top {
position: absolute;
top: 0;
left: 49%;
width: 1000px;
z-index: 9999;
}
.main-header .logo {
height: 80px;
}
.left-side, .main-sidebar {
padding-top: 80px;
}
}
"
))
To work with dropdown
This code should make you work with dropdown menus.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Header", dropdownMenu(type = "messages",
messageItem(from = "Sales Dept",message = "Sales are steady this month."))),
dashboardSidebar( sidebarMenu(id = "tabs",
menuItem("Page1", tabName = "page1"),
menuItem("Page2", tabName = "page2"))),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
fluidRow(class = "select-to-top",
column(6, selectInput("count1", "Select a category", c("1", "2"))),
column(6,selectInput("count2", "Select a subcategory1", c("cat1", "cat2", "cat3", "cat4")))
),
fluidRow(infoBoxOutput("ibox1")),
fluidRow(valueBoxOutput("vbox1")),
lapply(1:40, br)
),
tabItem(
tabName = "page2",
fluidRow(class = "select-to-top",
column(6,selectInput("count3", "Select a category", c("1", "2"))),
column(6, selectInput("count4", "Select a subcategory2", c("sub1", "sub2", "sub3", "sub4")))
),
fluidRow(infoBoxOutput("ibox2")),
fluidRow(valueBoxOutput("vbox2")
)
)
),
tags$style(HTML(
"@media (min-width: 767px) {
.select-to-top {
position: absolute;
top: 0;
left: 50%;
color: white;
transform: translateX(-45%);
width: 500px;
z-index: 9999;
}
.main-header .logo {
height: 60px;
}
.left-side, .main-sidebar {
padding-top: 60px;
}
}
"
))
)
)
server <- function(input, output) {
output$ibox1 <- renderInfoBox({
infoBox(
"Title",
input$count1,
icon = icon("credit-card")
)
})
output$vbox1 <- renderValueBox({
valueBox(
"Title",
input$count2,
icon = icon("credit-card")
)
})
output$ibox2 <- renderInfoBox({
infoBox(
"Title",
input$count3,
icon = icon("credit-card")
)
})
output$vbox2 <- renderValueBox({
valueBox(
"Title",
input$count4,
icon = icon("credit-card")
)
})
}
shinyApp(ui, server)
- Keep numbers which appear in both columns, in J lang
- Differentiation in J
- How to reshape an array with an arbitrary size in one dimension?
- Why is Insert (fold) right associative
- Write 4 : 'x&{.&.;: y' tacitly
- Alignment issue when printing formatted prime numbers in J language
- How can I define a verb in J that applies a different verb alternately to each atom in a list?
- How to get user input in the J programming language
- How to unbox a list of boxed lists of differing lengths in J?
- How can I fix 'noun result was required' error in J?
- In j, how can I define a verb locally in one scope and pass it to a defined adverb?
- Convert boxed array to normal array?
- Read column of CSV file as array
- Replace atom in array of strings
- What does the dyad `=` do to boxed strings?
- Index of minimum element using J
- How can I take the outer product of string vectors in J?
- Building an array of verbs in J
- Reading in multidigit command line parameter
- Amend with bond to new data shows unexpected behaviour
- How to turn a table or matrix into a (flat) list in J
- How to run dissect in J?
- How to define selection using index function in J
- How to exit the J console?
- Find 4-neighbors using J
- Writing custom verbs in J
- How do I negate a selector in J lang?
- How to use arbitrary selector in interchange in J lang?
- different result once square root is added inside tacit
- Sum of arrays with repeated indices