Denne note vil være af interesse for dem, der bruger det tabelformede databehandlingsbibliotek til R - data.table, og kan være glade for at se fleksibiliteten i brugen af det i forskellige eksempler.
Inspireret af et godt eksempel , og jeg håber, at du allerede har læst hans artikel, foreslår jeg at grave dybere mod kodeoptimering og ydeevne baseret på data.tabel.
Introduktion: Hvor kommer data.table fra?
Det er bedst at begynde at stifte bekendtskab med biblioteket lidt på afstand, nemlig de datastrukturer, hvorfra data.table-objektet (herefter benævnt DT) kan hentes.
matrix
Kode
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
En sådan struktur er en matrix (?base::array). Som på andre sprog er arrays her multidimensionelle. Det interessante er dog, at for eksempel en todimensional matrix begynder at arve egenskaber fra matrixklassen (?base::matrix), og et endimensionelt array, som også er vigtigt, arver ikke fra en vektor (?base::vektor).
Det skal forstås, at typen af data indeholdt i ethvert objekt skal kontrolleres ved hjælp af funktionen base::typeaf, som returnerer den interne typebeskrivelse iflg R Internaler - den generelle protokol for det sprog, der er knyttet til originalen C.
En anden kommando til at bestemme klassen af et objekt er base::klasse, i tilfælde af vektorer, returnerer vektortypen (den adskiller sig i navn fra den interne, men giver dig også mulighed for at forstå datatypen).
liste
Fra et todimensionelt array, også kendt som en matrix, kan du gå til listen (?base::liste).
Kode
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Der sker flere ting på én gang:
- Den anden dimension af matricen kollapser, det vil sige, at vi får både en liste og en vektor på samme tid.
- Listen arver således fra disse klasser. Det skal huskes, at et listeelement vil svare til én (skalær) værdi fra en celle i matrixmatricen.
Fordi en liste også er en vektor, kan nogle vektorfunktioner anvendes på den.
Dataramme
Du kan gå fra en liste, matrix eller vektor til en dataramme (?base::data.frame).
Kode
## data.frames ------------
df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)
is.list(df)
df$V6 <- df$V1 + df$V2
Hvad er interessant ved det: datarammen arver fra listen! Datarammekolonner er listeceller. Dette vil være vigtigt senere, når vi bruger funktioner anvendt på lister.
data.tabel
Få DT (?data.table::data.table) kan være fra dataramme, liste, vektor eller matrix. For eksempel sådan (på plads).
Kode
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
Det er nyttigt, at en DT, ligesom en dataramme, arver egenskaberne for en liste.
DT og hukommelse
I modsætning til alle andre objekter i R-basen sendes DT'er ved reference. Hvis du skal lave en kopi til et nyt hukommelsesområde, skal du bruge en funktion data.table::copy eller du skal foretage et valg fra det gamle objekt.
Kode
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)
Dette afslutter indledningen. DT er en fortsættelse af udviklingen af datastrukturer i R, som hovedsageligt opstår på grund af udvidelsen og accelerationen af operationer udført på objekter i datarammeklassen. Samtidig bevares arv fra andre primitiver.
Nogle eksempler på brug af data.table-egenskaber
Som en liste...
At iterere over rækkerne i en dataramme eller DT er ikke en god idé, da loop-koden i sproget R meget langsommere C, men det er ganske muligt at sløjfe gennem søjlerne, som normalt er meget mindre. Når du går gennem kolonnerne, skal du huske, at hver kolonne er et element i en liste, som normalt indeholder en vektor. Og operationer på vektorer er godt vektoriseret i sprogets grundlæggende funktioner. Du kan også bruge markeringsoperatorer, der er fælles for lister og vektorer: `[[`, `$`.
Kode
## 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)))
Vektorisering
Hvis der er behov for at gå gennem linjerne i en stor DT, ville den bedste løsning være at skrive en funktion med vektorisering. Men hvis dette ikke virker, så skal du huske, at cyklussen inden DT er stadig hurtigere end cyklussen R, da det udføres på C.
Lad os prøve det på et større eksempel med 100K rækker. Vi vil udtrække det første bogstav fra ordene inkluderet i vektorkolonnen w.
Opdateret
Kode
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))
]
})
Kør først iteration over rækker:
Enhed: millisekunder
udtr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq middel median uq max neval
+451.9998 460.1593 456.2505 460.9147 621.4042 100
Den anden kørsel, hvor vektorisering sker ved at gøre listen til en matrix og tage elementer på skiven med indeks 1 (sidstnævnte er selve vektoriseringen). Korrektion: vektorisering på funktionsniveau strsplit, som kan acceptere en vektor som input. Det viser sig, at proceduren til at omdanne en liste til en matrix er meget vanskeligere end selve vektoriseringen, men i dette tilfælde er den meget hurtigere end den ikke-vektoriserede version.
Enhed: millisekunder
udtr min lq middel median uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 +185.9893 442.5199 100
Acceleration med median in 3 gange.
Tredje kørsel, hvor transformationsskemaet til matrixen blev ændret.
Enhed: millisekunder
udtr min lq middel median uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 +42.11975 222.972 100
Acceleration med median in 13 gange.
Du skal eksperimentere med denne sag, jo mere, jo bedre bliver det.
Et andet eksempel med vektorisering, hvor der også er tekst, men det er tæt på virkelige forhold: forskellige længder af ord, forskelligt antal ord. Du skal have de første 3 ord. Sådan:
Her virker den forrige funktion ikke, da vektorerne er af forskellig længde, og vi indstiller matrixstørrelsen. Lad os lave dette om ved at grave rundt på internettet.
Kode
# 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))
]
Enhed: millisekunder
udtr min lq middel 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
Scriptet kørte med en gennemsnitshastighed på 1 sekund. Ikke dårligt.
Forbundet af en kæde...
Du kan arbejde med DT-objekter ved hjælp af chaining. Det ligner at vedhæfte beslagsyntaks til højre, i det væsentlige sukker.
Kode
# 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)]
Flyder gennem rørene...
De samme operationer kan udføres via rør, det ligner, men er funktionelt rigere, da du kan bruge alle metoder, ikke kun DT. Lad os udlede logistiske regressionskoefficienter for vores syntetiske data med et antal filtre på DT.
Kode
# 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, maskinlæring og mere inde i DT
Du kan bruge lambda-funktioner, men nogle gange er det bedre at oprette dem separat, skrive hele dataanalysepipelinen og gå videre - de fungerer inde i DT. Eksemplet er beriget med alle ovenstående funktioner plus flere nyttige ting fra DT-arsenalet (såsom adgang til selve DT inde i DT via et link, nogle gange indsat ikke sekventielt, men sådan at det er det).
Kode
# 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)
Konklusion
Jeg håber, at jeg var i stand til at skabe et komplet, men selvfølgelig ikke fuldstændigt, billede af et sådant objekt som data.table, startende fra dets egenskaber forbundet med arv fra R-klasser og slutter med dets egne funktioner og miljø fra tidyverse elementer . Jeg håber, at dette vil hjælpe dig til bedre at lære og bruge dette bibliotek til arbejde og underholdning.
Tak!
Fuld kode
Kode
## 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)
Kilde: www.habr.com
