如何更改 R shiny 中的选项卡导航栏菜单?

问题描述 投票:0回答:0

我有一个带有侧边栏的 Shinyapp,你可以选择两个选项并在 Plot 选项卡中显示结果。在“单击绘图”选项卡中,当您单击“绘图”选项卡中的图形中的点时显示结果。因此,我希望当我单击点时打开“单击绘图”选项卡,以及如何配置获取每个选项卡的 href 的 url?我想我需要一些关于 Javascript 的东西,但我不确定。


# Libraries 
library(shiny)
library(bs4Dash)
library(plotly)

# function navbar menu and navbar tab
menu <- function(..., id = NULL) {
  
  if (is.null(id)) id <- paste0("tabs_", round(stats::runif(1, min = 0, max = 1e9)))
  
  tags$ul(
    ...,
    status = "primary",
    class = "navbar-nav dropdown sidebar-menu",
    role = "menu",
    div(
      id = id,
      class = "sidebarMenuSelectedTabItem",
      `data-value` = "null",
      
    )
  )
}

tab <- function(tabName, ..., icon = NULL) {
  tags$li(
    class = "nav-item",
    tags$a(
      class = "nav-link",
      id = paste0("tab-", tabName),
      href = paste0("#shiny-tab-", tabName),
      `data-toggle` = "tab",
      `data-value` = tabName,
      icon,
      tags$p(...)
    )
  )
}


ui <- dashboardPage(
    
    dark = NULL,
    
    header = dashboardHeader(
      menu(
        tab(tabName = "plot_", "Plot"),
        tab(tabName = "click", "Click Plot")
      )
    ),
    
    # sidebar ------------------------------------------------------------
    
    sidebar = dashboardSidebar(
      skin = "light",
      elevation = 3,
      radioButtons("plotType", "Plot Type:", choices = c("ggplotly", "plotly"))
    ),
    
    # dashboard body ----------------------------------------------------------
    
    body = dashboardBody(
      
      tabItems(
        
        # plot ---------------------------------------------------------------
        
        tabItem(
          tabName = "plot_",
          
          fluidRow(
            
            plotlyOutput("plot")
          )
        ),
        
        # click ---------------------------------------------------------------
        tabItem(tabName = "click",
                fluidRow(
                  verbatimTextOutput("click")
                  
                )
        )
        
      )
    )
  )

server <- function(input, output, session) {
  
  nms <- row.names(mtcars)
  
  output$plot <- renderPlotly({
    p <- if (identical(input$plotType, "ggplotly")) {
      ggplotly(ggplot(mtcars, aes(x = mpg, y = wt, customdata = nms)) + geom_point())
    } else {
      plot_ly(mtcars, x = ~mpg, y = ~wt, customdata = nms)
    }
    p %>% 
      layout(dragmode = "select") %>%
      event_register("plotly_selecting")
  })
  
  
  
  output$click <- renderPrint({
    d <- event_data("plotly_click")
    if (is.null(d)) "Select an event" else unique(d$x)
  })
  
}

shinyApp(ui, server)
javascript html shinyapps shinyjs
© www.soinside.com 2019 - 2024. All rights reserved.