如何在R Shiny的server端使用onclick函数并在点击按钮后获取URL

解决方案 #

你要实现服务端监听按钮点击后打开指定URL，有两种常用的可行方案： #

方案1：使用shinyjs包的onclick函数（需要先初始化shinyjs）

你原来的写法缺少shinyjs的初始化步骤，补上之后就能正常在服务端调用：

library(shiny)
library(shinyjs) # 导入shinyjs包

u_id<-"123"
inv_id <-222
url <- paste0("https://www.google.com/","?id=",u_id, "&inv_id=", inv_id)

ui <- fluidPage(
  useShinyjs(), # 必须在UI里添加这行完成shinyjs初始化
  titlePanel("open url"),
  sidebarLayout(
    sidebarPanel(
      actionButton("id",
                   label = "ADD COMMENT",
                   icon = icon("Click"))
    ),
    mainPanel()
  )
)

server <- function(input, output, session) {
  # 服务端直接调用onclick监听按钮点击
  onclick("id", sprintf("window.open('%s','win','resizable,height=400,width=400')",url)) 
}

shinyApp(ui, server)

方案2：不用额外依赖包，用Shiny原生功能实现

通过observeEvent监听按钮点击，搭配session$sendCustomMessage执行前端JS逻辑，灵活度更高，也支持动态生成URL：

library(shiny)

u_id<-"123"
inv_id <-222
url <- paste0("https://www.google.com/","?id=",u_id, "&inv_id=", inv_id)

ui <- fluidPage(
  # 注册接收服务端消息的JS函数
  tags$script(HTML('
    Shiny.addCustomMessageHandler("openUrl", function(url) {
      window.open(url,"win","resizable,height=400,width=400");
    })
  ')),
  titlePanel("open url"),
  sidebarLayout(
    sidebarPanel(
      actionButton("id",
                   label = "ADD COMMENT",
                   icon = icon("Click"))
    ),
    mainPanel()
  )
)

server <- function(input, output, session) {
  # 监听按钮点击事件，触发后给前端发消息打开链接
  observeEvent(input$id, {
    # 如果URL需要根据服务端动态数据生成，直接在这里重新计算url值即可
    session$sendCustomMessage("openUrl", url)
  })
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者Fariya