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

Question

I have a column 'R/Y/G' that should contain three colors Green, Yellow or Red based on values from three different columns R, Y and G. The condition is that if the value of column 'R' is greater than 2.5 million, the color of the corresponding cell in 'R/Y/G' is Red. If the value of column 'Y' is between 2 and 2.5 mil, the color of the corresponding cell in 'R/Y/G' is Yellow. If the value of column 'G' is less than 2 mil, the color of the corresponding cell in 'R/Y/G' is Green. Here the condition :

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 is a column I've created to track the three columns ('R', 'Y' and 'G') and the color for column 'R/Y/G' will be dependent on tcolor based on what values I input in 'R', 'Y' and 'G'

Here's where it is implemented in actual code :

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

But this doesn't seem to work. The colors don't show up.

Answer 1

The created empty columns get character type instead of numeric, so you must create the empty columns with numeric type like this:

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

Learn how to debug Shiny apps by inserting breakpoints to check the type of your objects/columns.

By the way, you don't handle the case when d9$G > 2000000.

Edit: if you need some default color to be displayed before the user enters any value, you should set some default value for the tcolor column, e.g. for green:

  d9['tcolor'] <- 1

To get your desired behavior of cascading conditions and not be bothered by NA values (when no value is entered in a column), you can use the case_when() function from the dplyrpackage (see this post):

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