将通知链接到shinydashboard中的选项卡

Question

我想将通知链接到（内部）标签。

为此，我来到这里：How to use href in shiny notificationItem?

这似乎在加载应用程序后正常工作，但在侧边栏中进行了一些导航后链接不再起作用。

ui.R

library(shiny)
library(shinydashboard)

notification <- notificationItem(icon = icon("exclamation-triangle"), status = "danger", paste0("noti"))
notification$children[[1]] <- a(href="#shiny-tab-dashboard","data-toggle"="tab", "data-value"="dashboard",list(notification$children[[1]]$children))

header <- dashboardHeader(dropdownMenu(notification), title = "Dashboard")

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Test",
             menuSubItem("test1", tabName = "test1", href = NULL, newtab = TRUE,
                         icon = shiny::icon("angle-double-right"), selected = F),
             menuSubItem("test2", tabName = "test2", href = NULL, newtab = TRUE,
                         icon = shiny::icon("angle-double-right"), selected = T)
    )
  )
)

body <- dashboardBody(
  tabItems(
    tabItem(tabName = "dashboard",
            h2("Dashboard tab content")
    ),

    tabItem(tabName = "test1",
            h2("Widgets tab1 content")
    ),

    tabItem(tabName = "test2",
            h2("Widgets tab2 content")
    )
  )
)

dashboardPage(
  header,
  sidebar,
  body
)

server.R

function(input, output) {

}

Answer 1

像以前那样糟糕的黑客变种）

的想法

1）添加onclick

2）从js到闪亮

 tags$script(HTML("function clickFunction(link){ 
                       Shiny.onInputChange('linkClicked',link);
    }"))

3）observeEvent +重新渲染菜单

4）如果不想重新渲染完整菜单，可以使用菜单

output$dropdown=renderMenu({dropdownMenu(type = "tasks", badgeStatus = "danger",.list = d$tasks_now)})

其中d=reactiveValues({tasks_now=get_noti()}) 并在observeEvent更新d$tasks_now

服务器

library(shiny)

get_noti=function(){
  notification <- notificationItem(icon = icon("exclamation-triangle"), status = "danger", paste0("noti"))
  notification$children[[1]] <- a(href="#shiny-tab-dashboard","onclick"=paste0("clickFunction('",paste0(substr(as.character(runif(1, 0, 1)),1,6),"noti"),"'); return false;"),list(notification$children[[1]]$children))
  return(notification)
}

shinyServer(function(input, output, session) {
  output$dropdown=renderMenu({dropdownMenu(get_noti())})
  observeEvent(input$linkClicked,{
    print(input$linkClicked)
    updateTabItems(session,"sidemenu",selected = "dashboard")
    output$dropdown=renderMenu({dropdownMenu(get_noti())})
  })
  })

UI

library(shiny)
library(shinydashboard)
header <- dashboardHeader(dropdownMenuOutput('dropdown'), title = "Dashboard")
 sidebar <- dashboardSidebar(
  sidebarMenu(id="sidemenu",
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Test",
             menuSubItem("test1", tabName = "test1", href = NULL, newtab = TRUE,
                         icon = shiny::icon("angle-double-right"), selected = F),
             menuSubItem("test2", tabName = "test2", href = NULL, newtab = TRUE,
                         icon = shiny::icon("angle-double-right"), selected = T)
    )))
body <- dashboardBody(
  tags$script(HTML("function clickFunction(link){ 
                       Shiny.onInputChange('linkClicked',link);
    }")),
  tabItems(
    tabItem(tabName = "dashboard",
            h2("Dashboard tab content")
    ),

    tabItem(tabName = "test1",
            h2("Widgets tab1 content")
    ),

    tabItem(tabName = "test2",
            h2("Widgets tab2 content")
    )
  )
)
dashboardPage(
  header,
  sidebar,
  body
)