Diese Notiz wird für diejenigen von Interesse sein, die die Datenverarbeitungsbibliothek für R – data.table – verwenden und vielleicht erfreut sein werden, die Flexibilität ihrer Anwendung anhand verschiedener Beispiele zu sehen.
Inspiriert von einem guten Beispiel , und in der Hoffnung, dass Sie bereits seinen Artikel gelesen haben, schlage ich vor, tiefer in die Optimierung des Codes und die Leistung basierend auf data.table.
Einführung: Woher kommt data.table?
Am besten beginnt man die Bekanntschaft mit der Bibliothek ein wenig aus der Ferne, das heißt mit den Datenstrukturen, aus denen das Objekt data.table (im Folgenden DT) abgeleitet werden kann.
Array
Code
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Eine solcher Struktur ist das Array (?base::array). Wie in anderen Programmiersprachen sind Arrays hier mehrdimensional. Interessant ist jedoch, dass beispielsweise ein zweidimensionales Array die Eigenschaften der Matrixklasse erbt (?base::matrix), während ein eindimensionales Array, was ebenfalls wichtig ist, nicht von einem Vektor erbt (?base::vector).
Dabei ist zu beachten, dass der Datentyp, der in einem Objekt enthalten ist, mit der Funktion base::typeof, die eine interne Beschreibung des Typs gemäß R Internals – einem allgemeinen Protokoll der Sprache, das mit primären C.
Ein weiterer Befehl zur Bestimmung der Objektklasse, base::class, gibt im Falle von Vektoren den Vektortyp zurück (er unterscheidet sich im Namen von der internen Beschreibung, ermöglicht jedoch ebenfalls das Verständnis des Datentyps).
Eine Liste
Von einem zweidimensionalen Array, das auch eine Matrix ist, kann man zu einer Liste übergehen (?base::list).
Code
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Dabei passieren mehrere Dinge gleichzeitig:
- Die zweite Dimension der Matrix wird zusammengefasst, d.h. wir erhalten gleichzeitig sowohl eine Liste als auch einen Vektor.
- Die Liste erbt somit von diesen Klassen. Es ist zu beachten, dass ein Element der Liste einem (skalaren) Wert aus der Zelle der Matrix-Array entspricht.
Da die Liste auch ein Vektor ist, können einige Funktionen, die für Vektoren gelten, darauf angewendet werden.
Dataframe
Von einer Liste, einer Matrix oder einem Vektor kann man zu einem Dataframe (?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: ein Dataframe erbt von einer Liste! Die Spalten des Dataframes sind Zellen der Liste. Dies wird in Zukunft wichtig sein, wenn wir Funktionen verwenden, die auf Listen angewendet werden.
data.table
Ein DT (?data.table::data.table) kann aus Dataframe, Liste, Vektor oder Matrix erstellt 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, wie beim Dataframe, das DT die Eigenschaften einer Liste erbt.
DT und Speicher
Im Gegensatz zu allen anderen Objekten in R Base, werden D.T. per Referenz übergeben. Wenn eine Kopie im neuen Speicherbereich erstellt werden muss, wird eine Funktion benötigt. data.table::copy oder es muss eine Auswahl aus dem alten Objekt getroffen werden.
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. D.T. ist eine Weiterentwicklung von Datenstrukturen in R, die überwiegend durch die Erweiterung und Beschleunigung von Operationen an Objekten der Klasse Data Frame erfolgt. Dabei bleibt die Vererbung von anderen Primitiven erhalten.
Einige Beispiele für die Verwendung von Eigenschaften von data.table
Wie eine Liste…
Über die Zeilen eines Data Frames oder D.T. zu iterieren, ist keine gute Idee, da der Schleifencode in der Sprache R deutlich langsamer ist C, während das Iterieren über die Spalten, die normalerweise deutlich weniger sind, durchaus möglich ist. Wenn wir über die Spalten gehen, denken wir daran, dass jede Spalte ein Element einer Liste ist, das im Normalfall einen Vektor enthält. Und Operationen an Vektoren sind in den Basisfunktionen der Sprache gut vektorisiert. Außerdem können Auswahloperatoren verwendet werden, die für Listen und Vektoren typisch sind: `[[`, `$`.
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 es nötig ist, über die Zeilen eines großen D.T. zu gehen, ist die beste Lösung, eine Funktion mit Vektorisierung zu schreiben. Wenn das nicht möglich ist, sollte man sich daran erinnern, dass eine Schleife innerhalb D.T. immer schneller ist als die Schleife in R, da sie auf C.
ausgeführt wird. Lassen Sie uns ein größeres Beispiel mit 100K Zeilen ausprobieren. Wir werden den ersten Buchstaben aus den Wörtern in der Vektorspalte 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))
]
})
Der erste Durchlauf 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 Durchgang, bei dem die Vektorisierung durch die Umwandlung einer Liste in eine Matrix und das Entnehmen von Elementen mit dem Index 1 erfolgt (das letztlich die eigentliche Vektorisierung ist). Ich korrigiere mich: Die Umwandlung einer Liste in eine Matrix ist viel aufwendiger als die eigentliche Vektorisierung, aber auch in diesem Fall geht es deutlich schneller als die nicht-vectrisierte Variante. strsplit, die einen Vektor als Eingabe akzeptiert. Es stellt sich heraus, dass die Prozedur zur Umwandlung einer Liste in eine Matrix viel komplizierter ist als die Vektorisierung selbst, aber auch in diesem Fall ist es viel schneller als die nicht-vectrisierte 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
Beschleunigung im Median um 3 mal.
Der dritte Durchgang, 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
Beschleunigung im Median um 13 mal.
Damit muss man experimentieren, je mehr – desto besser wird es.
Ein weiteres Beispiel für Vektorisierung, das ebenfalls Text enthält, jedoch näher an den realen Bedingungen ist: unterschiedliche Wortlängen, unterschiedliche Wortanzahlen. Es müssen die ersten 3 Wörter herausgeholt werden. So:
Hier funktioniert die vorherige Funktion nicht mehr, da die Vektoren unterschiedlich lang sind, und wir die Größe der Matrix festgelegt haben. Lassen Sie uns das überarbeiten, indem wir im Internet stöbern.
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 lief mit einer durchschnittlichen Geschwindigkeit von 1 Sekunde. Nicht schlecht.
Verknüpft durch eine Kette...
Mit DT-Objekten kann man arbeiten, indem man Chaining verwendet. Es sieht so aus, als würde man die Syntax der Klammern rechts anfügen, letztendlich ist das ein Zuckerl.
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 über Piping durchgeführt werden, sieht ähnlich aus, ist aber funktional reicher, da man beliebige Methoden verwenden kann und nicht nur DT. Lassen Sie uns die Koeffizienten der logistischen Regression für unsere synthetischen Daten mit verschiedenen Filtern auf DT ausgeben.
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 mehr innerhalb von DT
Man kann Lambda-Funktionen verwenden, aber manchmal ist es besser, sie separat zu erstellen, die gesamte Pipeline der Datenanalyse zu beschreiben und vorwärts - sie arbeiten innerhalb von DT. Das Beispiel wurde mit all den oben genannten Funktionen angereichert, plus einigen nützlichen Dingen aus dem Arsenal von DT (wie den Zugriff auf DT innerhalb von DT über Referenz, die manchmal nicht sequentiell eingefügt wurde, aber um es so zu haben).
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, dass ich ein zusammenhängendes, aber natürlich nicht vollständiges Bild eines Objekts wie data.table schaffen konnte, beginnend mit seinen ererbten Eigenschaften von R-Klassen bis hin zu seinen eigenen Funktionen und dem Umfeld der tidyverse-Elemente. Ich hoffe, dass dies Ihnen hilft, diese Bibliothek besser zu verstehen und anzuwenden für 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
