r语言 - 闪亮仪表板的下拉菜单单击时菜单事件



关注此问题和答案 获取最近点击的通知闪亮仪表板中下拉菜单的项目

我在下面创建了应用程序,当单击任务项时,该应用程序可以很好地打开一个甜蜜的警报。

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)

但是两次点击相同的任务项不会再次打开甜蜜警报。只有在击中中间的另一个项目时,它才会再次打开。如何解决?

你可以在rstudio网站上找到一篇关于这个问题的好文章:https://shiny.rstudio.com/articles/js-send-message.html。

问题的根源:

警告:Shiny 仅侦听消息值的变化。 因此,如果您使用相同的参数调用doAwesomeThing2两次,则 第二次调用不会触发观察事件块,因为对象 您发送不变。

溶液:

这可以通过添加随机值来克服 到您的对象,这使对象作为一个整体显示为更改为 闪亮。在 R 中,您只需忽略对象的该部分即可。

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

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)

注意:

我假设你有shinyWidgetssweetalert()函数,但我无法添加showCloseButton参数,所以我删除了它。

最新更新