可反应表格上的行颜色格式出现一秒钟，然后消失

Question

我想在 Shiny 中制作一个具有单选行的可反应表格，这样每当我单击一行时，表格上其他行的颜色都会根据它们的值是否大于或小于该行进行格式化我选择了。例如，当我选择休斯顿时，人口列中的其他单元格应该全部为红色，因为它们都小于休斯顿的人口。

这种格式有效，但唯一的问题是它在屏幕上闪烁大约十分之一秒，然后消失，我的行未被选中。如何使格式保持不变？

这是一个最小的可重现示例：

library(shiny)

ui <- fluidPage(
  reactableOutput("selected_table")
)

city_data <- data.frame(
  city = c("New Orleans", "Houston", "San Antonio", "Dallas", "Austin", "Tampa"),
  population = c(376971, 22880000, 1452000, 12880000, 964177, 387050)
)


server <- function(input, output, session) {
  output$selected_table = renderReactable({
    
    # get data for checked row
    checked_row_index = getReactableState("selected_table", "selected")
    checked_row = city_data[checked_row_index, ]
    
    if (!is.null(city_data)) {
      reactable(city_data, 
                
                columns = list(
                  population = colDef(
                    style = function(value) {
                      if (!is.null(checked_row_index)) {
                        if (!is.null(checked_row$population)) {
                          if (value < checked_row$population) {
                            # format red if value less than selected row
                            list(background = "#f8baba")
                          } else {
                            # format green if value greater than selected row
                            list(background = "#baf8ba")
                          }
                        } else {
                          # if value for cell null, format grey
                          list(background = "#eee")
                        }
                      } else {
                        # if no row selected, format cell with color grey
                        list(background = "#eee")
                      }
                    }
                  )
                ),
                selection = "single"
      )
    }
    
  })
}

shinyApp(ui = ui, server = server)

Answer 1

对于任何好奇的人，我想我找到了解决方法：

library(shiny)

ui <- fluidPage(
  reactableOutput("selected_table")
)

city_data <- data.frame(
  city = c("New Orleans", "Houston", "San Antonio", "Dallas", "Austin", "Tampa"),
  population = c(376971, 22880000, 1452000, 12880000, 964177, 387050)
)


server <- function(input, output, session) {
  row_values <- reactiveValues(population = -1, city="Timbuktu")



  output$selected_table = renderReactable({

    # get data for checked row
    selected_pop = row_values$population
    selected_city = row_values$city
    if (!is.null(city_data)) {
      reactable(city_data,

                columns = list(
                  
                  city = colDef(
                    style = function(value) {
                      if (selected_city == "Timbuktu") {
                        list(background = "white")
                      } else if (value == selected_city) {
                        list(background = "#AAAAAA")
                      } else {
                        list(background = "white")
                      }
                    }
                  ),
                  
                  
                  population = colDef(
                    style = function(value) {
                      
                      if (selected_pop == -1) {
                        list(background = "white")
                      } else if (value > selected_pop) {
                        list(background = "green")
                      } else {
                        list(background = "red")
                      }
                    }
                  )
                ),
                selection = "single"
      )
    }

  })

  observeEvent(as.character(getReactableState("selected_table","selected")), {

    checked_row_index = getReactableState("selected_table", "selected")
    checked_row = city_data[checked_row_index, ]
    
    if (!is.null(checked_row_index)) {
      row_values$population = checked_row$population
    }
    
    if (!is.null(checked_row_index)) {
      row_values$city = checked_row$city
    }

  })

}


shinyApp(ui = ui, server = server)

Answer 2

问题是，每次您选择一行时，都会再次渲染表格，并将所选值设置为

NULL

，这会触发新的“更新”并将颜色设置回默认值。相反，为了防止这种情况，您必须设置

defaultSelected

。另外，我建议将

checked_row_index 

和

checked_row

移到

renderReactable

之外，并使它们自己成为

reactive

：

library(shiny)
library(reactable)

city_data <- data.frame(
  city = c("New Orleans", "Houston", "San Antonio", "Dallas", "Austin", "Tampa"),
  population = c(376971, 22880000, 1452000, 12880000, 964177, 387050)
)

ui <- fluidPage(
  reactableOutput("selected_table")
)

server <- function(input, output, session) {
  checked_row_index <- reactive({
    getReactableState("selected_table", "selected")
  })
  
  checked_row <- reactive({
    city_data[checked_row_index(), ]
  })
  
  output$selected_table <- renderReactable({
    reactable(city_data,
      columns = list(
        population = colDef(
          style = function(value) {
            if (!is.null(checked_row_index())) {
              if (!is.null(checked_row()$population)) {
                if (value < checked_row()$population) {
                  # format red if value less than selected row
                  list(background = "#f8baba")
                } else {
                  # format green if value greater than selected row
                  list(background = "#baf8ba")
                }
              } else {
                # if value for cell null, format grey
                list(background = "#eee")
              }
            } else {
              # if no row selected, format cell with color grey
              list(background = "#eee")
            }
          }
        )
      ),
      selection = "single",
      defaultSelected = if (!is.null(checked_row_index())) checked_row_index()
    )
  })
}

shinyApp(ui = ui, server = server)