將通知鏈接到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）如果不要wnat重新呈現完整的菜單您可以使用菜單

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 
)