编辑基于 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)
我有一个列 '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)