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.
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 dplyr
package (see this post):
d9$tcolor <- dplyr::case_when(d9$R > 2500000 ~ 2,
d9$Y > 2000000 & d9$Y <= 2500000 ~ 0,
d9$G < 2000000 ~ 1)