gpt4 book ai didi

javascript - 如何根据列中的条件更改数据表行背景颜色,Rshiny

转载 作者:行者123 更新时间:2023-11-29 14:50:14 25 4
gpt4 key购买 nike

我有一个实时日志文件在运行,它监听数据库并在顶部呈现最近更新的数据表。然而,在花了一些时间之后,我卡在了如何使用 if 语句更改背景颜色上,因为我不熟悉 Javascript。

1) a) 当我的“测试”列为“通过”时,如何将背景颜色更改为绿色。 b) 当它的“Aggr”时为红色 c) 当它的“Bad”时为灰色。我看过R shiny colour dataframeHow to have conditional formatting of data frames in R Shiny?我可以将 scipt 修改为类似这样的内容

script <- "$('tbody tr td:nth-child(1)').each(function() {

var cellValue = $(this).text();

if (cellValue == "Pass") {
$(this).parent().css('background-color', 'green');
}
else if (cellValue == "Aggr") {
$(this).parent().css('background-color', 'red');
}
else if (cellValue == "Bad") {
$(this).parent().css('background-color', 'grey');
}

})"

但这只会执行一次。我也调查了这个 r shiny: highlight some cells但是库给了我一个错误 Error: package ‘ReporteRsjars’ could not be loaded 并且我也无法安装那个包来走这条路。

可能的解决方案:

i) 我可以使用 shinyBS 将我的日志表更改为文本输出并在那里更改颜色库或其他一些工具,这里有一个很好的例子 ChatRoom在 Rshiny 画廊。

ii) 我可以使用 googlevis 包,但是我会面临每次迭代都重新打印表格的问题(与此处所做的相同,但它并不“引人注目”)。

2) 如何仅在添加新点时呈现我的数据表输出。例如。如果没有任何变化,我不想再次重新打印数据表?

提前致谢...

我的示例代码如下

rm(list = ls())
library(shiny)
options(digits.secs=3)

test_table <- cbind(rep(as.character(Sys.time()),2),rep('a',2),rep('b',2),rep('b',2),rep('c',2),rep('c',2),rep('d',2),rep('d',2),rep('e',2),rep('e',2))
colnames(test_table) <- c("Time","Test","T3","T4","T5","T6","T7","T8","T9","T10")

ui =navbarPage(inverse=TRUE,title = "Real-Time Logs",
tabPanel("Logs",icon = icon("bell"),
mainPanel(htmlOutput("logs"))),
tabPanel("Logs 2",icon = icon("bell")),
tabPanel("Logs 3",icon = icon("bell")),
tags$head(tags$style("#logs {height:70vh;width:1000px;!important;text-align:center;font-size:12px;}")),
tags$style(type="text/css", "#logs td:nth-child(1) {height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(2) {width:70px;height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(3) {width:70px;height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(4) {width:70px;height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(5) {width:70px;height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(6) {width:70px;height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(7) {width:70px;height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(8) {width:70px;height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(9) {width:70px;height:20px;font-size:12px;text-align:center}"),
tags$style(type="text/css", "#logs td:nth-child(10) {width:70px;height:20px;font-size:12px;text-align:center}")
)
server <- (function(input, output, session) {
autoInvalidate1 <- reactiveTimer(1000,session)

my_test_table <- reactive({
autoInvalidate1()
other_data <- rbind(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2)),
(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2))))
test_table <<- rbind(apply(other_data, 2, rev),test_table)
as.data.frame(test_table)
})
output$logs <- renderTable({my_test_table()},include.rownames=FALSE)

})

runApp(list(ui = ui, server = server))

最佳答案

您可以添加自定义消息,您可以使用 session$onFlushed 方法调用该消息。为了使示例简洁,我删除了格式和额外的标签。首先是脚本并调用 shiny。注意我们等同于 "Pass " 而不是 "Pass" 等,因为 xtable 似乎添加了额外的间距:

library(shiny)
options(digits.secs=3)
script <- "
els = $('#logs tbody tr td:nth-child(2)');
console.log(els.length);
els.each(function() {
var cellValue = $(this).text();
if (cellValue == \" Pass \") {
$(this).parent().css('background-color', 'green');
}
else if (cellValue == \" Aggr \") {
$(this).parent().css('background-color', 'red');
}
else if (cellValue == \" Bad \") {
$(this).parent().css('background-color', 'grey');
}
});"
test_table <- cbind(rep(as.character(Sys.time()),2),rep('a',2),rep('b',2),rep('b',2),rep('c',2),rep('c',2),rep('d',2),rep('d',2),rep('e',2),rep('e',2))
colnames(test_table) <- c("Time","Test","T3","T4","T5","T6","T7","T8","T9","T10")

和应用

ui =navbarPage(inverse=TRUE,title = "Real-Time Logs",
tabPanel("Logs",icon = icon("bell"),
mainPanel(
htmlOutput("logs"))
, tags$script(sprintf('
Shiny.addCustomMessageHandler("myCallback",
function(message) {
%s
});
', script)
)
)
)
server <- (function(input, output, session) {
autoInvalidate1 <- reactiveTimer(3000,session)
my_test_table <- reactive({
autoInvalidate1()
other_data <- rbind(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2)),
(c(as.character(Sys.time()),(sample(c("Pass","Aggr","Bad"))[1]),round(c(rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1),rnorm(1)),2))))
test_table <<- rbind(apply(other_data, 2, rev),test_table)
session$onFlushed(function(){
session$sendCustomMessage(type = "myCallback", "some message")
})
as.data.frame(test_table)
})
output$logs <- renderTable({my_test_table()},include.rownames=FALSE)
})

runApp(list(ui = ui, server = server))

当您重新添加格式和额外的标签时,它看起来像:

enter image description here

关于javascript - 如何根据列中的条件更改数据表行背景颜色,Rshiny,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/26976860/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com