Ovaj će post biti zanimljiv onima koji koriste R biblioteku za obradu podataka data.table i mogli bi ih obradovati fleksibilnost njezine primjene u raznim primjerima.
Inspiriran dobrim primjerom i nadam se da ste već pročitali njegov članak, predlažem da dublje istražite optimizaciju koda i performanse na temelju podaci.tabela.
Uvod: Odakle dolazi data.table?
Najbolje je započeti upoznavanje s bibliotekom malo dalje, naime, sa strukturama podataka iz kojih se može dobiti objekt data.table (u daljnjem tekstu DT).
red
Šifra
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Jedna od takvih struktura je niz (?baza::niz). Kao i u drugim jezicima, nizovi su ovdje višedimenzionalni. Međutim, zanimljivo je da, na primjer, dvodimenzionalni niz počinje nasljeđivati svojstva iz klase matrice. (?baza::matrica), a jednodimenzionalni niz, što je također važno, ne nasljeđuje iz vektora (?baza::vektor).
Važno je razumjeti da funkcija treba provjeriti vrstu podataka sadržanih u bilo kojem objektu. baza::tip, koji vraća interni opis tipa prema R Interni dijelovi — protokol zajedničkog jezika povezan s originalom C.
Još jedna naredba za određivanje klase objekta, baza::klasa, u slučaju vektora, vraća tip vektora (ima drugačije ime od internog, ali vam također omogućuje razumijevanje tipa podataka).
popis
Iz dvodimenzionalnog niza, poznatog i kao matrica, možete prijeći na listu (?base::list).
Šifra
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Nekoliko stvari se događa odjednom:
- Druga dimenzija matrice se sažima, odnosno dobivamo i listu i vektor istovremeno.
- Lista stoga nasljeđuje ove klase. Imajte na umu da će svaki element liste odgovarati jednoj (skalarnoj) vrijednosti iz ćelije matričnog niza.
Budući da je lista ujedno i vektor, na nju se mogu primijeniti neke vektorske funkcije.
Okvir podataka
S popisa, matrice ili vektora možete prijeći na podatkovni okvir (?base::data.frame).
Šifra
## data.frames ------------
df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)
is.list(df)
df$V6 <- df$V1 + df$V2
Zanimljivo je da podatkovni okvir nasljeđuje popis! Stupci podatkovnog okvira su ćelije popisa. To će biti važno kasnije kada budemo koristili funkcije koje se primjenjuju na popise.
podaci.tabela
Nabavi DT (?podaci.tablica::podaci.tablica) može biti od okvir podataka, popis, vektor ili matrica. Na primjer, ovako (na mjestu).
Šifra
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
Korisno je to što, poput okvira podataka, DT nasljeđuje svojstva liste.
DT i memorija
Za razliku od svih ostalih objekata u R bazi, DT-ovi se prenose referencom. Ako ih trebate kopirati na novu lokaciju u memoriji, potrebna vam je funkcija podaci.tablica::kopija ili trebate napraviti selekciju iz starog objekta.
Šifra
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 završava uvod. DT je nastavak razvoja podatkovnih struktura u R-u, prvenstveno kroz proširenje i ubrzanje operacija koje se izvode na objektima podatkovnog okvira. Uz zadržavanje nasljeđivanja iz drugih primitiva.
Neki primjeri korištenja svojstava data.table
Kao popis…
Iteriranje kroz retke okvira podataka ili DT-a nije najbolja ideja, budući da je kod petlje u jeziku R mnogo sporije C, ali petlja kroz stupce, kojih je obično mnogo manje, sasvim je moguća. Prilikom petlje kroz stupce, imajte na umu da je svaki stupac element liste, koji obično sadrži vektor. A operacije na vektorima su dobro vektorizirane u osnovnim jezičnim funkcijama. Također možete koristiti operatore odabira svojstvene listama i vektorima: `[[`, `$`.
Šifra
## 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 trebate iterirati kroz veliki DT, najbolje rješenje je napisati vektoriziranu funkciju. Ali ako to ne uspije, zapamtite da petlja u DT je i dalje brži od ciklusa u R, budući da se izvodi na C.
Pokušajmo to na većem primjeru sa 100 tisuća redaka. Izdvojit ćemo prvo slovo iz riječi uključenih u vektor stupac. w.
Ažurirano
Šifra
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 pokretanje s iteracijom kroz redove:
Jedinica: milisekunde
izraz min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq srednja vrijednost medijana uq maksimalna neval
451.9998 460.1593 456.2505 460.9147 621.4042 100
Drugi prolaz, gdje se vektorizacija događa pretvaranjem liste u matricu i uzimanjem elemenata kriške s indeksom 1 (potonji je stvarna vektorizacija). Ispravak: vektorizacija na razini funkcije. strsplit, koji može prihvatiti vektor kao ulaz. Ispada da je postupak pretvaranja liste u matricu puno složeniji od same vektorizacije, ali čak i u ovom slučaju puno je brži od nevektorizirane verzije.
Jedinica: milisekunde
ekspr 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 medijanu u 3 puta.
Treći pokušaj, gdje je promijenjena shema pretvorbe matrice.
Jedinica: milisekunde
ekspr 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 medijanu u 13 puta.
Trebaš eksperimentirati s ovim, što više to bolje.
Evo još jednog primjera vektorizacije, također s tekstom, ali bližeg uvjetima iz stvarnog svijeta: različite duljine riječi i različiti brojevi riječi. Cilj je izdvojiti prve tri riječi. Ovako:
Prethodna funkcija ovdje ne radi jer su vektori različitih duljina, a mi smo odredili veličinu matrice. Preradimo ovo pretraživanjem interneta.
Šifra
# 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
izraz min lq srednja vrijednost medijan
{ dt[, `:=`((paste0(“w_”, 1:3)), strsplit(w, split = " ", fixed = T))] } 851.7623 916.071 1054.5 1035.199
UQ maksimalni neval
1178.738 1356.816 100
Skripta se izvršavala prosječnom brzinom od 1 sekunde. Nije loše.
Povezani jednim lancem…
Možete raditi s DT objektima pomoću ulančavanja. To izgleda kao ulančavanje sintakse zagrada s desne strane, u biti šećerni premaz.
Šifra
# 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)]
Curi kroz cijevi...
Iste operacije mogu se izvesti pomoću cjevovoda; izgleda slično, ali je funkcionalnije bogatije, jer se mogu koristiti bilo koje metode, ne samo DT. Izvedimo koeficijente logističke regresije za naše sintetičke podatke s nekoliko DT filtera.
Šifra
# 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, strojno učenje i još mnogo toga unutar DT-a
Lambda funkcije se mogu koristiti, ali ponekad je bolje kreirati ih zasebno, napisati cijeli proces analize podataka i to je to - rade unutar DT-a. Primjer je obogaćen svim gore spomenutim značajkama, plus nekoliko korisnih stvari iz DT arsenala (kao što je pristup samom DT-u unutar DT-a putem poveznice, ponekad umetnute izvan redoslijeda, ali samo da budemo sigurni).
Šifra
# 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 uspio stvoriti sveobuhvatnu, iako svakako ne potpunu, sliku objekta data.table, od njegovih svojstava povezanih s nasljeđivanjem iz R klasa do vlastitih značajki i okruženja tidyverse elemenata. Nadam se da će vam ovo pomoći da bolje razumijete i primijenite ovu biblioteku u svom radu. zabava.
Hvala vam!
Puni kod
Šifra
## 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
