Táto poznámka bude zaujímavá pre tých, ktorí používajú tabuľkovú knižnicu na spracovanie údajov pre R - data.table a možno ich poteší flexibilita jej použitia na rôznych príkladoch.
Inšpirované dobrým príkladom a dúfam, že ste si už jeho článok prečítali, navrhujem ísť hlbšie k optimalizácii kódu a výkonu na základe údajová tabuľka.
Úvod: Odkiaľ pochádza data.table?
Najlepšie je začať sa s knižnicou oboznamovať trochu z diaľky, a to s dátovými štruktúrami, z ktorých možno získať objekt data.table (ďalej len DT).
rad
kód
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Jednou z takýchto štruktúr je pole (?base::array). Rovnako ako v iných jazykoch, aj tu sú polia viacrozmerné. Zaujímavosťou však je, že napríklad dvojrozmerné pole začína dediť vlastnosti z triedy matrix (?základ::matrix) a jednorozmerné pole, ktoré je tiež dôležité, nededí z vektora (?základ::vektor).
Malo by byť zrejmé, že typ údajov obsiahnutých v akomkoľvek objekte by sa mal skontrolovať pomocou funkcie základ::typ, ktorý vráti interný popis typu podľa R Vnútorné časti - všeobecný protokol jazyka spojeného s originálom C.
Ďalším príkazom na určenie triedy objektu je základ::trieda, v prípade vektorov vracia typ vektor (od interného sa líši názvom, no zároveň umožňuje pochopiť dátový typ).
Zoznam
Z dvojrozmerného poľa, známeho aj ako matica, môžete prejsť na zoznam (?základ::zoznam).
kód
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Deje sa niekoľko vecí naraz:
- Druhý rozmer matice sa zrúti, to znamená, že dostaneme zoznam aj vektor súčasne.
- Zoznam teda dedí z týchto tried. Treba mať na pamäti, že prvok zoznamu bude zodpovedať jednej (skalárnej) hodnote z bunky matice poľa.
Pretože zoznam je tiež vektor, možno naň použiť niektoré vektorové funkcie.
Dataframe
Môžete prejsť zo zoznamu, matice alebo vektora do dátového rámca (?base::data.frame).
kód
## data.frames ------------
df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)
is.list(df)
df$V6 <- df$V1 + df$V2
Čo je na ňom zaujímavé: dátový rámec dedí zo zoznamu! Stĺpce dátového rámca sú bunky zoznamu. To bude dôležité neskôr, keď použijeme funkcie aplikované na zoznamy.
údajová tabuľka
Získajte DT (?data.table::data.table) môže byť z dátový rámec, zoznam, vektor alebo matica. Napríklad takto (na mieste).
kód
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
Je užitočné, že podobne ako dátový rámec, aj DT zdedí vlastnosti zoznamu.
DT a pamäť
Na rozdiel od všetkých ostatných objektov v základni R sa DT odovzdávajú odkazom. Ak potrebujete vytvoriť kópiu do novej oblasti pamäte, potrebujete funkciu data.table::kopírovať alebo musíte urobiť výber zo starého objektu.
kód
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)
Týmto končím úvod. DT je pokračovaním vývoja dátových štruktúr v R, ku ktorému dochádza najmä v dôsledku rozšírenia a zrýchlenia operácií vykonávaných na objektoch triedy dataframe. Zároveň sa zachováva dedičnosť od iných primitívov.
Niekoľko príkladov použitia vlastností data.table
Ako zoznam...
Iterovanie cez riadky dátového rámca alebo DT nie je dobrý nápad, pretože kód slučky v jazyku R oveľa pomalšie C, ale je celkom možné prechádzať cez stĺpce, ktoré sú zvyčajne oveľa menšie. Pri prechádzaní stĺpcami nezabudnite, že každý stĺpec je prvkom zoznamu, ktorý zvyčajne obsahuje vektor. A operácie s vektormi sú dobre vektorizované v základných funkciách jazyka. Môžete tiež použiť operátory výberu spoločné pre zoznamy a vektory: `[[`, `$`.
kód
## 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)))
Vektorizácia
Ak je potrebné prejsť riadkami veľkého DT, najlepším riešením by bolo napísať funkciu s vektorizáciou. Ale ak to nefunguje, mali by ste si uvedomiť, že cyklus vnútri DT je stále rýchlejší ako cyklus R, keďže sa vykonáva na C.
Skúsme to na väčšom príklade so 100 XNUMX riadkami. Vyberieme prvé písmeno zo slov zahrnutých v stĺpci vektor w.
Aktualizované
kód
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))
]
})
Prvé spustenie iterácie cez riadky:
Jednotka: milisekundy
expr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", pevné = T))[1]), by = 1:nrow(dt)] } 439.6217
lq stredný medián uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100
Druhý chod, kde vektorizácia nastáva premenou zoznamu na maticu a prevzatím prvkov na reze s indexom 1 (druhý je samotná vektorizácia). Oprava: vektorizácia na úrovni funkcií strsplit, ktorý môže prijať vektor ako vstup. Ukazuje sa, že postup premeny zoznamu na maticu je oveľa ťažší ako samotná vektorizácia, ale v tomto prípade je oveľa rýchlejší ako nevektorizovaná verzia.
Jednotka: milisekundy
expr min lq stredný medián uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100
Zrýchlenie podľa mediánu v Počet hodín 3.
Tretí chod, kde sa zmenila schéma transformácie do matice.
Jednotka: milisekundy
expr min lq stredný medián uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100
Zrýchlenie podľa mediánu v Počet hodín 13.
S touto záležitosťou musíte experimentovať, čím viac, tým lepšie to bude.
Ďalší príklad s vektorizáciou, kde je aj text, ale je blízky reálnym podmienkam: rôzne dĺžky slov, iný počet slov. Musíte získať prvé 3 slová. Páči sa ti to:
Tu predchádzajúca funkcia nefunguje, pretože vektory majú rôznu dĺžku a nastavujeme veľkosť matice. Zopakujme to prehrabaním sa na internete.
kód
# 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))
]
Jednotka: milisekundy
expr min lq stredný medián
{ dt[, `:=`((prilepiť0(“w_”, 1:3)), strsplit(w, rozdeliť = " ", pevné = T))] } 851.7623 916.071 1054.5 1035.199
uq max neval
1178.738 1356.816 100
Skript bežal priemernou rýchlosťou 1 sekundu. Nie zlé.
Prepojené jednou reťazou...
S objektmi DT môžete pracovať pomocou reťazenia. Vyzerá to ako pripojenie syntaxe zátvoriek doprava, v podstate cukor.
kód
# 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)]
Preteká cez potrubie...
Rovnaké operácie sa dajú robiť cez potrubie, vyzerá to podobne, ale je funkčne bohatšie, keďže môžete použiť akékoľvek metódy, nielen DT. Odvoďme logistické regresné koeficienty pre naše syntetické dáta s množstvom filtrov na DT.
kód
# 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]]
Štatistiky, strojové učenie a ďalšie v DT
Môžete použiť funkcie lambda, ale niekedy je lepšie ich vytvoriť samostatne, napísať celý kanál analýzy údajov a pokračovať - fungujú vo vnútri DT. Príklad je obohatený o všetky vyššie uvedené funkcie plus niekoľko užitočných vecí z arzenálu DT (napríklad prístup k samotnému DT vo vnútri DT cez odkaz, niekedy vložený nie postupne, ale tak, aby bol).
kód
# 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)
Záver
Dúfam, že sa mi podarilo vytvoriť úplný, ale, samozrejme, nie úplný obraz takéhoto objektu, akým je data.table, počnúc jeho vlastnosťami spojenými s dedením z tried R a končiac jeho vlastnými vlastnosťami a prostredím z prvkov tidyverse . Dúfam, že vám to pomôže lepšie sa učiť a používať túto knižnicu na prácu a zábava.
Ďakujeme!
Úplný kód
kód
## 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)
Zdroj: hab.com
