如何在 r shiny 中使用 DT / renderDataTable() 根据来自三个不同摘要 table 的输入显示详细 table

How do I display detailed table on the basis of inputs from three different summary tables using DT / renderDataTable() in r shiny

我有三个不同的数据框,显示了具有不同行数和列数的完全不同的数据。我在闪亮屏幕的左栏中将所有这些都一个一个地显示在另一个下方。在右侧,我想显示一个详细的数据框,具体取决于左侧所选 table(三个中的)的所选行。

input$tableId_cell_clickedinput$tableId_rows_selected 非常有用,如果我必须从一个数据框中选择并根据所选行或单击的单元格显示其他数据框。

是否有任何输入参数可以帮助我获取 table / 数据框(共三个),用户在其中单击了选定的单元格或行。这将使我能够根据用户输入的 table 和行输入在闪亮屏幕的右侧显示详细的 table?

示例如下:

library(shiny)
library(DT)                     # datatable()
library(shinydashboard)


ui <-fluidPage(
  dashboardPage(
    dashboardHeader(disable = TRUE),
    dashboardSidebar(disable = TRUE, width = NULL, collapsed = TRUE),
    dashboardBody(            
      fixedRow(
        column(4, 
               dataTableOutput("summary_abc"), 
               dataTableOutput("summary_def"), 
               dataTableOutput("summary_ghi")),
        column(5, 
               textOutput("employee_details")))
    )))

server <- shinyServer(function(input, output, session) {
  output$summary_abc <- renderDataTable({
    options(DT.options = list(pageLength = 10, searching = FALSE, paging = FALSE))
    
    employee <- c('John Doe','Peter Gynn','Jolie Hope')
    salary <- c(21000, 23400, 26800)
    age <- c(45,63,28)
    data1 <- data.frame(employee, salary, age)
    
    table_1 <- data1
    table_1 <- datatable(table_1, class = 'cell-border stripe', selection = "single",
                         options = list(ordering=F, dom = 't'),
                         caption = "Summary 1", rownames = FALSE)
    table_1})
  
  output$summary_def <- renderDataTable({
    options(DT.options = list(pageLength = 10, searching = FALSE, paging = FALSE))
    
    employee <- c('John Doe','Peter Gynn','Jolie Hope')
    qualification <- c("Graduate", "Post Graduate", "Master")
    experience <- c(8,5,17)
    data2 <- data.frame(employee, qualification, experience)
    
    table_1 <- data2
    table_1 <- datatable(table_1, class = 'cell-border stripe', selection = "single",
                         options = list(ordering=F, dom = 't'),
                         caption = "Summary 2", rownames = FALSE)
    table_1})
  
  output$summary_ghi <- renderDataTable({
    options(DT.options = list(pageLength = 10, searching = FALSE, paging = FALSE))
    
    employee <- c('John Doe','Peter Gynn','Jolie Hope', "Jackson")
    weight <- c(60,58,72,59)
    temperature <- c(95,97,96,98)
    data3 <- data.frame(employee, weight, temperature)
    
    table_1 <- data3
    table_1 <- datatable(table_1, class = 'cell-border stripe', selection = "single",
                         options = list(ordering=F, dom = 't'),
                         caption = "Summary 3", rownames = FALSE)
    table_1})
  
  
  output$employee_details <- renderText(
    {
      table_selected <- "Summary 2"
      row_selected <- 3
      paste("Table: ", table_selected, "Row: ", row_selected)
      
    }
  )
  
  
  
})

shinyApp(ui = ui, server = server)

您可以使用反应值来保存最新的 table 点击和每次更改的任意进一步信息。

将此添加到您的服务器函数并更改您的文本输出:

table_reac <- reactiveValues()
observeEvent(input$summary_abc_rows_selected, {
  table_reac$title <- "Summary 1"
  table_reac$row <- input$summary_abc_rows_selected
})
observeEvent(input$summary_def_rows_selected, {
  table_reac$title <- "Summary 2"
  table_reac$row <- input$summary_def_rows_selected
})
observeEvent(input$summary_ghi_rows_selected, {
  table_reac$title <- "Summary 3"
  table_reac$row <- input$summary_ghi_rows_selected
})

output$employee_details <- renderText(
  {
    table_selected <- table_reac$title
    row_selected <- table_reac$row
    
    paste("Table: ", table_selected, "Row: ", row_selected)
    
  }
)