Околу податоци.табела

Оваа белешка ќе биде од интерес за оние кои ја користат библиотеката за обработка на податоци со табели за 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)

Една таква структура е низа (?основа::низа). Како и кај другите јазици, низите овде се повеќедимензионални. Сепак, интересното е што, на пример, дводимензионална низа почнува да наследува својства од класата на матрицата (?основа::матрица), а еднодимензионалната низа, која е исто така важна, не наследува од вектор (?основа::вектор).

Треба да се разбере дека типот на податоци содржани во кој било објект треба да се провери со помош на функцијата основа::тип, кој го враќа описот на внатрешниот тип според R Внатрешни работи - општиот протокол на јазикот поврзан со оригиналот C.

Друга команда за одредување на класата на објектот е база::класа, во случај на вектори, го враќа векторскиот тип (се разликува по име од внатрешниот, но исто така ви овозможува да го разберете типот на податоци).

Листа

Од дводимензионална низа, позната и како матрица, можете да отидете на списокот (?основа::листа).

Код

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

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

Неколку работи се случуваат одеднаш:

• Втората димензија на матрицата пропаѓа, односно добиваме и листа и вектор во исто време.
• Списокот на тој начин наследува од овие класи. Мора да се има на ум дека елементот од списокот ќе одговара на една (скаларна) вредност од ќелија од матрицата на низата.

Бидејќи листата е исто така вектор, на неа може да се применат некои векторски функции.

Рамка на податоци

Можете да преминете од листа, матрица или вектор до податочна рамка (?база::податоци.рамка).

Код

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

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

is.list(df)

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

Што е интересно за тоа: податочната рамка наследува од листата! Колоните на податочната рамка се ќелии со листа. Ова ќе биде важно подоцна кога ќе ги користиме функциите применети на списоците.

податоци. табела

Земете DT (?податоци.табела::податоци.табела) може да биде од податочна рамка, листа, вектор или матрица. На пример, вака (на место).

Код

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

data.table::setDT(df)

is.list(df)

is.data.frame(df)

is.data.table(df)

Корисно е, како податочна рамка, DT да ги наследува својствата на списокот.

ДТ и меморија

За разлика од сите други објекти во R базата, DT се пренесуваат со референца. Ако треба да направите копија во нова мемориска област, потребна ви е функција податоци.табела::копија или треба да направите избор од стариот објект.

Код

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, што главно се јавува поради проширувањето и забрзувањето на операциите извршени на објекти од класата на податочна рамка. Во исто време, наследството од другите примитивци е зачувано.

Некои примери за користење на својствата на податоци.табела

Како список...

Повторувањето преку редовите на податочната рамка или 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)))

Векторизација

Ако има потреба да се помине низ линиите на голем ДТ, најдобро решение би било да се напише функција со векторизација. Но, ако ова не функционира, тогаш треба да запомните дека циклусот внатре ДТ е сепак побрз од циклусот 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 невал
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 и завршувајќи со неговите сопствени карактеристики и околина од уредни елементи . Се надевам дека ова ќе ви помогне подобро да научите и да ја користите оваа библиотека за работа и забава.

Ви благодариме!

Целосен код

Код

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