rshinyreactable

How to retain custom cell specification using updateReactable and isolate?


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
        )
    )
)

Solution

  • A colleague of mine determined that

    1. we don't want to isolate() because the icons require rendering each time.
    2. The order of operations in shiny are the culprit. This can be fixed by manually setting the order of operations via tracking the page through the 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)