如何用lapply简化向DataFrame添加变量的重复代码

需求说明 #

现有仅含var1列的DataFrame，需新增两列：

• Col：基于var1值，通过colorRampPalette生成白色到深青色的渐变色（值越小颜色越浅，值越大颜色越深）
• Col2：对应颜色的编号

数据示例 #

data <- data.frame(var1 = c(0,0,0,0,0,1,1,4,4,5,5,5,7,7,8,12,13,17,17,17,17,29,29,29,30,30,33,
                            34,35,37,39,40,41,41,44,44,48,50,50,57))

原冗余代码 #

原代码通过重复的条件赋值实现，冗余度极高：

rbPal <- colorRampPalette(c('white','darkcyan'))
nb_scale_pas= floor((max(data$var1)/20)) +1

data$Col[data$var1>0*nb_scale_pas & data$var1<=1*nb_scale_pas]=rbPal(20)[1]
data$Col[data$var1>1*nb_scale_pas & data$var1<=2*nb_scale_pas]=rbPal(20)[2]
data$Col[data$var1>2*nb_scale_pas & data$var1<=3*nb_scale_pas]=rbPal(20)[3]
data$Col[data$var1>3*nb_scale_pas & data$var1<=4*nb_scale_pas]=rbPal(20)[4]
data$Col[data$var1>4*nb_scale_pas & data$var1<=5*nb_scale_pas]=rbPal(20)[5]
data$Col[data$var1>5*nb_scale_pas & data$var1<=6*nb_scale_pas]=rbPal(20)[6]
data$Col[data$var1>6*nb_scale_pas & data$var1<=7*nb_scale_pas]=rbPal(20)[7]
data$Col[data$var1>7*nb_scale_pas & data$var1<=8*nb_scale_pas]=rbPal(20)[8]
data$Col[data$var1>8*nb_scale_pas & data$var1<=9*nb_scale_pas]=rbPal(20)[9]
data$Col[data$var1>9*nb_scale_pas & data$var1<=10*nb_scale_pas]=rbPal(20)[10]
data$Col[data$var1>10*nb_scale_pas & data$var1<=11*nb_scale_pas]=rbPal(20)[11]
data$Col[data$var1>11*nb_scale_pas & data$var1<=12*nb_scale_pas]=rbPal(20)[12]
data$Col[data$var1>12*nb_scale_pas & data$var1<=13*nb_scale_pas]=rbPal(20)[13]
data$Col[data$var1>13*nb_scale_pas & data$var1<=14*nb_scale_pas]=rbPal(20)[14]
data$Col[data$var1>14*nb_scale_pas & data$var1<=15*nb_scale_pas]=rbPal(20)[15]
data$Col[data$var1>15*nb_scale_pas & data$var1<=16*nb_scale_pas]=rbPal(20)[16]
data$Col[data$var1>16*nb_scale_pas & data$var1<=17*nb_scale_pas]=rbPal(20)[17]
data$Col[data$var1>17*nb_scale_pas & data$var1<=18*nb_scale_pas]=rbPal(20)[18]
data$Col[data$var1>18*nb_scale_pas & data$var1<=19*nb_scale_pas]=rbPal(20)[19]

data$Col2[data$Col==rbPal(20)[1]]=1
data$Col2[data$Col==rbPal(20)[2]]=2
data$Col2[data$Col==rbPal(20)[3]]=3
data$Col2[data$Col==rbPal(20)[4]]=4
data$Col2[data$Col==rbPal(20)[5]]=5
data$Col2[data$Col==rbPal(20)[6]]=6
data$Col2[data$Col==rbPal(20)[7]]=7
data$Col2[data$Col==rbPal(20)[8]]=8
data$Col2[data$Col==rbPal(20)[9]]=9
data$Col2[data$Col==rbPal(20)[10]]=10
data$Col2[data$Col==rbPal(20)[11]]=11
data$Col2[data$Col==rbPal(20)[12]]=12
data$Col2[data$Col==rbPal(20)[13]]=13
data$Col2[data$Col==rbPal(20)[14]]=14
data$Col2[data$Col==rbPal(20)[15]]=15
data$Col2[data$Col==rbPal(20)[16]]=16
data$Col2[data$Col==rbPal(20)[17]]=17
data$Col2[data$Col==rbPal(20)[18]]=18
data$Col2[data$Col==rbPal(20)[19]]=19

简化方案 #

方法1：分箱映射（推荐，效率更高）

核心思路是先把var1按区间分箱，再直接映射颜色和编号：

# 初始化颜色调色板
rbPal <- colorRampPalette(c('white','darkcyan'))
colors <- rbPal(20)
nb_scale_pas <- floor(max(data$var1)/20) + 1

# 生成分箱区间，0值单独设为NA
bins <- seq(0, 19*nb_scale_pas, by = nb_scale_pas)
# 给var1分箱得到组号，0值返回NA
data$Col2 <- findInterval(data$var1, bins)
data$Col2[data$var1 == 0] <- NA
# 映射对应颜色
data$Col <- colors[data$Col2]

方法2：用lapply实现

如果一定要用lapply遍历区间，代码如下：

rbPal <- colorRampPalette(c('white','darkcyan'))
colors <- rbPal(20)
nb_scale_pas <- floor(max(data$var1)/20) + 1

# 先初始化Col和Col2为NA
data$Col <- NA_character_
data$Col2 <- NA_integer_

# 用lapply遍历1到19的区间，批量赋值
lapply(1:19, function(i) {
  lower <- (i-1)*nb_scale_pas
  upper <- i*nb_scale_pas
  idx <- data$var1 > lower & data$var1 <= upper
  data$Col[idx] <<- colors[i]
  data$Col2[idx] <<- i
})

验证输出 #

运行后得到的结果与预期一致：

> data
   var1     Col Col2
1     0    <NA>   NA
2     0    <NA>   NA
3     0    <NA>   NA
4     0    <NA>   NA
5     0    <NA>   NA
6     1 #FFFFFF    1
7     1 #FFFFFF    1
8     4 #F1F8F8    2
9     4 #F1F8F8    2
10    5 #F1F8F8    2
...
33   41 #50AFAF   14
34   41 #50AFAF   14
35   44 #43A9A9   15
36   44 #43A9A9   15
37   48 #35A3A3   16
38   50 #289D9D   17
39   50 #289D9D   17
40   57 #0D9191   19

内容的提问来源于stack exchange，提问作者Patrick Parts