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

Question

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

当我单击 valueBox 时，它应该在弹出窗口 window 中呈现 table，如下图所示。

任何人都可以帮助这个代码吗？

我的代码：

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)

Answer 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)

Answer 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)

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

Shiny: Trigger a popup by clicking a valueBox

r

shiny

shinydashboard

shinyjs

shinybs