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)
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)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.