如何使用 lapply 在 dataframe 中添加变量

Question

我想使用像 lapply 这样的 function 来简化下面的代码。 简而言之，我有一个带有一个变量的 dataframe。 我想根据 var1 的值添加另外两个变量。 在 Col 变量中，我想根据变量 1 的值来赋予颜色。对于颜色，我使用 colorRamPalette。 目标是将浅色用于小价值，将深色用于高价值，比例为 colors。 为此，我使用 nb_scale_pas 定义了一个步骤，然后使用条件测试对每种颜色进行属性测试。 对于第二个变量，我只想用数字“命名”颜色。

数据

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))

> data
   var1
1     0
2     0
3     0
4     0
5     0
6     1
7     1
8     4
9     4
10    5
11    5
12    5
13    7
14    7
15    8
16   12
17   13
--------
33   41
34   41
35   44
36   44
37   48
38   50
39   50
40   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

最终 output

> 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
11    5 #F1F8F8    2
12    5 #F1F8F8    2
13    7 #E4F2F2    3
---------------------
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

Answer 1

为什么不只是矢量化颜色分配，例如做这样的事情？

（编辑以将范围分成相等大小的间隔；当然，任何其他预定义的削减也可以工作。）

library(RColorBrewer)
rbPal <- colorRampPalette(c('white','darkcyan'))
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))
cols <- cut(data$var1, breaks = seq(0,max(data$var1), length.out=21), labels = rbPal(20), include.lowest = TRUE)
data$Col1 <- as.character(cols)
data$Col2 <- as.numeric(cols)
data
#>    var1    Col1 Col2
#> 1     0 #FFFFFF    1
#> 2     0 #FFFFFF    1
#> 3     0 #FFFFFF    1
#> 4     0 #FFFFFF    1
#> 5     0 #FFFFFF    1
#> 6     1 #FFFFFF    1
#> 7     1 #FFFFFF    1
#> 8     4 #F1F8F8    2
#> 9     4 #F1F8F8    2
#> 10    5 #F1F8F8    2
#> 11    5 #F1F8F8    2
#> 12    5 #F1F8F8    2
#> 13    7 #E4F2F2    3
#> 14    7 #E4F2F2    3
#> 15    8 #E4F2F2    3
#> 16   12 #C9E6E6    5
#> 17   13 #C9E6E6    5
#> 18   17 #BBE0E0    6
#> 19   17 #BBE0E0    6
#> 20   17 #BBE0E0    6
#> 21   17 #BBE0E0    6
#> 22   29 #78C1C1   11
#> 23   29 #78C1C1   11
#> 24   29 #78C1C1   11
#> 25   30 #78C1C1   11
#> 26   30 #78C1C1   11
#> 27   33 #6BBBBB   12
#> 28   34 #6BBBBB   12
#> 29   35 #5DB5B5   13
#> 30   37 #5DB5B5   13
#> 31   39 #50AFAF   14
#> 32   40 #43A9A9   15
#> 33   41 #43A9A9   15
#> 34   41 #43A9A9   15
#> 35   44 #35A3A3   16
#> 36   44 #35A3A3   16
#> 37   48 #289D9D   17
#> 38   50 #1A9797   18
#> 39   50 #1A9797   18
#> 40   57 #008B8B   20
scales::show_col(data$Col1 )

^{由代表 package (v2.0.1) 于 2022 年 8 月 5 日创建}