Dynamically populate tabName in R Shiny application - r

I am working on a complex shiny application. The sidebarMenu contains over 100 menu items, with some nested items. I am also using modules (callModule) to generate repeated content.
The problem I am running into is the initial loading time, which is 28 seconds. When I ran profvis I found the time was adding up because the site is generating all of the tables, plots, and content for all 100+ menu items. Therefore, I would like to generate the content when the user clicks on the menu item rather than generating it all when the site is loaded.
I am using renderUI to create the tabItems and renderMenu to create the menuItems in the server.R file.
In the small reproducible example provided below, I set my sidebarMenu id to "smenu". I call input$smenu in tabItem to set the tabName. This doesn't work as expected. If you run the example, you will notice that if you 1) click on "Dashboard", 2) click on "Dashboard2", the h3() content that should appear on the dashboard2 page does not appear. However, if you 3) click on "Dashboard" again, and 4) click on "Dashboard2" again, the content appears.
I have two questions.
1) What is the best way to generate only the content that the user asks for rather than generating it all when the site is initially loaded?
2) Why does this code show content after this sequence of clicks rather than when the user first clicks on Dashboard2?
Thanks in advance for any advice or pointers.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
id = "smenu",
sidebarMenuOutput("menu")
)
),
dashboardBody(
textOutput("testmenu"),
uiOutput("bodyUI")
)
)
server <- function(input, output) {
observe({
output$testmenu <- renderText({
out <- paste("Current menu item is", input$smenu, sep = " ")
})
})
output$bodyUI <- renderUI({
tabItems(
tabItem(tabName = input$smenu,
h3(paste("Hello World! You are on the", input$smenu, "menu item.", sep = " "))
)
)
})
output$menu <- renderMenu({
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
menuItem("Dashboard2", tabName = "dashboard2", icon = icon("dashboard")),
menuItem("Dashboard3", tabName = "dashboard3", icon = icon("dashboard"))
)
)
})
}
shinyApp(ui, server)

If you want to use tabName from menuItem you have to define one tab per tabName:
tabItems(
tabItem(tabName = "dashboard",
h3(paste("Hello World! You are on the", input$smenu, "menu item.", sep = " "))
),
tabItem(tabName = "dashboard2",
h3(paste("Hello World! You are on the", input$smenu, "menu item.", sep = " "))
),
tabItem(tabName = "dashboard3",
h3(paste("Hello World! You are on the", input$smenu, "menu item.", sep = " "))
)
)
This will display the tabs after the first menu selection (since the tabs are defined in the server)
Also you should move the menu id to the renderMenu:
output$menu <- renderMenu({
sidebarMenu(id = "smenu",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"),
menuItem("Dashboard2", tabName = "dashboard2", icon = icon("dashboard")),
menuItem("Dashboard3", tabName = "dashboard3", icon = icon("dashboard"))
)
)
})
and simplify the ui:
...
dashboardSidebar(
sidebarMenuOutput("menu")
),
...

Related

In Shiny how can I click in a menuItem and show the subItems options on the body?

This is my {shinydashboard}:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
"User Name",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
sidebarMenu(
id = "tabs",
menuItem(
"Dashboard",
tabName = "dashboard",
icon = icon("dashboard"),
menuSubItem(
"Widgets",
icon = icon("th"),
tabName = "widgets"
),
menuSubItem(
"Charts",
icon = icon("th"),
tabName = "charts"
)
))),
dashboardBody(
tabItems(
tabItem("dashboard",
tags$button(
h1('This button takes me to the Widgets Panel')),
br(),
br(),
tags$button(h1('This button takes me to the Charts Panel'))
))))
server = function(input, output) {
}
shinyApp(ui, server)
The idea is to click on 'Dashboard' Menu and then on the body I have a link or button that takes me to the 'Widgets' or 'Charts' Panels.
Once I click on those buttons/links OR click on the Sub Menus of 'Dashboard' menu these actions will take me to their Panels.
So, how can I add the buttons and links that take me to the panels of my Menu SubItems?
And how can I add the buttons and links on the body of my Shiny Dashboard?
Any help would me amazing.
Your question is the result of a common misunderstanding regarding shinydashboard's structure.
Childfull menuItems (like your "Dashboard" menuItem) don't have a corresponding tabItem.
The only usecase for a childfull menuItem is to expand on click and present its children (no visual change in the body - only in the sidebar).
Accordingly in your above code the tabName = "dashboard" parameter is ignored and the tabItem("dashboard", ...) isn't displayed.
When a menuItem is childfull it accepts the parameters
expandedName and startExpanded.
When a menuItem is childless it accepts the parameters tabName
and selected (just like menuSubItem which always is childless).
Please read the small print.
Also check my related answers here and here.
However, there are unofficial workarounds to have a childfull menuItem display a tabItem - I don't recommend to use them.
To navigate your tabs programmatically use updateTabItems:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
sidebarUserPanel(name = "User Name",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
image = NULL),
sidebarMenu(
id = "tabs",
menuItem(
"Dashboard",
menuSubItem("Widgets",
icon = icon("th"),
tabName = "widgets"),
menuSubItem("Charts",
icon = icon("th"),
tabName = "charts"),
icon = icon("dashboard"),
expandedName = "dashboard",
startExpanded = TRUE
)
)
),
body = dashboardBody(
tabItems(
tabItem("widgets", actionButton("goCharts", "Go to Charts tab")),
tabItem("charts", actionButton("goWidgets", "Go to Widgets tab"))
)
)
)
server <- function(input, output, session) {
observeEvent(input$goCharts, {
updateTabItems(session, inputId = "tabs", selected = "charts")
})
observeEvent(input$goWidgets, {
updateTabItems(session, inputId = "tabs", selected = "widgets")
})
}
shinyApp(ui, server)

Shinydashboard Sidebar Beginner Question -- Bulletpoints

My first shinydashboard app looks good so far, except for the bullet points in the sidebar. What am I doing wrong?
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(title="First App"),
shinydashboard::dashboardSidebar(
shinydashboard::menuItem("Accounts", tabName = "accounts", icon = shiny::icon("users")),
shinydashboard::menuItem("Topics", icon = shiny::icon("hashtag"),
shinydashboard::menuSubItem("Multi-Topic-View", tabName = "topics_multi"),
shinydashboard::menuSubItem("Single-Topic-View", tabName = "topic_single"),
shinydashboard::menuSubItem("Tweet-View", tabName = "topic_tweet")
)
),
shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem(tabName="accounts", shiny::h2("Account tab content")),
shinydashboard::tabItem(tabName="topics_multi", shiny::h2("Multi Topic tab content")),
shinydashboard::tabItem(tabName="topic_single", shiny::h2("Single Topic tab content")),
shinydashboard::tabItem(tabName="topic_tweet", shiny::h2("Tweet Topic tab content"))
)
)
)
server <- function(input, output) { }
app <- shiny::shinyApp(ui, server)
shiny::runApp(app, launch.browser=TRUE)
Here is a Screenshot when I run this code in Google Chrome on a Windows machine (R version 4.0.3, shinydashboard_0.7.1, shiny_1.6.0). Can I get rid of the bullet points?
Use sidebarMenu(id = "tabs",...) in dashboardSidebar() to eliminate bullet points. You can define your id as you wish.
ui <- shinydashboard::dashboardPage(
shinydashboard::dashboardHeader(title="First App"),
dashboardSidebar(
sidebarMenu(id = "tabs", # Setting id makes input$tabs give the tabName of currently-selected tab
menuItem("Accounts", tabName = "accounts", icon = icon("users")),
menuItem("Topics", icon = shiny::icon("hashtag"),
menuSubItem("Multi-Topic-View", tabName = "topics_multi"),
menuSubItem("Single-Topic-View", tabName = "topic_single"),
menuSubItem("Tweet-View", tabName = "topic_tweet")
))
),
shinydashboard::dashboardBody(
tabItems(
tabItem(tabName="accounts", shiny::h2("Account tab content")),
tabItem(tabName="topics_multi", shiny::h2("Multi Topic tab content")),
tabItem(tabName="topic_single", shiny::h2("Single Topic tab content")),
tabItem(tabName="topic_tweet", shiny::h2("Tweet Topic tab content"))
)
)
)
server <- function(input, output, session) { }
shinyApp(ui, server)

Shiny dataTableOutput won't show up if its is under tabItem

My Shiny APP has a simple structure looks like:
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard",
selectInput('location', 'Please Select a Location', choices= c("A", "B", "C")),
downloadButton(outputId = 'download', lable = "Downlaod"),
menuItem("Widgets", tabName = "widgets", badgeLabel = "new", badgeColor = "green")
)),
# dashboardBody first try (works no problem):
dashboardBody(DT::dataTableOutput(outputId = 'mytable'))
# dashboardBody second try (data table does not appear):
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
DT::dataTableOutput(outputId = 'mytable')),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
)))
server <- shinyServer(function(input, output, session){
output$mytable<- DT::renderDataTable({```some calculation```})
output$downloadcsv <- downloadHandler(
filename = function(){paste0(sys.Date(),'-mytable.csv')},
content = function(file) {write.csv(```the table from renderDataTable step```, file)}
)}
As you can see, the app includes two different "pages" where the first one is a data table depends on the selectInput.
My app runs perfectly if I don't wrap it with tabItem. However, once I write it under tabItem, the app only shows "Widgets tab content" which is the content of the second tab and does not populate the data table at all (while the download button still works).
I've also tried to add class='active' behind tabName = "dashboard", but it still doesn't work. Plus, I'm not getting any error message.
I'm wondering if anyone knows which step did I go wrong? Any help would be appreciated!
The problem lies in the placement of the table. I have rendered input options outside the menuItem. Check this code below
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
selectInput('location', 'Please Select a Location', choices= c("A", "B", "C")),
downloadButton(outputId = 'download.csv', lable = "Downlaod"),
menuItem("Dashboard", tabName = "dashboard"),
menuItem("Widgets", tabName = "widgets", badgeLabel = "new", badgeColor = "green")
)),
# dashboardBody first try (works no problem):
#dashboardBody(DT::dataTableOutput(outputId = 'mytable'))
#dashboardBody second try (data table does not appear):
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
DT::dataTableOutput(outputId = 'mytable')),
tabItem(tabName = "widgets",
h2("Widgets tab content"))
))
))
server <- function(input, output, session){
output$mytable<- DT::renderDataTable({DT::datatable(head(iris))})
output$downloadcsv <- downloadHandler(
filename = function(){paste0(sys.Date(),'-mytable.csv')},
content = function(file) {write.csv(head(iris), file)}
)}
shinyApp(ui=ui, server=server)

R Shiny source functions into ui.R

When developing a big Shiny app, the ui.R could get really messy even if we correctly indent every line of the code with consistent style.
In R package shinydashboard, we could define menuItems in the sidebarMenu first and then work on the specific tabItem by the tabName(defined in the menuItems) later in the code. This is a really helpful feature for tidying the code.
Here is an example from its official website:
## ui.R ##
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# Put them together into a dashboardPage
dashboardPage(
dashboardHeader(title = "Simple tabs"),
sidebar,
body
)
However in my real work, I tend to design every piece of the web myself so shinydashboard is not my choice. How can I do the same thing as the shinydashboard could do, like
# define the structure first
tabsetPanel(
tab1,
tab2
)
# then work on each tab
tab1 = tabPanel("tab1", ....),
tab2 = tabPanel("tab2", ....)
I tried with the renderUI function but it's not working very well (you can't put uiOutput directly in tabsetPanel). Is there any better way to do this?

Navigate to particular sidebar menu item in ShinyDashboard?

(cross post from shiny google groups, https://groups.google.com/forum/#!topic/shiny-discuss/CvoABQQoZeE)
How can one navigate to a particular sidebar menu item in ShinyDashboard?
sidebarMenu(
menuItem("Menu Item 1")
menuItem("Menu Item 2")
)
i.e. how can I put a button on the "Menu Item 1" page that will link to "Menu Item 2"?
To navigate between tabs I am using the updateTabsetPanel function:
observeEvent(input$go,{
updateTabsetPanel(session, "tabset1", selected = "Step 2")
})
I believe I should be able to use a similar function to navigate to a sidebar menu, but I am not sure what that is.
Any pointers greatly appreciated
Thanks
Iain
Is this what you are looking for? note that the example is taken from Change the selected tab on the client
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Simple tabs"),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Menu Item 1", tabName = "one", icon = icon("dashboard")),
menuItem("Menu Item 1", tabName = "two", icon = icon("th"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "one",h2("Dashboard tab content"),actionButton('switchtab', 'Switch tab')),
tabItem(tabName = "two",h2("Widgets tab content"))
)
)
)
server <- function(input, output, session) {
observeEvent(input$switchtab, {
newtab <- switch(input$tabs, "one" = "two","two" = "one")
updateTabItems(session, "tabs", newtab)
})
}
shinyApp(ui, server)

Resources