如何使用 updateReactable 和isolate 保留自定义单元格规范？

Question

跟进上一个关于可反应和闪亮的问题，我想使用自定义图标来实现该问题中的页面跳转。

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)

点击添加按钮确实正确添加了数据，并且跳转到了想要的页面，但是没有图标显示。删除

isolate()

调用可以正确添加带有图标的观察结果，但不会跳转到页面。我的第一个想法是使用列中的 html 和

colDef(html = TRUE)

选项手动添加所需的图标。但是，在应用程序中实现该逻辑根本不会呈现任何图标。 IE。 :

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

Answer 1

我的一位同事确定

1. 我们不想

   isolate()

   ，因为图标每次都需要渲染。
2. 闪亮的操作顺序是罪魁祸首。这可以通过手动设置操作顺序来解决，方法是通过

   reactiveValues

   跟踪页面并将

   htmlwidgets::onRender()

   通过管道传输到

   reactable

   上以设置新的可观察输入。

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)