R 闪亮的仪表板主体依赖于闪亮的子项选择

Question

这是一种从闪亮的子项选择中创建闪亮的观察事件依赖性的方法吗？

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

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)

Answer 2

诀窍是在UI部分设置参数id。

下面的代码完成了这项工作：

library(shinydashboard)
library(shiny)

ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenu(id="tabs",
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$tabs, {
req(input$tabs)
if (input$tabs == "submenu_1") {
# Do whatever you want when submenu_1 is selected
print("submenu_1 selected")
} else if (input$tabs == "submenu_2") {
# Do whatever you want when submenu_2 is selected 
print("submenu_2 selected")
}
})
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)