Связывание уведомления с вкладкой в ​​shinydashboard

Question

Я хочу связать notificattion с вкладкой (внутренней).

Для этого я наткнулся на это: 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 to shiny

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

3) observeEvent + пересборка меню

4) Если Dont 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 
)