Question

每次尝试单击应用程序的选项卡时，我都试图从Shiny调用JavaScript函数。我需要将标签名称发送到自定义js函数。作为最简单的选项，我从R调用alert()函数并将选项卡的名称传递给它。由于某些原因，尽管我复制了example，但是我的代码无法正常工作，并且没有出现带有消息的窗口。

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)

将消息从Shiny发送到JavaScript

1 个答案: