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)