I have a tabBox in a shiny dashboard and would like to add a download button on the right of the tabs where the title of the tabBox would usually appear:
Any suggestions on how to do this?
Here is some minimal code to work with (without the required download box):
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "tabBoxes"),
dashboardSidebar(disable=TRUE),
dashboardBody(
fluidRow(
tabBox(
title = 'Download Button',
width = 12,
tabPanel("Tab1", "Some text for tab 1"),
tabPanel("Tab2", "Some text for tab 2")
)
))
)
server <- function(input, output) { }
shinyApp(ui, server)
Turns out its as simple as setting the tabBox title equal to a downloadButton!
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "tabBoxes"),
dashboardSidebar(disable=TRUE),
dashboardBody(
fluidRow(
tabBox(
title = downloadButton(outputId = 'downloadData', label='Download'),
width = 12,
tabPanel("Tab1", "Some text for tab 1"),
tabPanel("Tab2", "Some text for tab 2")
)
))
)
server <- function(input, output) { }
shinyApp(ui, server)
Related
Does anyone know how to make the title of a tabBox go above the tabs in a shinydashboard app? For example, in the figure below, the title is on the right, but I would like it to go on top of the box.
Code for this tabBox:
library(shiny)
library(shinydashboard)
ui = dashboardPage(dashboardHeader(title = "tabBoxes"), dashboardSidebar(),
dashboardBody(
fluidRow(
tabBox(title = HTML("Hello friend<br>"),
tabPanel("merp", "hi there"),
tabPanel("derp", "hello"),
tabPanel("herp", "howdy")
))
)
)
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
}
shinyApp(ui = ui, server = server
)
For those who might look for the solution here, a pretty simple fix was to put the tabBox (with no title) inside of a box with a title:
library(shiny)
library(shinydashboard)
ui = dashboardPage(dashboardHeader(title = "tabBoxes"), dashboardSidebar(),
dashboardBody(
fluidRow(box(title = HTML("Hello friend<br>"),
tabBox(
tabPanel("merp", "hi there"),
tabPanel("derp", "hello"),
tabPanel("herp", "howdy"))
))
)
)
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
}
shinyApp(ui = ui, server = server)
There is the side argument e.g
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(
tabBox(
title = "First tabBox",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1", height = "250px",side = 'right',
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
)
))
shinyApp(
ui = dashboardPage(dashboardHeader(title = "tabBoxes"), dashboardSidebar(), body),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
}
)
I have the shiny dashboard below and as you see I want to display a datatable inside sidebar but the issue is that the table is much wider. Can I make the table fit in exactly in the sidebar without increasing sidbar width?
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Table" , tabname = "my_table", icon = icon("table"),DT::dataTableOutput("example_table")
),
menuItem("Next Widget", tabName = "Other"))),
dashboardBody(
tabItems(
tabItem(tabName = "subMenu", #my_table",
fluidRow(
)),
tabItem(tabName = "Other",
h2("Other tab")
)
)))
server <- function(input, output) {
output$example_table <- DT::renderDataTable(head(mtcars))
}
shinyApp(ui, server)
One quick way is to enable horizontal scrolling for your DT. Then the table will fit the container but be scrollable:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
menuItem("Table" , tabname = "my_table", icon = icon("table"),DT::dataTableOutput("example_table")
),
menuItem("Next Widget", tabName = "Other"))),
dashboardBody(
tabItems(
tabItem(tabName = "subMenu", #my_table",
fluidRow(
)),
tabItem(tabName = "Other",
h2("Other tab")
)
)))
server <- function(input, output) {
output$example_table <- DT::renderDataTable(head(mtcars), options = list(scrollX=TRUE))
}
shinyApp(ui, server)
I would like to open a second dashboard by pressing the action button on the first dashboard. I was able to do that using the code below but the dashboards are connected to each other. E.g. if I close the sidebar on the second dashboard, the sidebar of the first one closes, too.
This is the server.R file:
function(input, output, session) {
# some more code
# react to clicking on button show2
observeEvent(input$show2, {
# here is some more code
showModal(settngsModal())
})
settngsModal <- function() {
modalDialog(
withTags({
dashboardPage(
dashboardHeader(
title = "Second Dashboard"
),
dashboardSidebar(
sidebarMenu(
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)),
dashboardBody(
tabItem(tabName = "widgets",
h1("Widgets tab content")
)
)
)
}),
title = "Settings",
fade = TRUE)
}
}
This is the ui.R file:
dashboardPage(
dashboardHeader(
title = "First dashboard"
),
dashboardSidebar(collapsed = TRUE,sidebarMenu()),
dashboardBody(),
h1('Headline'),
actionButton("show2", "Show second dashboard", size = 'lg')
)
)
Is it possible to have an "independent" dashboard?
Maybe even having two dashboards that can be used side by side (because now the second dashboard is a popup and the first dashboard can only be used if the second one is closed)?
You could use shinyjs to toggle between the two dashBoardPage tags.
Below is an example of switching between two Dashboards, there's a decent issue thread around rendering UI dashboardPage elements reactively.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- tagList(
useShinyjs(),
div(id = "dashboard_two",
style = "display:none",
dashboardPage(
dashboardHeader(
title = "Second dashboard"
),
dashboardSidebar(collapsed = TRUE,sidebarMenu()),
dashboardBody(fluidRow(actionButton("show1", "Show first dashboard")),
fluidRow(box(title = "Dash Two", height = 300, "Testing Render")) )
)
),
div(id = "dashboard_one",
style = "display:none",
dashboardPage(
dashboardHeader(
title = "First dashboard"
),
dashboardSidebar(collapsed = TRUE, sidebarMenu()),
dashboardBody(actionButton("show2", "Show second dashboard")
)
)
)
)
server <- function(input, output) {
shinyjs::show("dashboard_one")
observeEvent({ input$show1; input$show2}, {
shinyjs::toggle("dashboard_one")
shinyjs::toggle("dashboard_two")
})
}
shinyApp(ui, server)
I am working in an application similar to one below. I have my input panel in sidebar under a menu which is initally expanded. I want to collapse the menu and hide all the input panel so that my sidebar will be clean. But It should appear when I expand (not permanently hide). I tried the following solution but it is not working. Please help me to find a solution or any alternative approach.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem(
startExpanded = TRUE,
"Menu 1",
column(
width = 12,
actionButton("hideMe", label = "Collapse Me", icon = icon("close"))
)
)
)
),
body = dashboardBody()
)
server <- function(input, output, server){
observeEvent(input$hideMe, {
shinyjs::hide(selector = "ul.menu-open");
})
}
runApp(shinyApp(ui, server))
You need to add useShinyjs() into ui part
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
useShinyjs(),
sidebarMenu(
menuItem(
startExpanded = TRUE,
"Menu 1",
column(
width = 12,
actionButton("hideMe", label = "Collapse Me", icon = icon("close"))
)
)
)
),
body = dashboardBody()
)
server <- function(input, output, server){
observeEvent(input$hideMe, {
shinyjs::hide(selector = "ul.menu-open");
})
}
runApp(shinyApp(ui, server))
I am trying to render shinydashboard after login page but shinydashboard skin color is not showing.
my code is as follow:
ui.r
library(shinydashboard)
library(shiny)
uiOutput("page")
Login.R
library(shinydashboard)
ui1Output <- function(id, label = "ui1") {
shinyUI(fluidPage(
mainPanel(
textInput("username","Username",placeholder ="UserName"),
passwordInput("password","Password", placeholder ="Password"),
actionButton("login", "Login")
)))
}
dashbaordpage.R
library(shinydashboard)
dashpageOutput <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "dashboard",h2("Dashbaord")),
# Second tab content
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
global.R
source('login.R') #login page
source('dashboardPage.R')#dashbaordpage
server.R
library(shiny)
library(shinydashboard)
shinyServer(function(input, output,session) {
output$page <- renderUI({
ui1Output('ui1Output')
})
observeEvent(input$login,
{
if(True)
{
output$page <- renderUI(dashpageOutput)
}
else
{
Logged<-F
showModal(modalDialog(
title = "Error",
"Enter Correct Username and password"
))
}
})
})
Details: when I going dashboard is showing but not with default skin color or any other skin color. I have tried skin='red' like wise option.
Image for reference how actually showing after login.
Please help me.
Thanks in advance.