I would like to bookmark a double nested menusubitem in shinydashboard, however this is not working (see example below).
When you bookmark page 1, page 2 or page 3.1, then it is working smoothly. However, when you try to bookmark page 4.1.1, then it opens on page 1.
Does anyone have a clue how to solve this?
library(shiny)
library(shinydashboard)
ui <- function(request){
dashboardPage(
dashboardHeader(title = "Dashboard Demo")
, dashboardSidebar(
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs"
, menuItem("Page 1", tabName = "page1", icon = NULL)
, menuItem("Page 2", tabName = "page2", icon = NULL)
, menuItem("Page 3", icon = NULL
, menuSubItem("Page 3.1", tabName = "page3_1", icon = NULL)
)
, menuItem("Page 4", icon = NULL
, menuItem("Page 4.1", icon = NULL
, menuSubItem("Page 4.1.1", tabName = "page4_1_1", icon = NULL)
)
)
)
)
, dashboardBody(
bookmarkButton()
, tabItems(
tabItem("page1", div(p(h2("Page 1"), "working", br(), "try to bookmark 4.1.1 and you will see it is not working")))
, tabItem("page2", div(p(h2("Page 2"), "working")))
, tabItem("page3_1", div(p(h2("Page 3.1"), "working")))
, tabItem("page4_1_1", div(p(h2("Page 4.1.1"), "not working with bookmark button")))
)
)
, title = "Dashboard example"
)
}
server <- function(input, output, session) {
}
enableBookmarking(store = "url")
shinyApp(ui = ui, server = server)
Related
I want to show the controlbar (right sidebar) only for several tabs in the left sidebar.
library(shiny)
library(bs4Dash)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(
title = "My dashboard"
),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarMenu",
menuItem(
text = "Tab 1",
tabName = "tab1"
),
menuItem(
text = "Tab 2",
tabName = "tab2"
)
)
),
body = dashboardBody(),
controlbar = dashboardControlbar(),
title = "DashboardPage"
),
server = function(input, output) { }
)
I try to develop a shiny app where for some of the tabs a controlbar is necessary, for others the controlbar should show certain options and for others it is obvious at all. What is the most elegant way to ensure this? Should i "outsource" the appearance into seperate modules or are there other recommendations?
It is possible, and there are a lot of different ways to achieve this.
Different methods have their benefits and shortcomings.
I can demonstrate to basic Shiny methods for conditional UI elements that are used the most.
The common thing among the "easy" solutions to the conditional UI per tab problem is to evaluate somehow on which tab the users view currently is.
First method would be to check the Javascript context and adapt the UI using conditionalPanel:
shinyApp(
ui = dashboardPage(
header = dashboardHeader(
title = "My dashboard"
),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarMenu",
menuItem(
text = "Tab 1",
tabName = "tab1"
),
menuItem(
text = "Tab 2",
tabName = "tab2"
),
menuItem(
text = "Tab 3",
tabName = "tab3"
)
)
),
body = dashboardBody(),
controlbar = dashboardControlbar(
id= "controlbar",
collapsed = TRUE,
conditionalPanel(
condition = "input.sidebarMenu=='tab1'||input.sidebarMenu=='tab3'",
controlbarMenu(
controlbarItem(title = "Item1"),
controlbarItem(title = "Item2")
)
),
conditionalPanel(
condition = "input.sidebarMenu=='tab2'",
controlbarMenu(
controlbarItem(title = "Item3")
)
),
conditionalPanel(
condition = "input.sidebarMenu=='tab3'",
controlbarMenu(
controlbarItem(title = "Item4")
)
)
),
title = "DashboardPage"
),
server = function(input, output,session) { }
)
The benefit is clearly that this should render faster since it gets evaluated inside the UI (clientside). The downside is that we have to use Javascript (what we might dont want to do) and also we create logic in the UI function, making it more cluttered.
The next method would be to use R and render some parts of the UI in the Server function and send it to an output function in the UI
shinyApp(
ui = dashboardPage(
header = dashboardHeader(
title = "My dashboard"
),
sidebar = dashboardSidebar(
sidebarMenu(
id = "sidebarMenu",
menuItem(
text = "Tab 1",
tabName = "tab1"
),
menuItem(
text = "Tab 2",
tabName = "tab2"
),
menuItem(
text = "Tab 3",
tabName = "tab3"
)
)
),
body = dashboardBody(),
controlbar = dashboardControlbar(
id= "controlbar",
collapsed = TRUE,
sidebarMenuOutput("Menu")
),
title = "DashboardPage"
),
server = function(input, output,session) {
observeEvent(input$sidebarMenu, {
output$Menu <- renderMenu({
if(input$sidebarMenu=="tab1") {
controlbarMenu(
controlbarItem(
title = "Item1"
)
)
}else if(input$sidebarMenu=="tab2"){
controlbarMenu(
controlbarItem(
title = "Item2"
),
controlbarItem(
title = "Item2_2"
)
)
}else{
controlbarMenu()
}
})
})
}
)
The benefit is that we have the logic in the Server function, and our UI gets more concise. The downsight is that we add extra computational work to the server, which could be done on the clients side. We also will have to write some if else statments or map or apply and its not clear what amount of the UI should be rendered in the server function. Also it gets more complex if you want to add a feature, so often times you have rewrite this alot during development if your not careful and plan ahead for reactivity, etc.
In my shinydashboard app, I want to specify a different tabName in the sidebarMenu from the tabName in the body. The server function should then catch the tabName on click and call updateTabItems.
The idea is, that some menu items in the sidebar should go to the same tab, and the longer tabName in the sideBar contains additional information used to fill the tab.
When both tabNames in sideBar and tabItems are the same, the code works. However, if I change the tabName in the sideBar, e.g. to one_param_val, updateTabItems stops working.
Any ideas why that is and what I can do about it?
library(shiny)
library(shinydashboard)
ui <- shinydashboardPlus::dashboardPage(
header=shinydashboard::dashboardHeader(title = "Switch tabs"),
sidebar=shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
shinydashboard::menuItem(
"Menu Item 1", tabName = "one_param_val" # works for tabName="one"
),
shinydashboard::menuItem(
"Menu Item 2", tabName = "two"
)
)
),
body=shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem(
tabName = "one", h2("Content One")
),
shinydashboard::tabItem(
tabName = "two", h2("Content Two")
)
)
)
)
server <- function(input, output, session) {
shiny::observeEvent(input$tabs, {
if(grepl("^one", input$tabs)) {
message("switching to one")
shinydashboard::updateTabItems(
session, inputId="tabs", selected="one"
)
}
})
}
shinyApp(ui, server)
Here is a workaround using a hidden menuItem. However the proxy menuItem will no longer get marked as selected in the sidebar:
library(shiny)
library(shinyjs)
library(shinydashboard)
ui <- shinydashboardPlus::dashboardPage(
header=shinydashboard::dashboardHeader(title = "Switch tabs"),
sidebar=shinydashboard::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
shinyjs::hidden(shinydashboard::menuItem(
"Menu Item 1", tabName = "one"
)),
shinydashboard::menuItem(
"Menu Item 1", tabName = "one_param_val"
),
shinydashboard::menuItem(
"Menu Item 2", tabName = "two"
)
)
),
body=shinydashboard::dashboardBody(
useShinyjs(),
shinydashboard::tabItems(
shinydashboard::tabItem(
tabName = "one", h2("Content One")
),
shinydashboard::tabItem(
tabName = "two", h2("Content Two")
)
)
)
)
server <- function(input, output, session) {
shiny::observeEvent(input$tabs, {
# browser()
if(grepl("^one", input$tabs)) {
message("switching to one")
shinydashboard::updateTabItems(
session, inputId="tabs", selected="one"
)
}
})
}
shinyApp(ui, server)
I am building an app using the bs4Dash package, and I would like to include action buttons in the main page that would allow the user to jump to the appropriate page. However, the buttons do not do anything.
This is very much the same as this question. I believe the issue here is that updatebs4TabItems requires a TabSetPanel inputId... Except that I do not wish to include tabset panels here.
library(shiny)
library(bs4Dash)
ui <- bs4DashPage(
# Sidebar -------------------------------------------------------------
sidebar = bs4DashSidebar(
bs4SidebarMenu(
bs4SidebarMenuItem(
"Welcome",
tabName = "item0"
),
bs4SidebarMenuItem(
"Page 1",
tabName = "item1"
),
bs4SidebarMenuItem(
"Page 2",
tabName = "item2"
)
)
),
# Body -------------------------------------------------------------
body = bs4DashBody(
bs4TabItems(
bs4TabItem(
tabName = "item0",
fluidRow(
actionButton("JumpToV1", "Go to Page 1"),
actionButton("JumpToV2", "Go to Page 2")
)
),
bs4TabItem(
tabName = "item1",
fluidRow(
bs4Callout(
title = "This is Page 1",
elevation = 4,
status = "danger"
)
)
),
bs4TabItem(
tabName = "item2",
fluidRow(
bs4Callout(
title = "This is Page 2",
elevation = 4,
status = "danger")
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$JumpToV1, {
updatebs4TabItems(session, "item0", selected = "item1")
})
observeEvent(input$JumpToV2, {
updatebs4TabItems(session, "item0", selected = "item2")
})
}
shinyApp(ui, server)
You're close! Two things need adjusting. From the documentation, note that the selected argument in updatebs4TabItems takes an integer (the position of the selected tab), not a string (so not the id name you have). Also, the inputID argument for updatebs4TabItems will refer to the sidebarID for you, which you need to set. The below code should work how you want.
library(shiny)
library(bs4Dash)
ui <- bs4DashPage(
# Sidebar -------------------------------------------------------------
sidebar = bs4DashSidebar(
bs4SidebarMenu(
id = "sidebarID", #note the new ID here
bs4SidebarMenuItem(
"Welcome",
tabName = "item0"
),
bs4SidebarMenuItem(
"Page 1",
tabName = "item1"
),
bs4SidebarMenuItem(
"Page 2",
tabName = "item2"
)
)
),
# Body -------------------------------------------------------------
body = bs4DashBody(
bs4TabItems(
bs4TabItem(
tabName = "item0",
fluidRow(
actionButton("JumpToV1", "Go to Page 1"),
actionButton("JumpToV2", "Go to Page 2")
)
),
bs4TabItem(
tabName = "item1",
fluidRow(
bs4Callout(
title = "This is Page 1",
elevation = 4,
status = "danger"
)
)
),
bs4TabItem(
tabName = "item2",
fluidRow(
bs4Callout(
title = "This is Page 2",
elevation = 4,
status = "danger")
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$JumpToV1, {
#changed ID and selected here and below
updatebs4TabItems(session, inputId = "sidebarID", selected = 2)
})
observeEvent(input$JumpToV2, {
updatebs4TabItems(session, inputId = "sidebarID", selected = 3)
})
}
shinyApp(ui, server)
I'm using a shinydashboard but when the title is too long it fails to wrap the lines. I have tried using <br/> to accomplish this, but it doesn't work even with HTML() around it in this context.
I know I can make the title space wider with titleWidth, but that does not look as good in many cases.
What would be the simplest way to achieve this?
Here's an example:
library(shiny)
library(shinydashboard)
## Only run this example in interactive R sessions
if (interactive()) {
header <- dashboardHeader(title = "This title is just way too long")
sidebar <- dashboardSidebar(
sidebarUserPanel("User Name",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
# Image file should be in www/ subdir
image = "userimage.png"
),
sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new",
badgeColor = "green"),
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
)
)
)
body <- dashboardBody(
tabItems(
tabItem("dashboard",
div(p("Dashboard tab content"))
),
tabItem("widgets",
"Widgets tab content"
),
tabItem("subitem1",
"Sub-item 1 tab content"
),
tabItem("subitem2",
"Sub-item 2 tab content"
)
)
)
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
}
The goal is to apply word-wrapping so that we can read the entire title (which says "This title is just way too long").
header <- dashboardHeader(title = h4(HTML("This title<br/>is just way too long")))
shinyApp(
ui = dashboardPage(header, sidebar, body),
server = function(input, output) { }
)
I have a Shiny app where there is an action button that is suppose to connect to Skype so people can directly chat with me. Below is the code I tried however when the action button is clicked nothing happens.
library(shiny)
library(shinydashboard)
rm(list=ls())
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarMenu(id = "menuChoice",
menuItem("Resources", tabName = "ResourcesMenu", icon = icon("leaf"),
menuSubItem("Filter Selection", tabName =
"LayoutSubMenu", icon = icon("angle-double-right")),
menuSubItem("Test", tabName = "Test2", icon = icon("globe")),
menuSubItem("Test 3", tabName = "Test3", icon = icon("wrench"))
),
menuItem("Trial Run", tabName = "TR", icon = icon("star"))
)
)
body <- dashboardBody(
uiOutput("TabSelect"),
#This action button is where I need help
a(actionButton(inputId = "phone",
label = "867-5309",
icon = icon("fab fa-skype", lib = "font-awesome")
),
href="skype:LastName, FirstName?chat"
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output, session) {
output$TabSelect <- renderUI ({
selectInput(inputId = "LoadTab", "Available Tabs",
choices = c(input$menuChoice)
)
})
}
shinyApp(ui, server)