🧖 🛕 🐺 围绕数据表 🙀 🎈 🙎🏽

对于使用R-data.table的表数据处理库的人员来说，此注释将很有趣，并且也许很高兴通过各种示例看到其应用程序的灵活性。

受同事的一个很好的例子的启发，并希望您已经阅读了他的文章，我建议更深入地研究基于data.table的代码和性能优化。

简介：data.table来自哪里？

最好从头开始了解该库，即从可以获取data.table对象（以下称为DT）的数据结构开始。

数组

编码

## arrays ---------

arrmatr <- array(1:20, c(4,5))

class(arrmatr)

typeof(arrmatr)

is.array(arrmatr)

is.matrix(arrmatr)

这些结构之一是数组（？Base :: array）。与其他语言一样，数组在这里是多维的。但是，有趣的是，例如，二维数组开始从矩阵类（？Base :: matrix）继承属性，而一维数组（也很重要）没有从向量（？Base :: vector）继承。

应当理解，设施中包含的数据类型应通过函数base :: typeof进行检查，该函数根据与第一个C语言关联的R Internals通用语言协议返回该类型的内部描述。确定对象类的另一个命令是base :: class

，在使用vector的情况下，返回一个vector类型（它与内部名称不同，但也可以让您理解数据类型）。

清单

从二维数组开始，它是一个矩阵，您可以转到列表（？Base :: list）。

编码

## lists ------------------

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

在这种情况下，会同时发生几件事：

矩阵的第二维折叠，即，我们得到一个列表和一个向量。
因此，列表从这些类继承。应当记住，矩阵数组单元格中的单个（标量）值将对应于列表项。

由于列表也是一个向量，因此可以将一些向量功能应用于该列表。

数据框

从列表，矩阵或向量中，您可以转到数据框（？Base :: data.frame）。

编码

## data.frames ------------

df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)

is.list(df)

df$V6 <- df$V1 + df$V2

有趣的是：数据框继承自列表！数据框的列是列表单元格。将来，当我们使用应用于列表的功能时，这一点将很重要。

数据表

您可以从数据框，列表，向量或矩阵中获取DT（？Data.table :: data.table）。例如，这样（就位）。

编码

## data.tables -----------------------
library(data.table)

data.table::setDT(df)

is.list(df)

is.data.frame(df)

is.data.table(df)

像数据框一样，DT继承列表的属性很有用。

DT和记忆

与R base中的所有其他对象不同，DT通过引用传递。如果需要复制到新的存储区，则需要data.table :: copy函数，或者需要从旧对象中进行选择。

编码

df2 <- df

df[V1 == 1, V2 := 999]

data.table::fsetdiff(df, df2)

df2 <- data.table::copy(df)

df[V1 == 2, V2 := 999]

data.table::fsetdiff(df, df2)

在此介绍结束。DT是R中数据结构发展的延续，这主要是由于对数据帧类的对象执行的操作的扩展和加速而发生的。在这种情况下，保留了其他原语的继承。

使用data.table属性的一些示例

像清单...

遍历数据帧或DT的行并不是一个好主意，因为R语言中的循环代码比C慢得多，并且很有可能遍历通常少得多的列中的列。遍历各列时，请记住，每列都是一个列表项，通常包含一个向量。向量的操作在该语言的基本功能中已很好地向量化。您还可以使用特定于列表和向量的选择运算符：`[[`，`$`。

编码

## operations on data.tables ------------

#using list properties

df$'V1'[1]

df[['V1']]

df[[1]][1]

sapply(df, class)

sapply(df, function(x) sum(is.na(x)))

向量化

如果需要遍历大型DT，则最好使用矢量化编写函数。但是，如果它不能正常工作，应该记住的是，循环的内 DT在静止周期快将R，因为它运行在的C。

让我们尝试一个包含10万行的更大示例。我们将从列向量w中包含的单词中提取第一个字母。

更新

编码

library(magrittr)
library(microbenchmark)

## Bigger example ----

rown <- 100000

dt <- 
	data.table(
		w = sapply(seq_len(rown), function(x) paste(sample(letters, 3, replace = T), collapse = ' '))
		, a = sample(letters, rown, replace = T)
		, b = runif(rown, -3, 3)
		, c = runif(rown, -3, 3)
		, e = rnorm(rown)
	) %>%
	.[, d := 1 + b + c + rnorm(nrow(.))]

# vectorization

microbenchmark({
	dt[
		, first_l := unlist(strsplit(w, split = ' ', fixed = T))[1]
		, by = 1:nrow(dt)
	   ]
})

# second

first_l_f <- function(sd)
{
	strsplit(sd, split = ' ', fixed = T) %>%
		do.call(rbind, .) %>%
		`[`(,1)
}

dt[, first_l := NULL]

microbenchmark({
	dt[
		, first_l := .(first_l_f(w))
		]
})

# third

first_l_f2 <- function(sd)
{
	strsplit(sd, split = ' ', fixed = T) %>%
		unlist %>%
		matrix(nrow = 3) %>%
		`[`(1,)
}

dt[, first_l := NULL]

microbenchmark({
	dt[
		, first_l := .(first_l_f2(w))
		]
})

第一个运行遍历各行：

单位：毫秒
expr min
{dt [，`：=`（first_l，unlist（strsplit（w，split =“”，fixed = T））[1]），by = 1：nrow（dt）]} 439.6217
lq均值uq最大中位数
451.9998 460.1593 456.2505 460.9147 621.4042 100

第二轮，通过将列表变成矩阵并在索引为1的切片上获取元素来完成矢量化~~（后者实际上是矢量化）~~。我将恢复：在strsplit函数级别的向量化，可以将向量作为输入。事实证明，将列表转换为矩阵的过程比矢量化本身要困难得多，但在这种情况下，它比非矢量化版本要快得多。

单位：毫秒
expr最小值lq平均中位数uq最大值neval
{dt [，`：=`（first_l ,.（First_l_f（w）））]} 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100

中值加速度是3倍。

第三轮，转换成矩阵的方案被改变了。

单位：毫秒
expr最小值lq平均中位数uq最大值neval
{dt [，`：=`（first_l ,.（First_l_f2（w）））]} 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100

中值加速度是13倍。

您必须尝试做这个事情，越多越好。

向量化的另一个示例，其中也有文本，但它接近实际条件：单词长度不同，单词数量不同。必须获得前3个字。像这样：

这里的前一个函数不起作用，因为矢量的长度不同，我们设置了矩阵的大小。通过研究Internet重做此操作。

编码

# fourth

rown <- 100000

words <-
	sapply(
		seq_len(rown)
		, function(x){
			nwords <- rbinom(1, 10, 0.5)
			paste(
				sapply(
					seq_len(nwords)
					, function(x){
						paste(sample(letters, rbinom(1, 10, 0.5), replace = T), collapse = '')
					}
				)
				, collapse = ' '
			)
		}
	)

dt <- 
	data.table(
		w = words
		, a = sample(letters, rown, replace = T)
		, b = runif(rown, -3, 3)
		, c = runif(rown, -3, 3)
		, e = rnorm(rown)
	) %>%
	.[, d := 1 + b + c + rnorm(nrow(.))]

first_l_f3 <- function(sd, n)
{
	l <- strsplit(sd, split = ' ', fixed = T)
	
	maxl <- max(lengths(l))
	
	sapply(l, "length<-", maxl) %>%
		`[`(n,) %>%
		as.character
}

microbenchmark({
	dt[
		, (paste0('w_', 1:3)) := lapply(1:3, function(x) first_l_f3(w, x))
		]
})

dt[
	, (paste0('w_', 1:3)) := lapply(1:3, function(x) first_l_f3(w, x))
	]

单位：毫秒
expr min lq平均中位数

{dt [，`：=`（（paste0（“ w_”，1：3）），strsplit（w，split =“”，固定= T））]} 851.7623 916.071 1054.5 1035.199
uq max neval
1178.738 1356.816 100

该脚本以平均1秒的速度运行。不错。

找到另一种更经济的方式卡布拉格：

编码

# fifth

rown <- 100000

words <-
	sapply(
		seq_len(rown)
		, function(x){
			nwords <- rbinom(1, 10, 0.5)
			paste(
				sapply(
					seq_len(nwords)
					, function(x){
						paste(sample(letters, rbinom(1, 10, 0.5), replace = T), collapse = '')
					}
				)
				, collapse = ' '
			)
		}
	)

dt <- 
	data.table(
		w = words
		, a = sample(letters, rown, replace = T)
		, b = runif(rown, -3, 3)
		, c = runif(rown, -3, 3)
		, e = rnorm(rown)
	) %>%
	.[, d := 1 + b + c + rnorm(nrow(.))]

microbenchmark({
	
	w_split <- dt[
		, data.table::tstrsplit(w, split = ' ', fixed = T, keep = 1L:3L)
		]
	
	dt[
		, `:=` (
			w_1 = as.character(w_split[[1]])
			, w_2 = as.character(w_split[[2]])
			, w_3 = as.character(w_split[[3]])
		)
		]

})

中位数186，便宜5倍...

一链相连...

您可以使用链接使用DT对象。看起来右括号语法实际上是糖。

编码

# chaining

res1 <- dt[a == 'a'][sample(.N, 100)]

res2 <- dt[, .N, a][, N]

res3 <- dt[, coefficients(lm(e ~ d))[1], a][, .(letter = a, coef = V1)]

流经管道...

可以通过管道完成相同的操作，它看起来很相似，但是功能更丰富，因为您可以使用任何方法，而不仅仅是DT。我们使用许多柴油燃料过滤器得出合成数据的逻辑回归系数。

编码

# piping

samplpe_b <- dt[a %in% head(letters), sample(b, 1)]

res4 <- 
	dt %>%
	.[a %in% head(letters)] %>%
	.[, 
	  {
	  	dt0 <- .SD[1:100]
	  	
	  	quants <- 
	  		dt0[, c] %>%
	  		quantile(seq(0.1, 1, 0.1), na.rm = T)
	  	
	  	.(q = quants)
	  }
	  , .(cond = b > samplpe_b)
	  ] %>%
	glm(
		cond ~ q -1
		, family = binomial(link = "logit")
		, data = .
	) %>%
	summary %>%
	.[[12]]

DT内部的统计信息，机器学习等

您可以使用lambda函数，但有时最好单独创建它们，注册整个数据分析管道，然后在DT中使用它们。该示例丰富了上述所有功能，以及DT军械库中的一些有用信息（例如，通过引用访问DT内部的DT本身，有时不是顺序插入，而是插入）。

编码

# function

rm(lm_preds)

lm_preds <- function(
	sd, by, n
)
{
	
	if(
		n < 100 | 
		!by[['a']] %in% head(letters, 4)
	   )
	{
		
		res <-
			list(
				low = NA
				, mean = NA
				, high = NA
				, coefs = NA
			)
		
	} else {

		lmm <- 
			lm(
				d ~ c + b
				, data = sd
			)
		
		preds <- 
			stats::predict.lm(
				lmm
				, sd
				, interval = "prediction"
				)
		
		res <-
			list(
				low = preds[, 2]
				, mean = preds[, 1]
				, high = preds[, 3]
				, coefs = coefficients(lmm)
			)
	}

	res
	
}

res5 <- 
	dt %>%
	.[e < 0] %>%
	.[.[, .I[b > 0]]] %>%
	.[, `:=` (
		low = as.numeric(lm_preds(.SD, .BY, .N)[[1]])
		, mean = as.numeric(lm_preds(.SD, .BY, .N)[[2]])
		, high = as.numeric(lm_preds(.SD, .BY, .N)[[3]])
		, coef_c = as.numeric(lm_preds(.SD, .BY, .N)[[4]][1])
		, coef_b = as.numeric(lm_preds(.SD, .BY, .N)[[4]][2])
		, coef_int = as.numeric(lm_preds(.SD, .BY, .N)[[4]][3])
	)
	, a
	] %>%
	.[!is.na(mean), -'e', with = F]


# plot

plo <- 
	res5 %>%
	ggplot +
	facet_wrap(~ a) +
	geom_ribbon(
		aes(
			x = c * coef_c + b * coef_b + coef_int
			, ymin = low
			, ymax = high
			, fill = a
		)
		, size = 0.1
		, alpha = 0.1
	) +
	geom_point(
		aes(
			x = c * coef_c + b * coef_b + coef_int
			, y = mean
			, color = a
		)
		, size = 1
	) +
	geom_point(
		aes(
			x = c * coef_c + b * coef_b + coef_int
			, y = d
		)
		, size = 1
		, color = 'black'
	) +
	theme_minimal()

print(plo)

结论

我希望我能够创建诸如data.table这样的对象的完整（但当然不是完整的）图片，从其与R类继承相关的属性开始，以其自身的tidyverse元素和周围环境结束。希望这可以帮助您更好地学习和使用该库来工作和娱乐。

谢谢！

完整代码

编码

## load libs ----------------

library(data.table)
library(ggplot2)
library(magrittr)
library(microbenchmark)


## arrays ---------

arrmatr <- array(1:20, c(4,5))

class(arrmatr)

typeof(arrmatr)

is.array(arrmatr)

is.matrix(arrmatr)


## lists ------------------

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)


## data.frames ------------

df <- as.data.frame(arrmatr)

is.list(df)

df$V6 <- df$V1 + df$V2


## data.tables -----------------------

data.table::setDT(df)

is.list(df)

is.data.frame(df)

is.data.table(df)

df2 <- df

df[V1 == 1, V2 := 999]

data.table::fsetdiff(df, df2)

df2 <- data.table::copy(df)

df[V1 == 2, V2 := 999]

data.table::fsetdiff(df, df2)


## operations on data.tables ------------

#using list properties

df$'V1'[1]

df[['V1']]

df[[1]][1]

sapply(df, class)

sapply(df, function(x) sum(is.na(x)))


## Bigger example ----

rown <- 100000

dt <- 
	data.table(
		w = sapply(seq_len(rown), function(x) paste(sample(letters, 3, replace = T), collapse = ' '))
		, a = sample(letters, rown, replace = T)
		, b = runif(rown, -3, 3)
		, c = runif(rown, -3, 3)
		, e = rnorm(rown)
	) %>%
	.[, d := 1 + b + c + rnorm(nrow(.))]

# vectorization

# zero - for loop

microbenchmark({
	for(i in 1:nrow(dt))
		{
		dt[
			i
			, first_l := unlist(strsplit(w, split = ' ', fixed = T))[1]
		]
	}
})

# first

microbenchmark({
	dt[
		, first_l := unlist(strsplit(w, split = ' ', fixed = T))[1]
		, by = 1:nrow(dt)
	   ]
})

# second

first_l_f <- function(sd)
{
	strsplit(sd, split = ' ', fixed = T) %>%
		do.call(rbind, .) %>%
		`[`(,1)
}

dt[, first_l := NULL]

microbenchmark({
	dt[
		, first_l := .(first_l_f(w))
		]
})

# third

first_l_f2 <- function(sd)
{
	strsplit(sd, split = ' ', fixed = T) %>%
		unlist %>%
		matrix(nrow = 3) %>%
		`[`(1,)
}

dt[, first_l := NULL]

microbenchmark({
	dt[
		, first_l := .(first_l_f2(w))
		]
})

# fourth

rown <- 100000

words <-
	sapply(
		seq_len(rown)
		, function(x){
			nwords <- rbinom(1, 10, 0.5)
			paste(
				sapply(
					seq_len(nwords)
					, function(x){
						paste(sample(letters, rbinom(1, 10, 0.5), replace = T), collapse = '')
					}
				)
				, collapse = ' '
			)
		}
	)

dt <- 
	data.table(
		w = words
		, a = sample(letters, rown, replace = T)
		, b = runif(rown, -3, 3)
		, c = runif(rown, -3, 3)
		, e = rnorm(rown)
	) %>%
	.[, d := 1 + b + c + rnorm(nrow(.))]

first_l_f3 <- function(sd, n)
{
	l <- strsplit(sd, split = ' ', fixed = T)
	
	maxl <- max(lengths(l))
	
	sapply(l, "length<-", maxl) %>%
		`[`(n,) %>%
		as.character
}

microbenchmark({
	dt[
		, (paste0('w_', 1:3)) := lapply(1:3, function(x) first_l_f3(w, x))
		]
})

dt[
	, (paste0('w_', 1:3)) := lapply(1:3, function(x) first_l_f3(w, x))
	]


# chaining

res1 <- dt[a == 'a'][sample(.N, 100)]

res2 <- dt[, .N, a][, N]

res3 <- dt[, coefficients(lm(e ~ d))[1], a][, .(letter = a, coef = V1)]

# piping

samplpe_b <- dt[a %in% head(letters), sample(b, 1)]

res4 <- 
	dt %>%
	.[a %in% head(letters)] %>%
	.[, 
	  {
	  	dt0 <- .SD[1:100]
	  	
	  	quants <- 
	  		dt0[, c] %>%
	  		quantile(seq(0.1, 1, 0.1), na.rm = T)
	  	
	  	.(q = quants)
	  }
	  , .(cond = b > samplpe_b)
	  ] %>%
	glm(
		cond ~ q -1
		, family = binomial(link = "logit")
		, data = .
	) %>%
	summary %>%
	.[[12]]


# function

rm(lm_preds)

lm_preds <- function(
	sd, by, n
)
{
	
	if(
		n < 100 | 
		!by[['a']] %in% head(letters, 4)
	   )
	{
		
		res <-
			list(
				low = NA
				, mean = NA
				, high = NA
				, coefs = NA
			)
		
	} else {

		lmm <- 
			lm(
				d ~ c + b
				, data = sd
			)
		
		preds <- 
			stats::predict.lm(
				lmm
				, sd
				, interval = "prediction"
				)
		
		res <-
			list(
				low = preds[, 2]
				, mean = preds[, 1]
				, high = preds[, 3]
				, coefs = coefficients(lmm)
			)
	}

	res
	
}

res5 <- 
	dt %>%
	.[e < 0] %>%
	.[.[, .I[b > 0]]] %>%
	.[, `:=` (
		low = as.numeric(lm_preds(.SD, .BY, .N)[[1]])
		, mean = as.numeric(lm_preds(.SD, .BY, .N)[[2]])
		, high = as.numeric(lm_preds(.SD, .BY, .N)[[3]])
		, coef_c = as.numeric(lm_preds(.SD, .BY, .N)[[4]][1])
		, coef_b = as.numeric(lm_preds(.SD, .BY, .N)[[4]][2])
		, coef_int = as.numeric(lm_preds(.SD, .BY, .N)[[4]][3])
	)
	, a
	] %>%
	.[!is.na(mean), -'e', with = F]


# plot

plo <- 
	res5 %>%
	ggplot +
	facet_wrap(~ a) +
	geom_ribbon(
		aes(
			x = c * coef_c + b * coef_b + coef_int
			, ymin = low
			, ymax = high
			, fill = a
		)
		, size = 0.1
		, alpha = 0.1
	) +
	geom_point(
		aes(
			x = c * coef_c + b * coef_b + coef_int
			, y = mean
			, color = a
		)
		, size = 1
	) +
	geom_point(
		aes(
			x = c * coef_c + b * coef_b + coef_int
			, y = d
		)
		, size = 1
		, color = 'black'
	) +
	theme_minimal()

print(plo)

围绕数据表