r语言 - 缩放数据的列.表到单位间隔

Question

我有一个数据。包含数字和因子数据的混合表，例如:

R> dat
x           z y w 
1: 3.307590 -1.66951137 b a               
2: 1.809447  4.10331322 b b               
3: 3.314621  3.69436879 a a               
4: 1.896529 -0.08143017 c b               
5: 3.317341  1.01839533 c a               
6: 1.806456 -2.09547272 a b               
...

我需要将每个数值变量(x和z)缩放到单位间隔。我将它们的最小值和最大值存储在一个单独的矩阵中(最大值不是简单的max(x))。第一行是每个数值变量的最小值，第二行是最大值。

> cts.mat
x  z
[1,] 1 -3
[2,] 4  5

我如何使用矩阵中的边界缩放x和z列?

我试过像

dat[, lapply(.SD, range01, cts.mat), .SDcol = c("x", "z")]

其中range01为函数

range01 <- function(x, cts.mat) {
x.as.string <- deparse(substitute(x))
# This is (x-lower)/(upper-lower)
(x - cts.mat[, x.as.string][1]) / (cts.mat[, x.as.string][2] - cts.mat[, x.as.string][1])
}

但这不起作用。我认为我的核心问题是，我不知道如何运行一个lapply的参数变化为dat的每一列。在这种情况下，变化的参数是每个数字列的最小值和最大值。

谢谢你的帮助。

Answer 1

我发现一个循环的方法,我认为这是不够好。如果有人知道怎么做数据。表lapply，我仍然对一个解决方案感兴趣。

cts.names <- c("x", "z")
for (var in cts.names) {
dat[, (var) := scales::rescale(get(var),
from = c(0, 1),
to = cts.mat[, var])]
}

Answer 2

我对lapply的性能提升感到非常惊讶:

microbenchmark::microbenchmark(
set_loop={
for (var in colnames(cts.mat)) {
set(dat,j=var,value=scales::rescale(dat[[var]],
from = c(0, 1),
to = cts.mat[, var]))}
},
dt_loop={
for (var in colnames(cts.mat)) {
dat[, c(var) := scales::rescale(dat[[var]],
from = c(0, 1),
to = cts.mat[, var])]
}},
lapply={
lapply(colnames(cts.mat),
function(var) set(dat,j=var,value=scales::rescale(dat[[var]],
from = c(0, 1),
to = cts.mat[, var])))})
# Unit: microseconds
#     expr    min      lq     mean  median      uq     max neval
# set_loop 2342.9 2380.90 2523.414 2437.15 2531.30  4856.3   100
#  dt_loop 3109.0 3176.40 4000.359 3247.70 3383.35 64652.8   100
#   lapply   65.8   74.85  103.510   83.85   90.00  2100.3   100

我验证了这三种方法的结果是相同的，如果有一个解释感兴趣。也许可以尝试使用更大的数据集?

library(data.table)
dat <- read.table(text='x           z y w 
1: 3.307590 -1.66951137 b a               
2: 1.809447  4.10331322 b b               
3: 3.314621  3.69436879 a a               
4: 1.896529 -0.08143017 c b               
5: 3.317341  1.01839533 c a               
6: 1.806456 -2.09547272 a b ',header=T)
setDT(dat)

cts.mat <- read.table(text='
x  z
1: 1 -3
2: 4  5', header=T)
cts.mat <- as.matrix(cts.mat)
dat.ref <- copy(dat)
dat <- copy(dat.ref)
# set + loop
for (var in colnames(cts.mat)) {
set(dat,j=var,value=scales::rescale(dat[[var]],
from = c(0, 1),
to = cts.mat[, var]))}
result.set.loop <- copy(dat)
# dt + loop
dat <- copy(dat.ref)
for (var in colnames(cts.mat)) {
dat[, c(var) := scales::rescale(dat[[var]],
from = c(0, 1),
to = cts.mat[, var])]
}
result.dt.loop <- copy(dat)
# set + lapply  
dat <- copy(dat.ref)
lapply(colnames(cts.mat),function(var) set(dat,j=var,value=scales::rescale(dat[[var]],
       from = c(0, 1),
       to = cts.mat[, var])))
#> [[1]]
#>            x          z y w
#> 1: 10.922770 -16.356091 b a
#> 2:  6.428341  29.826506 b b
#> 3: 10.943863  26.554950 a a
#> 4:  6.689587  -3.651441 c b
#> 5: 10.952023   5.147163 c a
#> 6:  6.419368 -19.763782 a b
#> 
#> [[2]]
#>            x          z y w
#> 1: 10.922770 -16.356091 b a
#> 2:  6.428341  29.826506 b b
#> 3: 10.943863  26.554950 a a
#> 4:  6.689587  -3.651441 c b
#> 5: 10.952023   5.147163 c a
#> 6:  6.419368 -19.763782 a b
result.set.lapply <- copy(dat)
all.equal(result.dt.loop,result.set.loop)
#> [1] TRUE
all.equal(result.set.loop,result.set.lapply)
#> [1] TRUE