R计算与数据帧中的值成比例的RGB代码

Question

我有一个简单的数据框，在其中我具有log2刻度值。

我正在尝试向包含与第一列中的值成比例的R，G，B代码的数据框添加一列。另外，如果该值大于或小于一个值，我也想放置一个阈值。在这种情况下，最小值为-5，最大值为5。我在awk中做到了，但是在R中找不到解决方案我的awk代码：

awk -v maxlogratio=5 -v FS='\t' -v OFS='\t' '/^chr/{{r=0;g=0;if($9<1){{r=-255*(log($9)/log(2))/maxlogratio;if(r>255){{r=255}}}};if($9>1){{g=255*(log($9)/log(2))/maxlogratio;if(g>255){{g=255}}}};print $0,r","g",0"}}'

这里唯一的区别是我的值不在log2范围内（这就是为什么我有log（x）/ log（2）

R代码：

activity_rgb=data.frame(activity=seq(from=-6,to = 6,by = 1))%>%
mutate(rgb=ifelse(activity<0,c(-255*(activity)/5,0,0),c(0,255*(activity),0)))

我知道了：

   activity  rgb
1        -6  306
2        -5  255
3        -4  204
4        -3  153
5        -2  102
6        -1   51
7         0 -255
8         1    0
9         2  255
10        3  510
11        4  765
12        5 1020
13        6 1275

我希望这样：

activity    rgb
  -6    255,0,0 
  -5    255,0,0 
  -4    204,0,0 
  -3    153,0,0
  -2    102,0,0
  -1    51,0,0
   0    0,0,0   
   1    0,51,0  
   2    0,102,0 
   3    0,153,0 
   4    0,204,0 
   5    0,255,0
   6    0,255,0 

所以我需要将值粘贴到rgb列中，但是我不知道该怎么做。

所以最后我做了一些事情来得到r，g，b

但是我仍然无法将-5 / 5的最小值和值固定为255

activity_rgb=data.frame(activity=seq(from=-6,to = 6,by = 1))%>%
mutate(rgb=ifelse(activity<0,paste(-255*(activity)/5,0,0,sep = ","),paste(0,255*(activity)/5,0,sep = ",")))

activity_rgb
   activity     rgb
1        -6 306,0,0
2        -5 255,0,0
3        -4 204,0,0
4        -3 153,0,0
5        -2 102,0,0
6        -1  51,0,0
7         0   0,0,0
8         1  0,51,0
9         2 0,102,0
10        3 0,153,0
11        4 0,204,0
12        5 0,255,0
13        6 0,306,0 

Answer 1

尝试使用colorRamp：

scale_to_rgb <- function(val, bounds = NA,
                         colors = c("#ff0000", "#000000", "#00ff00"),
                         format = c("rgb", "comma"), ...) {
  if (anyNA(bounds)) bounds <- range(val, na.rm = TRUE)
  format = match.arg(format)

  isna <- is.na(val)
  ispos <- !isna & val >= 0
  isneg <- !isna & !ispos
  cols <- matrix(NA, nrow = length(val), ncol = 3)
  valneg <- pmax(bounds[1], val[isneg]) / bounds[1]
  valpos <- pmin(bounds[2], val[ispos]) / bounds[2]

  cols[isneg,] <- colorRamp(colors[2:1], ...)(valneg)
  cols[ispos,] <- colorRamp(colors[2:3], ...)(valpos)

  if (format == "rgb") {
    cols <- cols / 255
    rgb(cols[,1], cols[,2], cols[,3])
  } else {
    cols <- round(cols, 0)
    paste(cols[,1], cols[,2], cols[,3], sep = ",")
  }
}

您的数据和dplyr用例：

activity_rgb <- data.frame(activity = seq(from=-6, to = 6, by = 1))

activity_rgb %>%
  mutate(
    rgb = scale_to_rgb(activity, bounds = c(-5, 5)),
    comma = scale_to_rgb(activity, bounds = c(-5, 5), format = "comma")
  )
#    activity     rgb   comma
# 1        -6 #FF0000 255,0,0
# 2        -5 #FF0000 255,0,0
# 3        -4 #CC0000 204,0,0
# 4        -3 #990000 153,0,0
# 5        -2 #660000 102,0,0
# 6        -1 #330000  51,0,0
# 7         0 #000000   0,0,0
# 8         1 #003300  0,51,0
# 9         2 #006600 0,102,0
# 10        3 #009900 0,153,0
# 11        4 #00CC00 0,204,0
# 12        5 #00FF00 0,255,0
# 13        6 #00FF00 0,255,0

您提到了从-4缩放到5会发生什么事情...

activity_rgb %>%
  mutate(
    rgb = scale_to_rgb(activity, bounds = c(-4, 5)),
    comma = scale_to_rgb(activity, bounds = c(-4, 5), format = "comma")
  )
#    activity     rgb   comma
# 1        -6 #FF0000 255,0,0
# 2        -5 #FF0000 255,0,0
# 3        -4 #FF0000 255,0,0
# 4        -3 #BF0000 191,0,0
# 5        -2 #800000 128,0,0
# 6        -1 #400000  64,0,0
# 7         0 #000000   0,0,0
# 8         1 #003300  0,51,0
# 9         2 #006600 0,102,0
# 10        3 #009900 0,153,0
# 11        4 #00CC00 0,204,0
# 12        5 #00FF00 0,255,0
# 13        6 #00FF00 0,255,0