Following up on a previous question on reactable and shiny, I'd like to implement the page jumping in that question with the use of custom icons.
library(shiny)
library(reactable)
library(dplyr)
ui <- fluidPage(
actionButton("go", "Add Observation"),
reactableOutput("table")
)
server <- function(input, output, session) {
# Reactive data
data <- reactiveValues(
data = iris |> mutate(Index = row_number()),
)
# Render reactable, but isolate
output$table <- renderReactable({
reactable(
isolate(data$data),
columns = list(
Sepal.Length = reactable::colDef(
cell = function(value, index) {
if (value >= 5) {
shiny::icon("check", style = "color: green")
} else {
shiny::icon("xmark", style = "color: red")
}
}
)
)
)
})
# Update data on button click
observeEvent(
input$go,
{
# create a record to add
x <- iris[sample(nrow(iris), 1), ]
# add a record and re id
data$data <- bind_rows(
data$data,
x
) |> dplyr::mutate(Index = dplyr::row_number())
# get index of change, save the needed page
index <- tail(data$data, 1) |> dplyr::pull(Index)
# update data and page at same time
updateReactable("table", data = data$data, page = ceiling(index / 10))
}
)
}
shinyApp(ui, server)
Clicking the add button does correctly add the data and does jump to the wanted page, but no icon is displayed. Removing the isolate()
call correctly adds the observation with an icon, but the page is not jumped to. My first thought was to manually add the wanted icons using html in the column and colDef(html = TRUE)
option. However, implementing that logic in the app does not render any icons at all. I.e. :
data <- iris |>
mutate(
Index = row_number(),
Sepal.Length = dplyr::if_else(
Sepal.Length >= 5,
as.character(shiny::icon("check")),
as.character(shiny::icon("xmark"))
)
)
reactable(
data,
columns = list(
Sepal.Length = reactable::colDef(
html = TRUE
)
)
)
A colleague of mine determined that
isolate()
because the icons require rendering each time.reactiveValues
and piping an htmlwidgets::onRender()
onto the reactable
that sets a new observable input.library(shiny)
library(reactable)
library(dplyr)
ui <- fluidPage(
actionButton("go", "Add Observation"),
reactableOutput("table")
)
server <- function(input, output, session) {
# Reactive data
data <- reactiveValues(
data = iris |> mutate(Index = row_number()),
tbl_page = 1
)
# Render reactable and set rendered input
output$table <- renderReactable({
data$data |>
reactable(
columns = list(
Sepal.Length = reactable::colDef(
cell = function(value, index) {
if (value >= 5) {
shiny::icon("check", style = "color: green")
} else {
shiny::icon("xmark", style = "color: red")
}
}
)
)
) |>
htmlwidgets::onRender(
"function(el, x) {
Shiny.setInputValue('tbl_rendered', Date.now())
}"
)
})
# Update data on button click
observeEvent(
input$go,
{
# create a record to add
x <- data$data |>
dplyr::slice_sample(n = 1) |>
dplyr::mutate(Index = nrow(data$data) + 1)
# add a record and re id
data$data <- bind_rows(
data$data,
x
) |>
dplyr::arrange(Index)
# get index of change, save the needed page
index <- tail(data$data, 1) |> dplyr::pull(Index)
# update reactiveVals
data$tbl_page <- ceiling(index / 10)
}
)
# jump to page after table has rendered
shiny::observeEvent(
input$tbl_rendered,
reactable::updateReactable("table", page = data$tbl_page)
)
}
shinyApp(ui, server)