将通知链接到shinydashboard中的选项卡 [英] Linking notification to tab in shinydashboard

问题描述

我要将通知链接到(内部)选项卡。

为此，我遇到了以下情况：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
)

服务器.R

function(input, output) {

}

推荐答案

和以前一样糟糕的黑客变体)

想法

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()}) 和观察事件更新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())})
  })
  })

用户界面

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
)

这篇关于将通知链接到shinydashboard中的选项卡的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！