编辑基于 R Shiny 的其他 DT 列值时,颜色值不会显示

Color values don't show up when editing other DT column values it's based on R Shiny

我有一个列 'R/Y/G',它应该包含三种颜色,绿色、黄色或红色,基于三个不同列 R、Y 和 G 的值。条件是如果列 'R'大于250万,'R/Y/G'中对应单元格的颜色为红色。如果 'Y' 列的值介于 2 到 250 万之间,则 'R/Y/G' 中相应单元格的颜色为黄色。如果 'G' 列的值小于 200 万,则 'R/Y/G' 中相应单元格的颜色为绿色。这里的条件:

d9$tcolor <- ifelse(d9$R > 2500000, 2,
                        ifelse(d9$Y > 2000000 & d9$Y <= 2500000, 1,
                               ifelse(d9$G <= 2000000, 0)))

dt_d9=datatable(isolate(d9), editable = 'cell', rownames = FALSE, extensions = 'Buttons', options = list(dom = 'Bfrtip', buttons = I('colvis'))) %>% formatStyle(
    'R/Y/G', 'tcolor',
    backgroundColor = styleEqual(c(0,1,2), c('green', 'yellow', 'red')),fontWeight = 'bold'
  )

tcolor 是我创建的用于跟踪三列('R'、'Y' 和 'G')的列,并且列 'R/Y/G' 的颜色将取决于基于我在 'R'、'Y' 和 'G'

中输入的值的 tcolor

这是在实际代码中实现的地方:

cmp_data1 <- dbGetQuery(qr,sql)

saveRDS(cmp_data1, 'q1.rds')

dt_output = function(title, id) {
  fluidRow(column(
    12, h1(paste0(title)),
    hr(), DTOutput(id)
  ))
}

render_dt = function(data, editable = 'cell', server = TRUE, ...) {
  renderDT(data,selection = 'none', server = server, editable = editable, ...)
}

ui = fluidPage(
  downloadButton("mcp_csv", "Download as CSV", class="but"),
  
  dt_output('Report', 'x9')
)

server = function(input, output, session) {
  if(!file.exists("cm.rds")){
    d9 = cmp_data1
    d9['R/Y/G'] <- NA
    d9['R'] <- NA
    d9['Y'] <- NA
    d9['G'] <- NA
    d9['tcolor'] <- NA
  }
  else{
    cmp <- readRDS("cm.rds")
    d9 = cbind(cmp_data1, cmp[,(ncol(cmp)-4):ncol(cmp)])
  }
  
  rv <- reactiveValues()
  observe({
    rv$d9 <- d9
  })
  
  dt_d9=datatable(isolate(d9), editable = 'cell', rownames = FALSE, extensions = 'Buttons', options = list(dom = 'Bfrtip', buttons = I('colvis'))) %>% formatStyle(
    'R/Y/G', 'tcolor',
    backgroundColor = styleEqual(c(0,1,2), c('green', 'yellow', 'red')),fontWeight = 'bold'
  )
  
  output$x9 = render_dt(dt_d9)
  
  proxy = dataTableProxy('x9')
  observe({
    DT::replaceData(proxy, rv$d9, rownames = FALSE, resetPaging = FALSE)
  })
  
  observeEvent(input$x9_cell_edit, {
    rv$d9 <<- editData(rv$d9, input$x9_cell_edit, 'x9', rownames = FALSE)
    d9 <- rv$d9
    d9$tcolor <- ifelse(d9$R > 2500000, 2,
                        ifelse(d9$Y > 2000000 & d9$Y <= 2500000, 1,
                               ifelse(d9$G <= 2000000, 0)))
    rv$d9 <<- d9
    saveRDS(d9, 'cm.rds')
    
  })

但这似乎不起作用。颜色不显示。

创建的空列是字符类型而不是数字类型,所以你必须像这样创建数字类型的空列:

  d9['R/Y/G'] <- numeric()
  d9['R'] <- numeric()
  d9['Y'] <- numeric()
  d9['G'] <- numeric()
  d9['tcolor'] <- numeric()

通过插入断点来检查 objects/columns 的类型来学习 how to debug Shiny apps

顺便说一句,d9$G > 2000000.

时你不处理这个案子

编辑:如果您需要在用户输入任何值之前显示一些默认颜色,您应该为 tcolor 列设置一些默认值,例如绿色:

  d9['tcolor'] <- 1

要获得所需的级联条件行为并且不受 NA 值的困扰(当列中未输入任何值时),您可以使用 dplyr 包中的 case_when() 函数( ):

d9$tcolor <- dplyr::case_when(d9$R > 2500000 ~ 2,
                      d9$Y > 2000000 & d9$Y <= 2500000 ~ 0,
                      d9$G < 2000000 ~ 1)