Около data.table

Тази бележка ще представлява интерес за онези, които използват библиотеката за обработка на таблични данни за R - 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::matrix), и едномерен масив, който също е важен, не наследява от вектор (?база::вектор).

Трябва да се разбере, че типът данни, съдържащи се във всеки обект, трябва да се проверява с функцията база::тип, което връща вътрешното описание на типа според R вътрешни части - общият протокол на езика, свързан с оригинала C.

Друга команда за определяне на класа на обект е база :: клас, в случай на вектори, връща векторния тип (различава се по име от вътрешния, но също така ви позволява да разберете типа данни).

Списък

От двуизмерен масив, известен също като матрица, можете да отидете до списъка (?base::list).

Код

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

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

Няколко неща се случват едновременно:

• Второто измерение на матрицата се свива, тоест получаваме и списък, и вектор едновременно.
• По този начин списъкът наследява от тези класове. Трябва да се има предвид, че елемент от списък ще съответства на една (скаларна) стойност от клетка от матрицата на масива.

Тъй като списъкът също е вектор, някои векторни функции могат да бъдат приложени към него.

Dataframe

Можете да преминете от списък, матрица или вектор към рамка с данни (?base::data.frame).

Код

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

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

is.list(df)

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

Какво е интересно за него: рамката с данни наследява от списъка! Колоните на Dataframe са клетки от списък. Това ще бъде важно по-късно, когато използваме функции, приложени към списъци.

таблица с данни

Вземете 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, което се дължи главно на разширяването и ускоряването на операциите, извършвани върху обекти от класа dataframe. В същото време се запазва наследството от други примитиви.

Някои примери за използване на свойства на 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.

Нека опитаме на по-голям пример със 100K реда. Ще извлечем първата буква от думите, включени във векторната колона 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))
		]
})

Първо изпълнение, итериране на редове:

Единица: милисекунди
израз мин
{dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq средна медиана uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100

Второто изпълнение, при което векторизацията се извършва чрез превръщане на списъка в матрица и вземане на елементи от среза с индекс 1 (последното е самата векторизация). Корекция: векторизация на функционално ниво strsplit, който може да приеме вектор като вход. Оказва се, че процедурата за превръщане на списък в матрица е много по-трудна от самата векторизация, но в този случай е много по-бърза от невекторизираната версия.

Единица: милисекунди
expr min lq средна медиана uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100

Ускорение по медиана в 3 пъти.

Третият цикъл, където схемата за трансформация в матрицата е променена.

Единица: милисекунди
expr min lq средна медиана uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100

Ускорение по медиана в 13 пъти.

Трябва да експериментирате с този въпрос, колкото повече, толкова по-добре ще бъде.

Друг пример с векторизация, където също има текст, но е близък до реалните условия: различни дължини на думите, различен брой думи. Трябва да получите първите 3 думи. като това:

Тук предишната функция не работи, тъй като векторите са с различна дължина и ние задаваме размера на матрицата. Нека повторим това, като се разровим в интернет.

Код

# 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 секунда. не е лошо

Свързани с една верига...

Можете да работите с 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. Нека изведем коефициенти на логистична регресия за нашите синтетични данни с редица филтри на 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

Можете да използвате ламбда функции, но понякога е по-добре да ги създадете отделно, да напишете целия тръбопровод за анализ на данни и давайте напред - те работят вътре в 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)

Източник: www.habr.com