Отправка сообщений из Shiny в JavaScript

Question

Я пытаюсь вызывать функцию JavaScript из Shiny каждый раз, когда нажимается вкладка приложения.Мне нужно отправить имя вкладки в пользовательскую функцию JS.В качестве простейшего варианта я вызываю функцию alert() из R и передаю ей название вкладки.По какой-то причине мой код не работает, и окно с сообщением не появляется, хотя я скопировал пример .

library(shiny)
library(shinydashboard)
library(shinyjs)

ui = dashboardPage(

  dashboardHeader(title = "Shiny"),

  dashboardSidebar(
    sidebarMenu(id = "tabs",

                menuItem("Section_1", tabName = "section_1", icon = icon("align-justify"), 
                         startExpanded = TRUE, selected = TRUE,
                         menuSubItem("Subsection 1", tabName = "report_1", selected = TRUE),
                         menuSubItem("Subsection 2", tabName = "report_2")),
                menuItem("Section_2", tabName = "section_2", icon = icon("align-justify"))

    )
  ),

  dashboardBody(

    useShinyjs(),

    tags$head(tags$script("Shiny.addCustomMessageHandler('handler1', alert(tab_name))")),

    tabItems(
      tabItem("report_1", h1(id = "a", "a")),
      tabItem("report_2", h1(id = "b", "b")),
      tabItem("section_2", h1(id = "c", "c")))
  )
)


server <- function(input, output, session) {

  observe({ 

    if(input$tabs == "report_1") {
      print(input$tabs)
      tab_name = as.character(input$tabs)
      session$sendCustomMessage(type = "handler1", tab_name)
    } else if(input$tabs == "report_2"){
      print(input$tabs)
      tab_name = as.character(input$tabs)
      session$sendCustomMessage(type = "handler1", tab_name)
    } else if (input$tabs == "section_2"){
      print(input$tabs)
      tab_name = as.character(input$tabs)
      session$sendCustomMessage(type = "handler1", tab_name)
    }

  })
}

shinyApp(ui=ui, server=server) 

Answer 1

Напишите функцию внутри addCustomMessageHandler примерно так:

library(shiny)
library(shinydashboard)
library(shinyjs)

ui = dashboardPage(

  dashboardHeader(title = "Shiny"),

  dashboardSidebar(
    sidebarMenu(id = "tabs",

                menuItem("Section_1", tabName = "section_1", icon = icon("align-justify"), 
                         startExpanded = TRUE, selected = TRUE,
                         menuSubItem("Subsection 1", tabName = "report_1", selected = TRUE),
                         menuSubItem("Subsection 2", tabName = "report_2")),
                menuItem("Section_2", tabName = "section_2", icon = icon("align-justify"))

    )
  ),

  dashboardBody(

    useShinyjs(),

    tags$head(tags$script('Shiny.addCustomMessageHandler("handler1", function(message) {
                            alert(JSON.stringify(message));
                          })')),

    tabItems(
      tabItem("report_1", h1(id = "a", "a")),
      tabItem("report_2", h1(id = "b", "b")),
      tabItem("section_2", h1(id = "c", "c")))
  )
)


server <- function(input, output, session) {

  observe({ 

    if(input$tabs == "report_1") {
      print(input$tabs)
      tab_name = as.character(input$tabs)
      session$sendCustomMessage(type = "handler1", tab_name)
    } else if(input$tabs == "report_2"){
      print(input$tabs)
      tab_name = as.character(input$tabs)
      session$sendCustomMessage(type = "handler1", tab_name)
    } else if (input$tabs == "section_2"){
      print(input$tabs)
      tab_name = as.character(input$tabs)
      session$sendCustomMessage(type = "handler1", tab_name)
    }

  })
}

shinyApp(ui=ui, server=server)