我有以下数据框:
product<-c("ab","ab","ab","ac","ac","ac")
shop<-c("sad","sad","sad","sadas","fghj","xzzv")
category<-c("a","a","a","b","b","b")
tempr<-c(35,35,14,24,14,5)
value<-c(0,0,-6,8,4,0)
store<-data.frame(product,shop,category,tempr,value)
从中创建store2
:
store2 <- matrix(NA,ncol=length(unique(store$shop)),nrow=length(unique(store$product)))
colnames(store2) <- unique(store$shop)
rownames(store2) <- unique(store$product)
for(i in 1:ncol(store)) {
store2[store[i,'product'],store[i,'shop']] <- paste0(store[i,c('tempr')],'(',store[i,'value'],')')
}
我想创建一个DT
数据表,该数据包根据此新数据框的值着色。更具体地说,如果括号内的数字为正,则该单元格应显示为绿色。在任何其他情况下(负数,0或NA,其颜色都应为红色。这是一个示例:
我不一定推荐这种方法,因为我相当反对将一种语言嵌入另一种语言,但是我认为这可以解决您的问题。您可能可以将JavaScript保存到文件中,然后将其加载到变量中,这是我认为更好的方法,但是,为了一个独立的解决方案,我对其进行了内联。
根据DT
此处的文档https://rstudio.github.io/DT/functions.html,很明显,所需的方法是以formatStyle
某种方式使用的。
DT
提供了一些可用于的便捷方法formatStyle
,其来源在这里:https : //github.com/rstudio/DT/blob/0b9710f5a9391c634a3865961083740f1cbf657b/R/format.R,我将其作为解决方案的基础。
基本上,我们需要传递一些JavaScript,formatStyle
这些JavaScript将基于一个名为的变量进行所有表格样式的设置value
。我们将需要执行以下操作:
datatable(store2) %>% formatStyle(colnames(store2), backgroundColor=JS(jsFunc))
其中变量jsFunc
是一些JavaScript字符串。由于源表明该字符串必须是表达式而不是语句,并且由于这会有些复杂,因此我们将使用匿名函数,该函数将立即被评估以执行逻辑。该函数必须采用一个值,并根据该值返回颜色。这是我们需要的功能。
function(value){
// find a number preceeded by an open parenthesis with an optional minus sign
var matches = /\((-?\d+)/.exec(value);
// ignore values which do not match our pattern, returning white as the background color
if(!matches || matches.length < 2) {
return 'white';
}
// attempt to convert the match we found into a number
var int = parseInt(matches[1]);
// if we can't ignore it and return a white color
if(isNaN(int)) {
return 'white';
}
// if the value is negative, return red
if(int < 0) {
return 'red'
}
// otherwise, by default, return green
return 'green';
}
我们想立即调用此函数,因此我们将其包装在括号中,并将value参数传递给它。
(function(value){
// find a number preceeded by an open parenthesis with an optional minus sign
var matches = /\((-?\d+)/.exec(value);
// ignore values which do not match our pattern, returning white as the background color
if(!matches || matches.length < 2) {
return 'white';
}
// attempt to convert the match we found into a number
var int = parseInt(matches[1]);
// if we can't ignore it and return a white color
if(isNaN(int)) {
return 'white';
}
// if the value is negative, return red
if(int < 0) {
return 'red';
}
// otherwise, by default, return green
return 'green';
})(value)
我们将此值包装在多行R
字符串中,转义任何反斜杠和双引号(我避免使用它们),并将其分配给value jsFunc
。
jsFunc <- "(function(value){
// find a number preceeded by an open parenthesis with an optional minus sign
var matches = /\\((-?\\d+)/.exec(value);
// ignore values which do not match our pattern, returning white as the background color
if(!matches || matches.length < 2) {
return 'white';
}
// attempt to convert the match we found into a number
var int = parseInt(matches[1]);
// if we can't ignore it and return a white color
if(isNaN(int)) {
return 'white';
}
// if the value is negative, return red
if(int < 0) {
return 'red'
}
// otherwise, by default, return green
return 'green';
})(value)"
最后,我们可以formatStyle
使用此变量进行调用
datatable(store2) %>% formatStyle(colnames(store2), backgroundColor=JS(jsFunc))
那应该给我们这样的结果:
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句