Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

tabItem cannot show the content when more functions in menuItem using shiny and shinydashboard

I am learning shiny and shinydashboard. My code is like this:

library(shiny)
library(shinydashboard)
library(DT)
library(RODBC)
library(stringr)
library(dplyr)
ch<-odbcConnect('B1P HANA',uid='fchen4',pwd='XUEqin0312')
sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Query1",tabName="Query1",icon=icon("table"),
         numericInput('Start1','Start Date',19800312,min=20170101,max=20200101),
         numericInput('End1','End Date',19800312,min=20170101,max=20200101),
         textInput('Office1','Office ID','0'),
         submitButton("Submit")),
    menuItem("Query2",tabName="Query2",icon=icon("table"),
         numericInput('Start2','Start Date',20180101,min=20170101,max=20200101),
         numericInput('End2','End Date',20180101,min=20170101,max=20200101),
         textInput('Office2','Office ID','0'),
         submitButton("Submit"))
  )
)
body <- dashboardBody(
  tabItems(
    tabItem(tabName="Query1",h2("Dashboard tab content")),
    tabItem(tabName = "Query2",h2("Widgets tab content"))
  )
)
ui <- dashboardPage(
  dashboardHeader(title = 'LOSS PREVENTION'),
  sidebar,
  body
)
server <- function(input, output) {
}
shinyApp(ui, server)

The dash board looks like this:

enter image description here

You can see that when I put some input boxes in side bar, The text cannot show in the main part.

However, when my code is like this:

library(shiny)
library(shinydashboard)
library(DT)
library(RODBC)
library(stringr)
library(dplyr)
ch<-odbcConnect('B1P HANA',uid='fchen4',pwd='XUEqin0312')
sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Query1",tabName="Query1",icon=icon("table")),
    menuItem("Query2",tabName="Query2",icon=icon("table"))
  )
)
body <- dashboardBody(
  tabItems(
    tabItem(tabName="Query1",h2("Dashboard tab content")),
    tabItem(tabName = "Query2",h2("Widgets tab content"))
  )
)
ui <- dashboardPage(
  dashboardHeader(title = 'LOSS PREVENTION'),
  sidebar,
  body
)
server <- function(input, output) {
}
shinyApp(ui, server)

Then the result is like this:

enter image description here

You can see that now there is no inputs in the side bar, Then the main bar has text now. This is so weird.

like image 975
Feng Chen Avatar asked Sep 01 '25 02:09

Feng Chen


1 Answers

This is actually a pretty annoying thing in shinydashboard currently. There are some workaround solutions provided here by Winston Chang, but the best solution in my opinion is this one:

Basically what happens is, when you insert other input elements into a menuItem, it loses the data-toggle and data-value attributes. Because of this, tabItems in dashboardBody can't link with the menuItems anymore and thus the app can't display the content in the body.

You can use a custom function (convertMenuItem) to set data-toggle and data-value manually so that menuItems and tabItems are linked again.

Code:

library(shiny)
library(shinydashboard)

convertMenuItem <- function(mi,tabName) {
  mi$children[[1]]$attribs['data-toggle']="tab"
  mi$children[[1]]$attribs['data-value'] = tabName
  mi
}

sidebar <- dashboardSidebar(
  sidebarMenu(
    convertMenuItem(menuItem("Query1",tabName="Query1",icon=icon("table"),
             numericInput('Start1','Start Date',19800312,min=20170101,max=20200101),
             numericInput('End1','End Date',19800312,min=20170101,max=20200101),
             textInput('Office1','Office ID','0'),
             submitButton("Submit")), tabName = "Query1"),
    convertMenuItem(menuItem("Query2",tabName="Query2",icon=icon("table"),
             numericInput('Start2','Start Date',20180101,min=20170101,max=20200101),
             numericInput('End2','End Date',20180101,min=20170101,max=20200101),
             textInput('Office2','Office ID','0'),
             submitButton("Submit")), tabName = "Query2")
  )
)
body <- dashboardBody(
  tabItems(
    tabItem(tabName="Query1", h2("Dashboard tab content")),
    tabItem(tabName = "Query2", h2("Widgets tab content"))
  )
)
ui <- dashboardPage(
  dashboardHeader(title = 'LOSS PREVENTION'),
  sidebar,
  body
)

server <- function(input, output) {}
shinyApp(ui, server)

Result

Result

like image 114
GyD Avatar answered Sep 02 '25 16:09

GyD