Shiny 数据表超链接栏目

Question

I am trying to add an interactive feature in one/multiple columns of a Shiny datatable. Basically, I am trying to create a hyperlink to all the values of a column (say, mpg) for the datatable in tab 1 and get that row data displayed on tab 2. For instance, for the first row of the datatable, the mpg value (21) would be a hyperlink and when you click on 21, it would redirect to tab 2 that would display all the other column values corresponding to that row clicked. Here is a working version of my code.

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

You can use actionLink to create the appropriate link in the datatable . Then all you have to do is to listen to this actionLink and fill a reactive upon clicking which holds the corresponding row of the data. You render this reactive on your second tab and use updateTabsetPanel to jump to the second tab.

Code speaks a thousand words so here it goes:

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)