Data.Table若干高级技巧【R package】

最新推荐文章于 2022-07-07 00:48:49 发布

笛在月明

最新推荐文章于 2022-07-07 00:48:49 发布

阅读量3.4k

点赞数

分类专栏： R

R 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

data.table是由Matt Dowle创件的一个数据处理的包。其设计的主要目的是高效迅速的对大批量数据分组处理操作。它通过高效内存操作，设置keys、快速分组，以及滚动时序的快速合并的技巧，使其达到令人惊讶的效率。data.table主要通过二元检索法大大提高数据操作的效率，当然同时它也兼容适用于data.frame的向量检索法。

本文编译自Andrew Brooks总结的一些data.table的实用技巧。本文目的不在于介绍data.table的基本用法，而是在假设读者对data.table有一定了解后，通过具体的实例展示data.table的更加巧妙及强大的数据操作能力。如果没有接触过data.table，并想快速上手，建议参考datacamp提供的一个cheat sheet（https://s3.amazonaws.com/assets.datacamp.com/img/blog/data+table+cheat+sheet.pdf）。

文中所用数据实例来自R base中的Motor Trend Car Road Tests数据集，包含了32款车的11种特征：油耗，马力，车重等等。

1.数据结构与赋值

Columns of lists

如下的语句利用data.table语法summary一个数据表（long or narrow），和普通常用方法相比，没有特别之处。

dt <- data.table(mtcars)[, .(cyl, gear)]
dt[,unique(gear), by=cyl]
cyl V1
1: 6 4
2: 6 3
…

如果我们想得到对于每个cyl值，所有可能的gear列表，并把结果作为单独的一列添加到原始的表中（后续的例子中可以了解这样做的原因），data.table可以非常容易的做到。如下给出了两种语法。

dt <- data.table(mtcars)[,.(gear, cyl)]
dt[,gearsL:=list(list(unique(gear))), by=cyl]
dt[,gearsL:=.(list(unique(gear))), by=cyl]
gear cyl gearsL
1: 4 6 4,3,5
2: 4 6 4,3,5
…

使用第二种方法更简洁，可是不直观。但是，如果了解并习惯data.table中.（的操作，在这里其和list是等效的操作。

Accessing elements from a column of lists

完成上面的操作后，新得到的列gerasL实际是一个由list的元素组成的一个list。如果我们想得到每一行对应的这个list中特定位置的值，应该怎么用data.table完成？

提示：对list的批量操作，我们可以使用lapply()和sapply()这两个函数。

dt[,gearL1:=lapply(gearsL, function(x) x[2])]
dt[,gearS1:=sapply(gearsL, function(x) x[2])]
head(dt)
gear cyl gearsL gearL1 gearS1
1: 4 6 4,3,5 3 3
2: 4 6 4,3,5 3 3
…

注意，新得到的两列gearL1和gearS1本质上是不同的数据结构，如下所示：

str(head(dt[,gearL1]))
List of 6
$: num 3$ : num 3
…
str(head(dt[,gearS1]))
num [1:6] 3 3 3 3 5 3

有没有更简洁的操作呢？类似我们先前的例子，可以考虑使用`[操作符（即R的取值操作）：

dt[,gearL1:=lapply(gearsL, [, 2)]
dt[,gearS1:=sapply(gearsL, [, 2)]

上面的例子中，得到了对于每一行数据的，相同cyl的所有的gear的可能值列表，进一步，想得到所有出去该行数据的gear值的所有相同cyl组中的其他可能值，如何操作？可以考虑使用mapply()函数。

dt[,other_gear:=mapply(function(x, y)
setdiff(x, y), x=gearsL, y=gear)]
head(dt)
gear cyl gearsL gearL1 gearS1 other_gear
1: 4 6 4,3,5 3 3 3,5
2: 4 6 4,3,5 3 3 3,5
…

进一步简化，可以写成：

dt[,other_gear:=mapply(setdiff, gearsL, gear)]

Suppressing intermediate output with {}

这里是借用了base的{功能，将一系列的语句括成一段，可以按顺序完成一系列的操作，而不需要保留中间过程的临时变量。比如如下的例子：

dt <- data.table(mtcars)

默认情况下，只返回{}括起的程序段中最后一个指令的结果，并且是未命名的。

dt[,{tmp1=mean(mpg); tmp2=mean(abs(mpg-tmp1)); tmp3=round(tmp2, 2)}, by=cyl]

 cyl   V1

1: 6 1.19
2: 4 3.83
3: 8 1.79

也可以通过list操作，将选定的多个结果传递出来
dt[,{tmp1=mean(mpg); tmp2=mean(abs(mpg-tmp1)); tmp3=round(tmp2, 2);list(tmp2=tmp2, tmp3=tmp3)}, by=cyl]

cyl tmp2 tmp3
1: 6 1.191837 1.19
2: 4 3.833058 3.83
3: 8 1.785714 1.79

如果写成多行操作，可以略去”；”。

dt[,{tmp1=mean(mpg)
tmp2=mean(abs(mpg-tmp1))
tmp3=round(tmp2, 2)
list(tmp2=tmp2, tmp3=tmp3)},
by=cyl]

cyl     tmp2 tmp3

1: 6 1.191837 1.19
2: 4 3.833058 3.83
3: 8 1.785714 1.79

这种在data.table使用语句块的方法，没有内置的:= 赋值方法直接，但:= 不适合与{合用。使用:= 给多列同时赋值的时候，不能像先前我们展示的那样，利用先前构建的列来计算新构建的列。如果使用:=可以利用data.table的Chaining功能，然后在最后舍弃中间变量：

dt <- data.table(mtcars)[,.(cyl, mpg)]
dt[,tmp1:=mean(mpg), by=cyl][,tmp2:=mean(abs(mpg-tmp1)), by=cyl][,tmp1:=NULL]
head(dt)
cyl mpg tmp2
1: 6 21.0 1.191837
2: 6 21.0 1.191837
…

Fast looping with set

大多数情况下， loop和set操作的结合可以用:= 赋值操作在data.table中简单有效的实现。多数情况下，:=非常灵活和有效。但当某些情况下，必须进行loop操作时，set的效率远大于R base中的赋值操作。
(注：最新版的R base DF赋值操作的效率已经有了显著提高，和set的效率差别有缩小，但仍然有近60倍的区别)

M = matrix(1,nrow=100000,ncol=100)
DF = as.data.frame(M)
DT = as.data.table(M)
system.time(for (i in 1:1000) DF[i,1L] <- i) # 0.238s
system.time(for (i in 1:1000) DT[i,V1:=i]) # 0.356s
system.time(for (i in 1:1000) M[i,1L] <- i) # 0.020s
system.time(for (i in 1:1000) set(DT,i,1L,i)) # 0.004s

某些情况下，结合lapply函数与.SD的操作，data.table的作者偏好用loop+set完成。当我们需要对特定的列的子集操作的时候，使用set是非常好的选择。（相同的结果也可以使用.SDcols 来得到）

dt <- data.table(mtcars)[,1:5, with=F]
for (j in c(1L,2L,4L)) set(dt, j=j, value=-dt[[j]])
integers using ‘L’ passed for efficiency
for (j in c(3L,5L)) set(dt, j=j, value=paste0(dt[[j]],’!!’))
head(dt)

  mpg cyl  disp   hp   drat

1: -21.0 -6 160!! -110 3.9!!
2: -21.0 -6 160!! -110 3.9!!
…

Using shift to lead/lag vectors and lists

这个功能之在1.9.5后续版本才有。Base R没有一个很好的工具，来处理向量中的leads/lags。

dt <- data.table(mtcars)[,.(mpg, cyl)]
dt[,mpg_lag1:=shift(mpg, 1)]
dt[,mpg_forward1:=shift(mpg, 1, type=’lead’)]
head(dt)

  mpg cyl mpg_lag1 mpg_forward1

1: 21.0 6 NA 21.0
2: 21.0 6 21.0 22.8
…

shift with by

creating some data
n <- 30
dt <- data.table(
date=rep(seq(as.Date(‘2010-01-01’), as.Date(‘2015-01-01’), by=’year’), n/6),
ind=rpois(n, 5),
entity=sort(rep(letters[1:5], n/5))
)
setkey(dt, entity, date) # important for ordering
dt[,indpct_fast:=(ind/shift(ind, 1))-1, by=entity]
lagpad <- function(x, k) c(rep(NA, k), x)[1:length(x)]
dt[,indpct_slow:=(ind/lagpad(ind, 1))-1, by=entity]

head(dt, 10)

      date ind entity indpct_fast indpct_slow

1: 2010-01-01 4 a NA NA
2: 2011-01-01 5 a 0.2500000 0.2500000
3: 2012-01-01 5 a 0.0000000 0.0000000
…

Create multiple columns with := in one statement

利用一个操作时创建多个新的列，可以使用:=来实现，需要注意的是，新建的列只能由表中已有的列计算得到。

dt <- data.table(mtcars)[,.(mpg, cyl)]
dt[,:=(avg=mean(mpg), med=median(mpg), min=min(mpg)), by=cyl]
head(dt)

  mpg cyl      avg  med  min

1: 21.0 6 19.74286 19.7 17.8
2: 21.0 6 19.74286 19.7 17.8
…

Assign a column with := named with a character object

新创建列时，列名已经保存在你程序中的某变量中，使用:=赋值操作时，只需要简单的用括号括上该字符串变量。

dt <- data.table(mtcars)[, .(cyl, mpg)]

thing2 <- ‘mpgx2’

dt[,(thing2):=mpg*2]head(dt)

cyl  mpg mpgx2

1: 6 21.0 42.0
2: 6 21.0 42.0
…

也可以使用with=FALSE这个option，但不推荐使用该方法。

thing3 <- ‘mpgx3’
dt[,thing3:=mpg*3, with=F]
head(dt)

 cyl  mpg mpgx2 mpgx3

1: 6 21.0 42.0 63.0
2: 6 21.0 42.0 63.0
…

by的使用

Calculate a function over a group (using by) excluding each entity in a second category.

我们可以从一个具体的实例场景来更好的理解data.table中by的实现机制和具体作用。利用我们先前的数据例子：mtcars，假设我们想比较每一行数据（每一款车）中的mpg和与其相同类别（相同的cylinders）中的其他车的平均mpg，但是在计算平均值进行比较时，需要的是无偏的估计，也就是需要计算去除该车以外其他所有车的mpg的均值。如何在data.table中高效的实现？

METHOD 1: in-line

首先来计算有偏均值计算

dt <- data.table(mtcars)[,.(cyl, gear, mpg)]

dt[, mpg_biased_mean:=mean(mpg), by=cyl]
head(dt)

 cyl gear  mpg mpg_biased_mean

1: 6 4 21.0 19.74286
2: 6 4 21.0 19.74286
…

然后利用data.table中.GRP操作，求无偏均值。
dt[, dt[!gear %in% unique(dt$gear)[.GRP], mean(mpg), by=cyl], by=gear]

 gear cyl       V1

1: 4 6 19.73333
2: 4 8 15.10000
3: 4 4 25.96667
…

我们可以简单的验证如上的结果，比如说，想得到所有cyl为6的但gear不为4的mpg均值：

dt[gear!=4 & cyl==6, mean(mpg)]
[1] 19.73333

对应先前结果的第一行。

类似于使用.GRP方法的等效操作，可以写成：

dt[, dt[!gear %in% .BY[[1]], mean(mpg), by=cyl], by=gear] #unbiased mean

 gear cyl       V1

1: 4 6 19.73333
2: 4 8 15.10000
3: 4 4 25.96667
…

下面我们来分析下，.GRP在这里的具体作用原理

首先：.GRP是按by操作的结果给每个group一个访问的ID.这里是按cyl分组。

dt[, .GRP, by=cyl]
cyl GRP
1: 6 1
2: 4 2
3: 8 3

然后，可以得到每一个cyl组中，有多少不同的gear

dt[, .(.GRP, unique(dt$gear)[.GRP]), by=cyl]
cyl GRP V2
1: 6 1 4
2: 4 2 3
3: 8 3 5

最外层，再次嵌套按gear分组，把得到的信息扩展开

dt[,dt[, .(.GRP, unique(dt$gear)[.GRP]), by=cyl], by=gear]

 gear cyl GRP V2

1: 4 6 1 4
2: 4 4 2 3
3: 4 8 3 5
…

如何提高多次分组的效率？使用data.table中setting key功能。

setkey(dt, gear)
uid <- unique(dt$gear)
dt[, dt[!.(uid[.GRP]), mean(mpg), by=cyl] , by=gear] #unbiased mean

 gear cyl       V1

1: 3 6 19.74000
2: 3 4 27.18000
3: 3 8 15.40000
…

检查结果

mean(dt[cyl==4 & gear!=3,mpg])
[1] 27.18

METHOD 2: using {} and .SD

我们在前面的例子中已经了解过，利用{}操作可以隐藏数据操作中的中间变量，这里我们可以利用这个特性来解决求无偏均值的问题。

一步的实现

dt[, .SD[, mean(mpg)], by=gear] # same as dt[, mean(mpg), by=gear]

 gear       V1

1: 3 16.10667
2: 4 24.53333
3: 5 21.38000

dt[, .SD[, mean(mpg), by=cyl], by=gear]
same as dt[, mean(mpg), by=.(cyl, by=gear)]
or dt[, mean(mpg), by=.(cyl, gear)]

嵌套data.table和by操作

下面的程序嵌套了两个by操作和两层不同的data.table。其中的n是某cyl类别中车的数量，而N是某cyl组中特定gear的车的数量。多个计算组成程序块，由{}括起。

dt[,{
vbar = sum(mpg)
n = .N
.SD[,.(n, .N, sum_in_gear_cyl=sum(mpg), sum_in_cyl=vbar), by=gear]
} , by=cyl]

 cyl gear  n  N sum_in_gear_cyl sum_in_cyl

1: 6 3 7 2 39.5 138.2
2: 6 4 7 4 79.0 138.2
3: 6 5 7 1 19.7 138.2
…

作为测试，检查结果：

dt[,sum(mpg), by=cyl]

 cyl    V1

1: 6 138.2
2: 8 211.4
3: 4 293.3

有了这个结果后，计算无偏均值就很直接简单了。

dt[,{
vbar = mean(mpg)
n = .N
.SD[,(n*vbar-sum(mpg))/(n-.N),by=gear]} , by=cyl]
cyl gear V1
1: 6 3 19.74000
2: 6 4 19.73333
3: 6 5 19.75000
…

METHOD 3: Super Fast Mean calculation

有没有方法更快的完成这个任务？可以考虑利用向量操作的快速的特点对每一个gear和cyl的组合来计算无偏的mpg。实现上，利用类似的想法，先计算有偏的均值，然后减去需要排除的实例。

dt <- data.table(mtcars)[,.(mpg,cyl,gear)]

dt[,:=(avg_mpg_cyl=mean(mpg), Ncyl=.N), by=cyl]
dt[,:=(Ncylgear=.N, avg_mpg_cyl_gear=mean(mpg)), by=.(cyl, gear)]
dt[,unbmean:=(avg_mpg_cyl*Ncyl-(Ncylgear*avg_mpg_cyl_gear))/(Ncyl-Ncylgear)]
setkey(dt, cyl, gear)
head(dt)

  mpg cyl gear avg_mpg_cyl Ncyl Ncylgear avg_mpg_cyl_gear  unbmean

1: 21.5 4 3 26.66364 11 1 21.500 27.18000
2: 22.8 4 4 26.66364 11 8 26.925 25.96667
3: 24.4 4 4 26.66364 11 8 26.925 25.96667
…

为了代码的易读和维护，可以把一系列操作抽提成自定义函数。

leaveOneOutMean <- function(dt, ind, bybig, bysmall) {
dtmp <- copy(dt)
# copy so as not to alter original dt object w intermediate assignments
dtmp <- dtmp[is.na(get(ind))==F,]
dtmp[,:=(avg_ind_big=mean(get(ind)), Nbig=.N), by=.(get(bybig))]
dtmp[,:=(Nbigsmall=.N, avg_ind_big_small=mean(get(ind))), by=.(get(bybig), get(bysmall))]
dtmp[,unbmean:=(avg_ind_big*Nbig-(Nbigsmall*avg_ind_big_small))/(Nbig-Nbigsmall)]
return(dtmp[,unbmean])
}

dt <- data.table(mtcars)[,.(mpg,cyl,gear)]
dt[,unbiased_mean:=leaveOneOutMean(.SD, ind=’mpg’, bybig=’cyl’, bysmall=’gear’)]
dt[,biased_mean:=mean(mpg), by=cyl]
head(dt)

  mpg cyl gear unbiased_mean biased_mean

1: 21.0 6 4 19.73333 19.74286
2: 21.0 6 4 19.73333 19.74286
…

下面比较上述三种方法的速度。

dt <- data.table(mtcars)

dt <- dt[sample(1:.N, 100000, replace=T), ]
increase # of rows in mtcars
dt$gear <- sample(1:300, nrow(dt), replace=T)
adding in more cateogries

方法3:

system.time(dt[,unbiased_mean_vectorized:=leaveOneOutMean(.SD, ind=’mpg’, bybig=’cyl’, bysmall=’gear’)])

 user  system elapsed

0.053 0.004 0.056

方法2:

system.time(dt[,{
+ vbar = mean(mpg)
+ n = .N
+ .SD[,(n*vbar-sum(mpg))/(n-.N),by=gear]
+ } , by=cyl])

 user  system elapsed 
0.016   0.000   0.016

方法1:

uid <- unique(dt$gear)system.time(dt[, dt[!gear %in% (uid[.GRP]), mean(mpg), by=cyl] , by=gear][order(cyl, gear)])
user system elapsed
3.58 0.00 3.47

可以看出，方法2最快，方法3比方法1要快100倍。需要注意的是，方法2得到的是summary table，需要有额外的操作才能把结果join到原始表中。

Using [1], [.N], setkey and by for within group subsetting

问题：列出表中column X的最大值，其对应的column Y是按column Z分组中的最大值。

首先，例如，列出每一cyl组中最大的qsec

dt <- data.table(mtcars)[, .(cyl, mpg, qsec)]

dt[, max(qsec), by=cyl]

cyl    V1

1: 6 20.22
2: 4 22.90
3: 8 18.00

每一cyl组中最大mpg对应的qsec?

setkey(dt, mpg)
dt[,qsec[.N], by=cyl]

 cyl    V1

1: 8 17.05
2: 6 19.44
3: 4 19.90

每一cyl组中最小mpg对应的qsec?

dt[,qsec[1], by=cyl]

 cyl    V1

1: 8 17.98
2: 6 18.90
3: 4 18.60

找到qsec值相对应的mpg为每一cyl组的中值？

dt[,qsec[round(.N/2)], by=cyl]

 cyl   V1

1: 8 18.0
2: 6 15.5
3: 4 16.7

这里，大概可以了解了[1]或[.N]的机制了，下面我们看一个稍微复杂的例子。创建两列，一个是每一cyl组中mpg的标准偏差，另一列是每一cyl组中top 50%的标准偏差。

dt <- data.table(mtcars)
setkey(dt,mpg)

dt[, .(sd(mpg), sd(mpg[1:round(.N/2)])), by=cyl]

 cyl       V1        V2

1: 8 2.560048 2.0926174
2: 6 1.453567 0.8981462
3: 4 4.509828 1.7728508

FUNCTIONS

如何在函数中传递data.table的列名做为参数？

方法1: 不使用引号，使用deparse和substitute的结合。

dt <- data.table(mtcars)[,.(cyl, mpg)]
myfunc <- function(dt, v) {
v2=deparse(substitute(v))
dt[,v2, with=F][[1]] # [[1]] returns a vector
}
myfunc(dt, mpg)

方法2: 使用引号，利用get函数操作

dt <- data.table(mtcars)
myfunc <- function(dt, v) dt[,get(v)]

myfunc(dt, ‘mpg’)

注：本文由dataomics网友原创整理