I have create an app using shinydashboard with a group of menuItems and menuSubItems as well as the coresponding tabItems, and there is a conditionalPanel with different input parameters for each menuSubItems, and an actionButton for different analysing and ploting task, now it works before the actionButton is clicked, that is, the conditionalPanel changed when switching between menuSubItems, and it also works well for the first time actionButton is clicked, that is it show a plot html as expected, but after the first clicked of actionButton, the conditionalPanel no longer changed as before when switching between menuSubItems, it seems that the menuSubItems can not update when clicked by mouse in the ui.
exactly, there is two problems:
before the runButton is clicked, the condtional parinbox changed correctly when switching between menusubItems, and it can swithching between menusubItems freely, and when the first time the runButton is clicked, a html with a plot is generated and loaded as expected, while it does not work for the second time when swithching to another menusubItem, the input$sidebarmenu seems not changed?
How to uncollapse the parinbox when a menusubItem is clicked?
Dean Attali has kindly pointed that tabname of menusubItems is not actually going to be the ID of the submenu element in the app, may be this is the cause, but I do not how to fix it, any help is appreciated.
a minimal repeatable code is as below:
library(shiny)
library(shinyjs)
library(shinydashboard)
library(knitr)
library(markdown)
library(rmarkdown)
library(ggplot2)
# parinbox #############################
jsboxcollapsecode <- "shinyjs.collapse = function(boxid) {
$('#' + boxid).closest('.box').find('[data-widget=collapse]').click();
}
"
selDateRange=dateRangeInput('dateRange',label='time:',start=Sys.Date()-7,end=Sys.Date()-1)
selcompyear=textInput("compyear",label="compyear:")
selmetsInput=selectInput(inputId="selmets",label="item:",choices=c("a","b","c"),selected=c("a","b"),multiple=TRUE)
condselcompyear =conditionalPanel("input.sidebarmenu=='subItemOne'||input.sidebarmenu=='subItemFour'",selcompyear)
condselmetsInput=conditionalPanel("input.sidebarmenu=='subItemThree'",selmetsInput)
runButton=actionButton(inputId="runButton",label=strong("run"),width=100)
opendirButton=actionButton(inputId="opendirButton",label=strong("opendir"),width=100)
fluidrunopenButton=fluidRow(column(4,offset=1,runButton),column(width=4,offset=1,opendirButton))
parInbox=box(id="parbox",title="Input parameter",status="primary",solidHeader=TRUE,collapsible=TRUE,collapsed=FALSE,width='auto',
selDateRange,condselcompyear,condselmetsInput,fluidrunopenButton)
absParInPanel=absolutePanel(id="parinbox",top=80,right=0,width=300,draggable=TRUE,parInbox)
# Sidebar #############################
sidebar <- dashboardSidebar(
tags$head(
tags$script(
HTML(
"
$(document).ready(function(){
// Bind classes to menu items, easiet to fill in manually
var ids = ['subItemOne','subItemTwo','subItemThree','subItemFour'];
for(i=0; i<ids.length; i++){
$('a[data-value='+ids[i]+']').addClass('my_subitem_class');
}
// Register click handeler
$('.my_subitem_class').on('click',function(){
// Unactive menuSubItems
$('.my_subitem_class').parent().removeClass('active');
})
})
"
)
)
),
width = 290,
sidebarMenu(id='sidebarmenu',
menuItem('Menu One', tabName = 'menuOne', icon = icon('line-chart'),
menuSubItem('Sub-Item One', tabName = 'subItemOne'),
menuSubItem('Sub-Item Two', tabName = 'subItemTwo')),
menuItem('Menu Two', tabName = 'menuTwo', icon = icon('users'),
menuSubItem('Sub-Item Three', tabName = 'subItemThree'),
menuSubItem('Sub-Item Four', tabName = 'subItemFour')))
# sidebarMenu(
# menuItem('Menu Two', tabName = 'menuTwo', icon = icon('users'),
# menuSubItem('Sub-Item Three', tabName = 'subItemThree'),
# menuSubItem('Sub-Item Four', tabName = 'subItemFour')))
)
# Body #############################
body <- dashboardBody(
useShinyjs(),
extendShinyjs(text=jsboxcollapsecode),
absParInPanel,
tabItems(
tabItem(tabName = 'subItemOne',
h2('Selected Sub-Item One'),uiOutput('subItemOne_html')),
tabItem(tabName = 'subItemTwo',
h2('Selected Sub-Item Two'),uiOutput('subItemTwo_html')),
tabItem(tabName = 'subItemThree',
h2('Selected Sub-Item Three'),uiOutput('subItemThree_html')),
tabItem(tabName = 'subItemFour',
h2('Selected Sub-Item Four'),uiOutput('subItemFour_html'))
)
)
# UI #############################
ui <- dashboardPage(
dashboardHeader(title = 'Test', titleWidth = 290),
sidebar,
body
)
# Server #############################
server <- function(input, output){
shinyOutput<- function(input=NULL){
sidebarmenu=input$sidebarmenu
start=as.Date(format(input$dateRange[1]))
end=as.Date(format(input$dateRange[2]))
time=seq(from=start,to=end+5,by="day")
gdata=data.frame(x=time,y=sample(1:100,length(time)))
if(sidebarmenu=='subItemOne'){
ggsave(ggplot(gdata,aes(x,y))+geom_line(),device="png",filename="tmp.png")
}else if(sidebarmenu=='subItemTwo'){
ggsave(ggplot(gdata,aes(x,y))+geom_col(),device="png",filename="tmp.png")
}else if(sidebarmenu=='subItemThree'){
ggsave(ggplot(gdata,aes(x,y))+geom_dotplot(),device="png",filename="tmp.png")
}else if(sidebarmenu=='subItemFour'){
ggsave(ggplot(gdata,aes(x,y))+geom_col(fill="red"),device="png",filename="tmp.png")
}
Rmdfile="tmp.Rmd"
writeLines(c("---","output: 'html_document'","---","```{r rcode,cache=FALSE}","knitr::include_graphics('tmp.png')","```"),Rmdfile)
shiny::includeHTML(rmarkdown::render(Rmdfile,clean=FALSE))
}
htmlvalues=reactive({
if(input$runButton==0) return()
isolate({
input$runButton
renderUI({shinyOutput(input)})
})
})
observeEvent(input$runButton,
{
js$collapse("parbox")
print(paste("the current selected submenu is",input$sidebarmenu,sep=":"))
output[[paste(input$sidebarmenu,"html",sep="_")]]=htmlvalues()
})
}
shinyApp(ui, server)
