代码之家  ›  专栏  ›  技术社区  ›  JeanBertin

r发光仪表板主体取决于发光子项选择

  •  1
  • JeanBertin  · 技术社区  · 6 年前

    它是一种根据闪亮的子项选择创建闪亮的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)
    

    事先谢谢!

    2 回复  |  直到 6 年前
        1
  •  1
  •   Jim Chen    6 年前

    这就是你需要的吗??

    你可以添加一个 id 论点 sidebarMenu ,然后添加 observeEvent 对象触发者 input$sidebarmenu

    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)
    
        2
  •  1
  •   qfazille    6 年前

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

    下面的代码可以完成以下工作:

    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)