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

Question

我想通过单击在弹出窗口中显示数据表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)

Answer 1

您可以onclick使用shinyjs. 因此，您需要添加useShinyjs()您的 ui，您可以通过将您的 ui 包装在tagList.

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

onclick下一部分是在触发事件时创建一个弹出窗口。您可以使用showModal函数 from来做到这一点shinyBS。

工作示例

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)