rstudio
shiny get selected row from GT
It would be great if GT could be used in Shiny as way for reactive inputs. That is, a user clicks on a row in a GT and passes data from that row as a reactive input. Datatable has this capability. When user clicks a row in a datatable, we can access the selected row with: input$tableId_rows_selected see here: https://stackoverflow.com/questions/28274584/get-selected-row-from-datatable-in-shiny-app
Thanks very much!
Thanks Jonathan, I'm pretty excited about this feature—all Shiny-related things for gt tend to excite me—but I think it will take some time before I could get to this.
Since v.0.9.0 you can create interactive tables with {gt}. Under the hood this uses {reactable}. Hence, it's pretty easy to piggyback off the underlying {reactable} engine. This requires to modify the internal render_as_ihtml() function so that it does not set selection = NULL when it calls reactable::reactable().
Here's a proposal. First, modify the render_as_ihtml(data, id) function:
This gives us a function my_render_as_ihtml(data, id, selection) that is really just the original function where selection = NULL was replaced with selection = selection.
Since the output of this function is a {reactable} table, we can treat it as such in a dummy Shiny app.
library(shiny)
library(gt)
ui <- fluidPage(
reactable::reactableOutput("table"),
verbatimTextOutput('selected')
)
server <- function(input, output, session) {
output$table <- reactable::renderReactable({
gt::towny |>
dplyr::select(name, land_area_km2) |>
dplyr::slice(1:20) |>
gt::gt() |>
gt::tab_options(
table.width = '500px',
container.width = '500px'
) |>
my_render_as_ithml(selection = 'multiple', id = 'bla')
})
output$selected <- renderText({
selected <- reactable::getReactableState("table", "selected")
req(selected)
paste0('Selected rows: ', paste0(selected, collapse = ', '))
})
}
shinyApp(ui, server)
Hello @jkr216 , @rich-iannone and @AlbertRapp
I develop shiny apps and need a lot to use row selection on the table. DT and reactable packages allow us to do this. I use When I use DT package with simple data sets, there is no problem but, if your data sets are large and you will change table styles, it causes some format issues. Probably, you can handle the issues by using javascript, I think.
I tried reactable package to make nice tables. However, the rendering of the table is too slow. You have to use DT package for speed. I'd like to try gt package and see its speed but, it has no row selection attribute.
@AlbertRapp I couldn't run render_as_ihtml function. Could you share your working code succesfully?
@jkr216 and @rich-iannone I wonder your experiences, which package do you suggest to make nice format and fast rendering with row selection attribute.
This is my reactable code. Unfortunately, it is too slow :(
output$table <- renderReactable({
if(is.null(rvList$DFFiltered)){
df <- rvList$DFRaw
}else{
df <- rvList$DFFiltered
}
if(is.data.frame(df)){
# https://stackoverflow.com/questions/71250726/conditional-formattingbackground-cell-multiple-columns-using-reactable-lib
reactablecolumns <-
df %>% rename_all(funs(str_to_title(gsub("[[:punct:]]", " ", .)))) %>%
colnames() %>%
set_names() %>%
keep(~ .x %in% (str_to_title(gsub('[[:punct:] ]+',' ', make_clean_names(bormetriclist %>% pull(Attributes) %>% unique()))))) %>%
map(~ {
colDef(
vAlign = "center",
style = function(value) {
colfunc <- colorRampPalette(c("red", "yellow", "#00A300"))
colfunc <- colfunc(20)
ds_color <- ifelse(value == 1, colfunc[1], NA)
ds_color <- ifelse(value == 1.5, colfunc[2], ds_color)
ds_color <- ifelse(value == 2, colfunc[3], ds_color)
ds_color <- ifelse(value == 2.5, colfunc[4], ds_color)
ds_color <- ifelse(value == 3, colfunc[5], ds_color)
ds_color <- ifelse(value == 3.5, colfunc[6], ds_color)
ds_color <- ifelse(value == 4, colfunc[7], ds_color)
ds_color <- ifelse(value == 4.5, colfunc[8], ds_color)
ds_color <- ifelse(value == 5, colfunc[9], ds_color)
ds_color <- ifelse(value == 5.5, colfunc[10], ds_color)
ds_color <- ifelse(value == 6, colfunc[12], ds_color)
ds_color <- ifelse(value == 6.5, colfunc[13], ds_color)
ds_color <- ifelse(value == 7, colfunc[14], ds_color)
ds_color <- ifelse(value == 7.5, colfunc[15], ds_color)
ds_color <- ifelse(value == 8, colfunc[16], ds_color)
ds_color <- ifelse(value == 8.5, colfunc[17], ds_color)
ds_color <- ifelse(value == 9, colfunc[18], ds_color)
ds_color <- ifelse(value == 9.5, colfunc[19], ds_color)
ds_color <- ifelse(value == 10, colfunc[20], ds_color)
list(background = ds_color, fontWeight = "bold", color = "white", fontSize = 20)
}
)
})
reactablecolumns["Value"] = list("Value" = colDef(
format = colFormat(currency = "EUR", separators = TRUE, digits = 0, locales = "de-DE"),
minWidth = 110))
reactablecolumns["Height"] = list(Height = colDef(format = colFormat(suffix = " cm")))
reactablecolumns["Weight"] = list(Weight = colDef(format = colFormat(suffix = " kg")))
reactablecolumns["Photo"] = list(Photo = colDef(minWidth = 60, html = TRUE,sticky = "left"))
# Uzun yazılı karakter değişkenleri için: Tippy
render.reactable.cell.with.tippy <- function(text, tooltip){
div(
# text-decoration: underline;
#text-decoration-style: dotted;
#text-decoration-color: #FF6B00;
style = "
cursor: info;
caret-color: red;
white-space: nowrap;
overflow: hidden;
text-overflow: ellipsis;",
tippy(text = text, tooltip = tooltip, theme = "light")
)
}
# https://stackoverflow.com/questions/64591293/r-reactable-how-to-truncate-cell-content-and-display-upon-hovering
reactablecolumns["Player"] = list(Player = colDef(
cell = function(value, index, name){render.reactable.cell.with.tippy(text = value, tooltip = value)},
minWidth = 100,vAlign = "center", html = TRUE, sticky = "left",style = list(borderRight = "2px solid black")))
reactablecolumns["Name"] = list("Name" = colDef(
cell = function(value, index, name){render.reactable.cell.with.tippy(text = value, tooltip = value)},
minWidth = 100,vAlign = "center"))
reactablecolumns["SId"] = list("Sb Id" = colDef(show = FALSE))
reactablecolumns["Tmd"] = list("Tm Id" = colDef(show = FALSE))
for(i in c("CName", "Name", "Agent", "Team", "Nat", "TNat", "MRM")){
reactablecolumns[i] = list(i = colDef(
cell = function(value, index, name){render.reactable.cell.with.tippy(text = value, tooltip = value)},
minWidth = 100,vAlign = "center"))
}
# Reactable
reactable(
df %>%
rename_all(funs(str_to_title(gsub("[[:punct:]]", " ", .)))),
height = 750,
defaultPageSize = 100, pagination = T,pageSizeOptions = c(50, 100, 150, 200), showPageInfo = TRUE,
showPageSizeOptions = T, showPagination = T, paginationType = "numbers",
bordered = TRUE, striped = TRUE, highlight = TRUE, compact = TRUE,
sortable = TRUE, showSortable = TRUE, fullWidth = FALSE, style = "z-index: 0; width:100%; font-size:78%;",
selection = "single", onClick = "select",
theme = reactableTheme(
rowSelectedStyle = list(backgroundColor = "#C6E0B4", boxShadow = "inset 2px 0 0 0 #ffa62d")
),
defaultColDef = colDef(
headerVAlign = "center",vAlign = "center",
header = function(value) gsub("_", " ", value, fixed = TRUE),
#cell = function(value) format(value, nsmall = 1),
align = "center",
minWidth = 100,
headerStyle = list(background = "#002749", color = "white")
),
columns = reactablecolumns
)
}
})
just wondering if this feature is already implemented? Or will it be implemented in the future (when using gt in shiny)
Hello @AlbertRapp.
When I run your shiny App, R does not seem to know where to look for rstudio/gt internal functions, and so gives back an error. Could you tell me how to fix this?
I followed your recipe by copying the source code for render_as_ihtml from https://rdrr.io/github/rstudio/gt/src/R/render_as_i_html.R I modified the function() call to function(data, id,mysel), and modified the line "selection=NULL" to "selection=mysel", and saved the file as my_render_as_ihtml. Then I used this slightly modified version of your shiny code, which: --sources the my_render_as_ihtml file, and --has "my_render_as_ihtml(mysel = 'multiple', id = 'bla') as the last line of the output$table argument. (also corrected minor typo: ithml -->ihtml)
When I run the App, I get: Warning: Error in build_data: could not find function "build_data", which refers to the first line of the my_render_as_ihtml function:
data <- build_data(data = data, context = "html")
Similarly, if I replace my_render_as_ihtml(mysel = 'multiple', id = 'bla') with render_as_ihtml(id = 'bla') I get: Error in render_as_ihtml: could not find function "render_as_ihtml"
The code is not recognizing gt (internal) functions, although the gt library is successfully loaded ( "gt" %in% tolower(library()$results[,1]) returns TRUE).
Thanks for any suggestions
fname="my_render_as_ihtml" fpath=paste0("data","/",fname,".R") source(fpath)
library(shiny) library(gt)
ui <- fluidPage( reactable::reactableOutput("table"), verbatimTextOutput('selected') )
server <- function(input, output, session) { output$table <- reactable::renderReactable({ gt::towny |> dplyr::select(name, land_area_km2) |> dplyr::slice(1:20) |> gt::gt() |> gt::tab_options( table.width = '500px', container.width = '500px' ) |> my_render_as_ihtml(mysel = 'multiple', id = 'bla')
render_as_ihtml(id = 'bla')
})
output$selected <- renderText({ selected <- reactable::getReactableState("table", "selected") req(selected) paste0('Selected rows: ', paste0(selected, collapse = ', ')) })
}
shinyApp(ui, server)
