Shiny 数据表超链接栏目

Question

我正在尝试在 Shiny 数据表的一个/多个列中添加交互功能。 基本上，我正在尝试为选项卡 1 中的数据表创建一个指向列的所有值（例如 mpg）的超链接，并在选项卡 2 上显示该行数据。例如，对于数据表的第一行，mpg value (21) 将是一个超链接，当您单击 21 时，它将重定向到选项卡 2，该选项卡将显示与单击的行对应的所有其他列值。 这是我的代码的工作版本。

library(shiny)
library(DT)

ui <- fluidPage(
    titlePanel("reprex1")
    ,fluidRow(tabBox(
        tabPanel('Tab1', dataTableOutput("dt1")),
              tabPanel('Tab2'))
        
    )
)

server <- function(input, output) {
    output$dt1 <- renderDataTable({
        mtlocal <- mtcars
        for(n in 1:nrow(mtlocal)){
            mtlocal$actionbutton[[n]] <- as.character(
                actionButton(
                    paste0("buttonpress",n), label = paste0("buttonpress",n)
                )
            )
        }
        datatable(
            mtlocal
            , escape = FALSE
            , selection = "none"
            , options = list(
                preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
            )
        )
    }, server = FALSE)
    
    lapply(
        1:nrow(mtcars),function(x){
            observeEvent(
                input[[paste0("buttonpress",x)]],{
                    showModal(
                        modalDialog(
                            h2(paste0("You clicked on button ",x,"!"))
                        )
                    )
                }
            )       
        }
    )
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

您可以使用actionLink在数据表datatable创建适当的链接。 然后你所要做的就是听这个actionLink并在点击时填充一个reactive ，其中包含相应的数据行。 您在第二个选项卡上呈现此reactive ，并使用updateTabsetPanel跳转到第二个选项卡。

代码说了一千个单词，所以这里是：

library(shiny)
library(DT)
library(dplyr)
library(tibble)
library(purrr)

ui <- fluidPage(
   titlePanel("Link in Datatable"),
   tabsetPanel(
      tabPanel("Table",
               dataTableOutput("tab")),
      tabPanel("Details",
               dataTableOutput("details")),
      id = "ts"
   )
)

server <- function(input, output, session) {
   orig_data <- reactive({
      mtcars %>%
         rownames_to_column("id")
   })
   
   details <- reactiveVal(NULL)
   
   output$tab <- renderDataTable({
      orig_data() %>% 
         mutate(mpg = imap_chr(mpg,
                               function(mpg, idx) {
                                  actionLink(paste0("to_details_", idx),
                                             mpg) %>% 
                                     as.character()
                               })
         ) %>% 
         datatable(escape = FALSE, 
                   selection = "none", 
                   rownames = FALSE,
                   options = list(
                      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                   ))
   })
   
   output$details <- renderDataTable({
      details() %>% 
         datatable()
   })
   
   obs <- lapply(1:nrow(orig_data()), function(idx) {
      observeEvent(input[[paste0("to_details_", idx)]], {
         details(orig_data() %>% 
                    slice(idx))
         updateTabsetPanel(session, "ts", selected = "Details")
      })
   })
}

shinyApp(ui, server)