jquery - 光沢のある: 各 menuSubItems の actionButton を使用したさまざまなタスク

Question

menuItems と menuSubItems のグループ、および対応する tabItems を使用して、shinydashboard を使用してアプリを作成しました。各 menuSubItems の異なる入力パラメーターを持つ conditionalPanel と、異なる分析およびプロット タスクの actionButton があり、actionButton の前に動作するようになりました。つまり、menuSubItems を切り替えると conditionalPanel が変更され、actionButton が初めてクリックされたときにもうまく機能します。つまり、期待どおりにプロット html が表示されますが、actionButton を最初にクリックした後、conditionalPanel は変更されなくなりました。以前と同じように、menuSubItems を切り替えるときに、UI でマウスでクリックしたときに menuSubItems が更新できないようです。

正確には、次の 2 つの問題があります。

1. runButton がクリックされる前に、menusubItems を切り替えるときに条件付き parinbox が正しく変更され、menusubItems を自由に切り替えることができ、runButton が初めてクリックされたときに、プロットを含む html が生成され、期待どおりに読み込まれますが、そうではありません。別の menusubItem に切り替えたときに 2 回目の作業を行いましたが、input$sidebarmenu は変更されていないようですか?

2. 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)