Shiny：通过单击 valueBox 触发弹出窗口

Posted 2023-03-24

【中文标题】Shiny：通过单击 valueBox 触发弹出窗口

【英文标题】：Shiny: Trigger a popup by clicking a valueBox

【发布时间】：2019-09-07 09:14:24

【问题描述】：

我想通过单击valueBox 在弹出窗口中显示数据表。 valueBox 本身应该作为actionButton 工作。

当我点击valueBox 时，它应该会在弹出窗口中呈现一个表格，如下图所示。

任何人都可以帮助解决此代码吗？

我的代码：

library(shiny)
library(shinydashboard)

data <- iris

ui <- dashboardPage(
  dashboardHeader(title = "Telemedicine HP"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      valueBox( 60, subtitle = tags$p("Attended", style = "font-size: 200%;"),
                icon = icon("trademark"), color = "purple", width = 4,
                href = NULL))))

server <- function(input,output)


shinyApp(ui, server)

【参考方案1】：

您可以使用shinyjs 创建onclick 事件。因此，您需要在您的 ui 中添加 useShinyjs()，您可以通过将您的 ui 包装在 tagList 中来做到这一点。

当单击具有给定 ID 的元素时，会在您的服务器中触发 onclick 函数。所以你还需要给valueBox一个ID。我决定将它包装在带有 ID 的 div 中。

下一部分是在触发onclick 事件时创建一个弹出窗口。您可以使用shinyBS 中的showModal 函数来执行此操作。

工作示例

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

data <- iris

ui <- tagList(
  useShinyjs(),
  dashboardPage(
    dashboardHeader(title = "Telemedicine HP"),
    dashboardSidebar(),
    dashboardBody(
      fluidRow(
        div(id='clickdiv',
            valueBox(60, subtitle = tags$p("Attended", style = "font-size: 200%;"), icon = icon("trademark"), color = "purple", width = 4, href = NULL)
        )
      )
    )
  )
)

server <-  function(input, output, session)
  onclick('clickdiv', showModal(modalDialog(
    title = "Your title",
    renderDataTable(data)
  )))


shinyApp(ui, server)

【讨论】：

没有模态的方法不适用于output$table <- renderDataTable

【参考方案2】：

这是另一个没有shinyjs的解决方案

library(shiny)
library(shinydashboard)
library(shinyBS)

data <- iris

ui <- tagList(
  dashboardPage(
    dashboardHeader(title = "Telemedicine HP"),
    dashboardSidebar(),
    dashboardBody(
      fluidRow(
        div(id='clickdiv',
            valueBox(60, subtitle = tags$p("Attended", style = "font-size: 200%;"), icon = icon("trademark"), color = "purple", width = 4, href = NULL)
        )
      ),
      bsModal("modalExample", "Data Table", "clickdiv", size = "large",dataTableOutput("table"))
    )
  )
)

server <-  function(input, output, session)

  output$table <- renderDataTable(
    head(data)
  )



shinyApp(ui, server)