R Shiny 的仪表板主体依赖于 Shiny 的子项目选择

Question

这是一种根据 Shiny 的子项选择创建 Shiny 的 observeEvent 的方法吗？

在下面的可重现示例中，我想在单击子菜单 1 时自动执行按钮 1，在单击子菜单 2 时自动执行按钮 3。

library(shinydashboard)
library(shiny)


ui <- dashboardPage(
 dashboardHeader(title = "Dynamic sidebar"),
 dashboardSidebar(
   sidebarMenuOutput("menu")
 ),
dashboardBody(heigth = 800,  tabItems(
                                     tabItem(tabName = "submenu_1",
                                             fluidRow(
                                               actionButton(inputId = "button_1",label = "Button 1",  icon = icon("fa"),width = '417px'),
                                               actionButton(inputId = "button_2",label = "Button 2",  icon = icon("fa"),width = '417px')
                                             )
                                     ),
                                       tabItem(tabName = "submenu_2",
                                               fluidRow(
                                                 actionButton(inputId = "button_3",label = "Button 3",  icon = icon("fa"),width = '417px'),
                                                 actionButton(inputId = "button_4",label = "Button 4",  icon = icon("fa"),width = '417px')
                                               )
                                       )

                        ),
            textOutput("text")
            )
)


server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
  menuItem("Menu item 1", 
           menuSubItem('Submenu 1',tabName = 'submenu_1',icon = icon('line-chart')),
           menuSubItem('Submenu 2',tabName = 'submenu_2',icon = icon('line-chart'))
           )
)
})


 observeEvent(input$button_1,{output$text <- renderText("Buutton 1 must be selected by default on Submenu 1")})
 observeEvent(input$button_2,{output$text <- renderText("You have selected button 2")})
 observeEvent(input$button_3,{output$text <- renderText("Buutton 3 must be selected by default on Submenu 2 ")})
 observeEvent(input$button_4,{output$text <- renderText("You have selected button 4")})
}

shinyApp(ui, server)

提前致谢!

Answer 1

这是你需要的吗？？

你可以在sidebarMenu中添加一个id参数，然后添加一个由input$sidebarmenu触发的observeEvent对象>

library(shinydashboard)
library(shiny)


ui <- dashboardPage(
  dashboardHeader(title = "Dynamic sidebar"),
  dashboardSidebar(
    sidebarMenuOutput("menu")
  ),
  dashboardBody(heigth = 800,  tabItems(
    tabItem(tabName = "submenu_1",
            fluidRow(
              actionButton(inputId = "button_1",label = "Button 1",  icon = icon("fa"),width = '417px'),
              actionButton(inputId = "button_2",label = "Button 2",  icon = icon("fa"),width = '417px')
            )
    ),
    tabItem(tabName = "submenu_2",
            fluidRow(
              actionButton(inputId = "button_3",label = "Button 3",  icon = icon("fa"),width = '417px'),
              actionButton(inputId = "button_4",label = "Button 4",  icon = icon("fa"),width = '417px')
            )
    )

  ),
  textOutput("text")
  )
)


server <- function(input, output) {
  output$menu <- renderMenu({
    sidebarMenu(id = "sidebarmenu",
      menuItem("Menu item 1", 
               menuSubItem('Submenu 1',tabName = 'submenu_1',icon = icon('line-chart')),
               menuSubItem('Submenu 2',tabName = 'submenu_2',icon = icon('line-chart'))
      )
    )
  })

  observeEvent(input$sidebarmenu,{
    output$text <- renderText({
      if(input$sidebarmenu=="submenu_1"){
        "Buutton 1 must be selected by default on Submenu 1"
      }else if(input$sidebarmenu=="submenu_2"){
        "Buutton 3 must be selected by default on Submenu 2 "
      }
    })
  })

  observeEvent(input$button_1,{
    output$text <- renderText("Buutton 1 must be selected by default on Submenu 1")
  })
  observeEvent(input$button_2,{
    output$text <- renderText("You have selected button 2")
  })
  observeEvent(input$button_3,{
    output$text <- renderText("Buutton 3 must be selected by default on Submenu 2 ")
  })
  observeEvent(input$button_4,{
    output$text <- renderText("You have selected button 4")
  })

}

shinyApp(ui, server)