我已经使用 shinydashboard 创建了一个应用程序，其中包含一组 menuItems 和 menuSubItems 以及对应的 tabItems，并且每个 menuSubItems 都有一个具有不同输入参数的条件面板，以及一个用于不同分析和绘图任务的 actionButton，现在它在 actionButton 之前工作被点击，也就是在menuSubItems之间切换时conditionalPanel发生了变化，第一次点击actionButton也很好用，就是按预期显示了一个plot html，但是第一次点击actionButton后，conditionalPanel不再变化和之前在 menuSubItems 之间切换时一样，在 ui 中用鼠标单击时，menuSubItems 似乎无法更新。
确切地说，有两个问题：
在单击runButton之前，在menusubItems之间切换时条件parinbox正确更改，并且可以在menusubItems之间自由切换，并且当第一次单击runButton时，会按预期生成并加载带有plot的html，而它没有第二次工作时切换到另一个menusubItem，input$sidebarmenu 似乎没有改变？
单击menusubItem时如何展开parinbox？
Dean Attali 友好地指出 menusubItems 的 tabname 实际上并不是应用程序中子菜单元素的 ID，可能是这个原因，但我不知道如何解决它，感谢任何帮助。
一个最小的可重复代码如下：
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)