Rund um data.table

Dieser Hinweis könnte für diejenigen von Interesse sein, die die Datenverarbeitungsbibliothek für R — data.table — nutzen, und möglicherweise freuen sich, die Flexibilität ihrer Anwendung anhand verschiedener Beispiele zu sehen.

Inspiriert von einem guten Beispiel Kollegen, und in der Hoffnung, dass Sie bereits seinen Artikel gelesen haben, schlage ich vor, tiefer in die Optimierung von Code und Leistung basierend auf data.table.

Einführung: Woher kommt data.table?

Am besten beginnt man die Bekanntschaft mit der Bibliothek etwas fernab, und zwar mit den Datenstrukturen, aus denen ein data.table-Objekt (im Folgenden DT) erstellt werden kann.

Array

Code

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

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

class(arrmatr)

typeof(arrmatr)

is.array(arrmatr)

is.matrix(arrmatr)

Eine dieser Strukturen ist das Array (?base::array). Wie in anderen Sprachen sind Arrays hier mehrdimensional. Interessant ist jedoch, dass beispielsweise ein zweidimensionales Array Eigenschaften von der Matrixklasse erben beginnt (?base::matrix), während ein eindimensionales Array, was ebenfalls wichtig ist, nicht von einem Vektor erbt (?base::vector).

Dabei muss man verstehen, dass der Datentyp, der in einem Objekt enthalten ist, mit der Funktion base::typeofüberprüft werden sollte, die eine interne Beschreibung des Typs gemäß R Internals — einem allgemeinen Protokoll der Sprache, das mit den urprünglichen C.

Ein weiterer Befehl zur Bestimmung der Klasse eines Objektes, base::class, gibt bei Vektoren den Vektor-Typ zurück (er unterscheidet sich in der Bezeichnung von dem internen, ermöglicht aber auch das Verständnis des Datentyps).

Liste

Von einem zweidimensionalen Array, das auch eine Matrix ist, kann zu einer Liste übergegangen werden (?base::list).

Code

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

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

Dabei passieren mehrere Dinge gleichzeitig:

• Das zweite Dimension der Matrix wird zusammengefasst, sodass wir gleichzeitig eine Liste und einen Vektor erhalten.
• Die Liste leitet somit von diesen Klassen ab. Man muss beachten, dass jedem Listenelement ein (skalares) Wert aus der Zelle der Matrix entspricht.

Da die Liste auch ein Vektor ist, können einige Funktionen für Vektoren angewendet werden.

DataFrame

Von einer Liste, Matrix oder einem Vektor kann zu einem DataFrame übergegangen werden (?base::data.frame).

Code

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

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

is.list(df)

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

Was daran interessant ist: Der DataFrame leitet von der Liste ab! Die Spalten des DataFrames sind Zellen der Liste. Das wird wichtig sein, wenn wir später Funktionen verwenden, die auf Listen angewendet werden.

data.table

DT (?data.table::data.table) kann aus einem DataFrame, einer Liste, einem Vektor oder einer Matrix abgeleitet werden. Zum Beispiel so (in place).

Code

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

data.table::setDT(df)

is.list(df)

is.data.frame(df)

is.data.table(df)

Nützlich ist, dass DT, wie der DataFrame, die Eigenschaften der Liste erbt.

DT und Speicher

Im Gegensatz zu allen anderen Objekten in R werden Daten-Tabellen per Referenz übergeben. Wenn Sie eine Kopie im neuen Speicherbereich erstellen möchten, benötigen Sie eine Funktion data.table::copy oder Sie müssen eine Auswahl aus dem alten Objekt treffen.

Code

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)

Damit endet die Einführung. Daten-Tabellen sind eine Weiterentwicklung der Datenstrukturen in R, die hauptsächlich durch die Erweiterung und Beschleunigung der Operationen, die auf Objekten der Klasse Dataframe durchgeführt werden, vorangetrieben wird. Dabei bleibt das Erbe von anderen primitiven Datenstrukturen erhalten.

Einige Beispiele zur Nutzung der Eigenschaften von Daten-Tabellen

Wie eine Liste…

Das Iterieren über die Zeilen eines Dataframes oder einer Daten-Tabelle ist keine optimale Idee, da die Schleifenimplementierung in der Sprache R deutlich langsamer ist C, während das Durchlaufen von Spalten, die in der Regel deutlich weniger sind, durchaus machbar ist. Wenn Sie über die Spalten iterieren, denken Sie daran, dass jede Spalte ein Listenelement ist, das in der Regel einen Vektor enthält. Und Operationen über Vektoren sind gut vektorisiert in den Basisfunktionen der Sprache. Außerdem können die für Listen und Vektoren typischen Auswahloperatoren verwendet werden: `[[`, `$`.

Code

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

Vektorisierung

Wenn Sie große Datenzeilen durchlaufen müssen, ist das Schreiben einer Funktion mit Vektorisierung die beste Lösung. Wenn das jedoch nicht möglich ist, sollten Sie daran denken, dass eine Schleife innerhalb in Datenframes immer schneller ist als eine Schleife in R, da sie auf C.

Wir werden es an einem größeren Beispiel mit 100K Zeilen versuchen. Wir werden den ersten Buchstaben aus den Wörtern in der Vektor-Spalte extrahieren w.

Aktualisiert

Code

library(magrittr)
library(microbenchmark)

## Größeres Beispiel ----

rown <- 100000

dt %
	.[, d := 1 + b + c + rnorm(nrow(.))]

# Vektorisierung

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

# Zweite

first_l_f %
		do.call(rbind, .) %>%
		`[`(,1)
}

dt[, first_l := NULL]

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

# Dritte

first_l_f2 %
		unlist %>%
		matrix(nrow = 3) %>%
		`[`(1,)
}

dt[, first_l := NULL]

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

Erster Lauf mit Iteration über die Zeilen:

Einheit: Millisekunden
expr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = ' ', fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq mean median uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100

Der zweite Durchlauf, bei dem die Vektorisierung durch die Umwandlung einer Liste in eine Matrix erfolgt und Elemente mit dem Index 1 ausgewählt werden (letztendlich ist das die eigentliche Vektorisierung). Ich korrigiere mich: die Vektorisierung auf Funktionsebene. strsplit, das einen Vektor als Eingabe akzeptieren kann. Es stellt sich heraus, dass die Umwandlung einer Liste in eine Matrix viel komplexer ist als die eigentliche Vektorisierung, aber selbst in diesem Fall ist sie deutlich schneller als die nicht vektorisierte Variante.

Einheit: Millisekunden
expr min lq mean median uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93,07916 112,1381 161,9267 149.6863 185.9893 442.5199 100

Die Beschleunigung gegenüber dem Median beträgt 3 mal.

Der dritte Durchlauf, bei dem das Schema zur Umwandlung in eine Matrix geändert wurde.

Einheit: Millisekunden
expr min lq mean median uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32,60481 34,13679 40,4544 35.57115 42.11975 222.972 100

Die Beschleunigung gegenüber dem Median beträgt 13 mal.

Hiermit muss experimentiert werden, je mehr, desto besser wird es.

Ein weiteres Beispiel zur Vektorisierung, das ebenfalls Text enthält, jedoch näher an realen Bedingungen ist: unterschiedliche Wortlängen, unterschiedliche Wortanzahlen. Es müssen die ersten 3 Wörter extrahiert werden. So geht's:

Hier funktioniert die vorherige Funktion nicht mehr, da die Vektoren unterschiedliche Längen haben, und wir hatten die Größe der Matrix festgelegt. Lassen Sie uns das überarbeiten und im Internet nach Lösungen suchen.

Code

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

Einheit: Millisekunden
expr min lq mean median

{ dt[, `:=`((paste0(«w_», 1:3)), strsplit(w, split = " ", fixed = T))] } 851,7623 916,071 1054,5 1035.199
uq max neval
1178.738 1356.816 100

Das Skript arbeitete mit einer durchschnittlichen Geschwindigkeit von 1 Sekunde. Nicht schlecht.

Durch eine Kette verbunden…

Mit den DT-Objekten kann man arbeiten, indem man Chaining verwendet. Es sieht aus wie das Anhängen von Klammer-Syntax auf der rechten Seite, im Grunde genommen eine nette Vereinfachung.

Code

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

Fließt durch die Rohre…

Ähnliche Operationen können auch über Piping ausgeführt werden; es sieht ähnlich aus, ist aber funktional reichhaltiger, da man beliebige Methoden und nicht nur DT verwenden kann. Lassen Sie uns die Koeffizienten der logistischen Regression für unsere synthetischen Daten mit einer Reihe von Filtern auf DT berechnen.

Code

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

Statistik, maschinelles Lernen und weiteres innerhalb von DT

Man kann Lambda-Funktionen verwenden, aber manchmal ist es besser, sie separat zu erstellen, die gesamte Datenanalyse-Pipeline zu definieren und dann — sie funktionieren innerhalb von DT. Das Beispiel ist mit all den oben genannten Funktionen angereichert, plus ein paar nützliche Dinge aus dem DT-Arsenal (wie die Referenzierung des DT selbst innerhalb des DT über Links, die manchmal nicht sequenziell eingefügt sind, aber es trotzdem ermöglichen).

Code

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

Fazit

Ich hoffe, ich konnte ein umfassendes, aber natürlich nicht vollständiges Bild eines Objekts wie data.table zeichnen, beginnend mit seinen Eigenschaften, die mit der Vererbung von R-Klassen verbunden sind, und endend mit seinen eigenen Funktionen und dem Umfeld der tidyverse-Elemente. Ich hoffe, das hilft Ihnen, diese Bibliothek besser zu verstehen und anzuwenden. Unterhaltung.

Danke!

Vollständiger Code

Code

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

Quelle: habr.com