点击 shinydashboard 的 dropdownMenu 事件

Question

关注此问答

我创建了下面的应用程序，它在单击任务项时会很好地打开一个 sweetalert。

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(tidyverse)
ui <- fluidPage(
    dashboardPage(
        dashboardHeader(dropdownMenuOutput("dropdownmenu")),
        dashboardSidebar(),
        dashboardBody(
            tags$script(HTML("function clickFunction(link){ Shiny.onInputChange('linkClicked',link);}")),

    )))

server = shinyServer(function(input, output, session){
    output$dropdownmenu = renderMenu({

        aa <- 1:2 %>% 
           map(~taskItem(text = paste("This is no", .), value = ., color = c("red", "blue")[.]))

        for(i in 1:length(aa)){
            aa[[i]]$children[[1]] <- a(href="#","onclick"=paste0("clickFunction('",paste("This is no", i),"'); return false;"),
                                              aa[[i]]$children[[1]]$children)
        }
        dropdownMenu(type = "tasks", badgeStatus = "warning",
                     .list = aa)
    })


   observeEvent(input$linkClicked, {
        sendSweetAlert(
            session = session,
            text = input$linkClicked,
            type = "info",
            showCloseButton = TRUE)
    })
})

shinyApp(ui = ui, server = server)

但是两次点击同一个taskItem不会再次打开sweetalert。它只会在中间击中另一个项目时再次打开。如何解决？

Answer 1

您可以在 rstudio 网站上找到一篇关于此的好文章：https://shiny.rstudio.com/articles/js-send-message.html。

问题根源：

Caveat: Shiny only listens for changes in the value of a message. Hence, if you call doAwesomeThing2 twice with the same arguments, the second call will not trigger the observeEvent block because the object you send is unchanged.

解法：

This can be overcome by adding a random value to your object, which makes the object as a whole appear changed to Shiny. In R, you simply ignore that part of the object....

因此在您的情况下，您可以将代码更改为：

tags$script(HTML("function clickFunction(link){
                      var rndm = Math.random();
                       Shiny.onInputChange('linkClicked', {data:link, nonce: Math.random()});}"
      ))

对触发输入的调用将是：

input$linkClicked$data

完整的可复制示例：

library(shiny)
library(shinydashboard)
library(tidyverse)
library(shinyWidgets)

ui <- fluidPage(
  dashboardPage(
    dashboardHeader(dropdownMenuOutput("dropdownmenu")),
    dashboardSidebar(),
    dashboardBody(
      tags$script(HTML("function clickFunction(link){
                      var rndm = Math.random();
                       Shiny.onInputChange('linkClicked', {data:link, nonce: Math.random()});}"
      )),

    )))

server = shinyServer(function(input, output, session){
  output$dropdownmenu = renderMenu({

    aa <- 1:2 %>% 
      map(~taskItem(text = paste("This is no", .), value = ., color = c("red", "blue")[.]))

    for(i in 1:length(aa)){
      aa[[i]]$children[[1]] <- a(href="#","onclick"=paste0("clickFunction('",paste("This is no", i),"'); return false;"),
                                 aa[[i]]$children[[1]]$children)
    }
    dropdownMenu(type = "tasks", badgeStatus = "warning",
                 .list = aa)
  })


  observeEvent(input$linkClicked, {
    sendSweetAlert(
      session = session,
      text = input$linkClicked$data,
      type = "info"
    )
  })
})

shinyApp(ui = ui, server = server)

注：

我假设你有 shinyWidgets 的 sweetalert() 函数，但我没有添加 showCloseButton 参数的可能性，所以我删除了它。

点击 shinydashboard 的 dropdownMenu 事件

shinydashboard's dropdownMenu event on click

r

shiny

sweetalert

shinydashboard