Oko data.table

Ova napomena će biti od interesa za one koji koriste tabelarnu biblioteku za obradu podataka za R - data.table, i možda će im biti drago da vide fleksibilnost njene upotrebe u različitim primerima.

Inspirisan dobrim primjerom Kolege, i nadajući se da ste već pročitali njegov članak, predlažem da kopamo dublje u optimizaciju koda i performanse zasnovane na data.table.

Uvod: Odakle dolazi data.table?

Najbolje je da se upoznate sa bibliotekom malo izdaleka, odnosno sa strukturama podataka iz kojih se može dobiti objekat data.table (u daljem tekstu DT).

Massiv

Kod

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

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

class(arrmatr)

typeof(arrmatr)

is.array(arrmatr)

is.matrix(arrmatr)

Jedna takva struktura je niz (?base::array). Kao iu drugim jezicima, nizovi su i ovdje višedimenzionalni. Međutim, zanimljiva stvar je da, na primjer, dvodimenzionalni niz počinje nasljeđivati ​​svojstva iz matrične klase (?base::matrix), a jednodimenzionalni niz, što je također važno, ne nasljeđuje vektor (?base::vector).

Treba shvatiti da tip podataka sadržanih u bilo kojem objektu treba provjeriti pomoću funkcije base::typeof, koji vraća interni opis tipa prema R Internals - opšti protokol jezika koji je povezan sa originalom C.

Druga naredba za određivanje klase objekta je baza::klasa, u slučaju vektora, vraća tip vektora (razlikuje se po imenu od internog, ali vam takođe omogućava da razumete tip podataka).

lista

Iz dvodimenzionalnog niza, poznatog i kao matrica, možete ići na listu (?base::list).

Kod

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

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

Nekoliko stvari se dešava odjednom:

• Druga dimenzija matrice se kolabira, odnosno dobijamo i listu i vektor u isto vreme.
• Lista je stoga naslijeđena od ovih klasa. Mora se imati na umu da će element liste odgovarati jednoj (skalarnoj) vrijednosti iz ćelije matrice niza.

Budući da je lista također vektor, neke vektorske funkcije se mogu primijeniti na nju.

Dataframe

Možete ići sa liste, matrice ili vektora u okvir podataka (?base::data.frame).

Kod

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

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

is.list(df)

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

Ono što je zanimljivo u vezi s tim: dataframe nasljeđuje sa liste! Stupci okvira podataka su ćelije liste. Ovo će biti važno kasnije kada budemo koristili funkcije primijenjene na liste.

data.table

Uzmi DT (?data.table::data.table) može biti od dataframe, lista, vektor ili matrica. Na primjer, ovako (na mjestu).

Kod

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

data.table::setDT(df)

is.list(df)

is.data.frame(df)

is.data.table(df)

Korisno je da, poput okvira podataka, DT nasljeđuje svojstva liste.

DT i memorija

Za razliku od svih drugih objekata u R bazi, DT se prosljeđuju referencom. Ako trebate napraviti kopiju u novo memorijsko područje, potrebna vam je funkcija data.table::copy ili trebate napraviti selekciju iz starog objekta.

Kod

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)

Ovim je uvod završen. DT je ​​nastavak razvoja struktura podataka u R, koji se uglavnom javlja zbog proširenja i ubrzanja operacija koje se izvode na objektima klase dataframe. U isto vrijeme, očuvano je nasljeđe od drugih primitiva.

Neki primjeri korištenja svojstva data.table

Kao lista...

Iteracija preko redova okvira podataka ili DT nije dobra ideja, jer kod petlje u jeziku R mnogo sporije C, ali je sasvim moguće proći kroz kolone, koji su obično mnogo manji. Prolazeći kroz kolone, zapamtite da je svaka kolona element liste, koja obično sadrži vektor. I operacije na vektorima su dobro vektorizovane u osnovnim funkcijama jezika. Također možete koristiti operatore odabira zajedničke liste i vektore: `[[`, `$`.

Kod

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

Vektorizacija

Ako postoji potreba da se prođe kroz redove velikog DT-a, najbolje rješenje bi bilo napisati funkciju s vektorizacijom. Ali ako to ne uspije, onda treba zapamtiti da je ciklus unutar DT je ​​i dalje brži od ciklusa R, budući da se izvodi na C.

Pokušajmo na većem primjeru sa 100 redova. Izvući ćemo prvo slovo iz riječi uključenih u vektorski stupac w.

Ažurirano

Kod

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))
		]
})

Prvo pokrenite iteraciju po redovima:

Jedinica: milisekunde
ekspr min
{ dt[, `:=`(prvi_l, unlist(strsplit(w, split = " ", fiksno = T))[1]), by = 1:nrow(dt)] } 439.6217
lq srednja vrijednost uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100

Drugo pokretanje, gdje se vektorizacija događa pretvaranjem liste u matricu i uzimanjem elemenata na isječku sa indeksom 1 (potonji je sama vektorizacija). Ispravka: vektorizacija na funkcijskom nivou strsplit, koji može prihvatiti vektor kao ulaz. Ispada da je postupak pretvaranja liste u matricu mnogo teži od same vektorizacije, ali je u ovom slučaju mnogo brži od nevektorizirane verzije.

Jedinica: milisekunde
expr min lq srednji medijan uq max neval
{ dt[, `:=`(prvi_l, .(prvi_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100

Ubrzanje po medijani in 3 puta.

Treća serija, gdje je promijenjena šema transformacije u matricu.

Jedinica: milisekunde
expr min lq srednji medijan uq max neval
{ dt[, `:=`(prvi_l, .(prvi_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100

Ubrzanje po medijani in 13 puta.

Morate eksperimentirati s ovom materijom, što više, to će biti bolje.

Još jedan primjer sa vektorizacijom, gdje postoji i tekst, ali je blizak stvarnim uvjetima: različite dužine riječi, različit broj riječi. Morate dobiti prve 3 riječi. Volim ovo:

Ovdje prethodna funkcija ne radi, jer su vektori različite dužine, a mi postavljamo veličinu matrice. Ponovimo ovo kopanjem po internetu.

Kod

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

Jedinica: milisekunde
ekspr min lq srednji medijan

{ dt[, `:=`((paste0(“w_”, 1:3)), strsplit(w, split = " ", fiksno = T))] } 851.7623 916.071 1054.5 1035.199
uq max neval
1178.738 1356.816 100

Skripta je radila prosječnom brzinom od 1 sekunde. Nije loše.

Povezani jednim lancem...

Možete raditi sa DT objektima koristeći ulančavanje. Izgleda kao dodavanje sintakse zagrade na desno, u suštini šećer.

Kod

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

Teče kroz cevi...

Iste operacije se mogu obaviti preko cijevi, izgleda slično, ali je funkcionalno bogatije, jer možete koristiti bilo koje metode, ne samo DT. Hajde da izvedemo koeficijente logističke regresije za naše sintetičke podatke sa brojnim filterima na DT.

Kod

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

Statistika, mašinsko učenje i još mnogo toga unutar DT-a

Možete koristiti lambda funkcije, ali ponekad je bolje da ih kreirate odvojeno, napišete cijeli cjevovod analize podataka i samo naprijed - one rade unutar DT-a. Primer je obogaćen svim gore navedenim karakteristikama, plus nekoliko korisnih stvari iz DT arsenala (kao što je pristup samom DT-u unutar DT-a preko veze, ponekad umetnute ne sekvencijalno, već tako da jeste).

Kod

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

zaključak

Nadam se da sam uspeo da napravim kompletnu, ali, naravno, ne i potpunu sliku takvog objekta kao što je data.table, počevši od njegovih svojstava povezanih sa nasleđivanjem od R klasa i završavajući sopstvenim karakteristikama i okruženjem od elemenata tidyverse . Nadam se da će vam ovo pomoći da bolje naučite i koristite ovu biblioteku za rad i zabava.

Hvala vam!

Pun kod

Kod

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

izvor: www.habr.com