Ky postim do të jetë me interes për ata që përdorin bibliotekën e përpunimit të të dhënave të tabelës R data.table dhe mund të jenë të kënaqur të shohin fleksibilitetin e zbatimit të saj në shembuj të ndryshëm.
I frymëzuar nga një shembull i mirë , dhe duke shpresuar që e keni lexuar tashmë artikullin e tij, sugjeroj të gërmoni më thellë në optimizimin e kodit dhe performancën bazuar në të dhëna.tabela.
Hyrje: Nga vjen data.table?
Është më mirë të fillosh të njihesh me bibliotekën nga pak më larg, domethënë, me strukturat e të dhënave nga të cilat mund të merret objekti data.table (në tekstin e mëtejmë, DT).
Array
Kod
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Një nga strukturat e tilla është një varg (?base::array). Ashtu si në gjuhë të tjera, vargjet këtu janë shumëdimensionale. Megjithatë, ajo që është interesante është se, për shembull, një varg dy-dimensional fillon të trashëgojë vetitë nga klasa e matricës. (?base::matrix), dhe një varg njëdimensional, i cili është gjithashtu i rëndësishëm, nuk trashëgon nga një vektor (?base::vector).
Është e rëndësishme të kuptohet se lloji i të dhënave të përmbajtura në çdo objekt duhet të kontrollohet nga funksioni bazë::lloj, i cili kthen përshkrimin e brendshëm të tipit sipas R Internals — një protokoll gjuhe të përbashkët i lidhur me origjinalin C.
Një tjetër komandë për të përcaktuar klasën e një objekti, bazë::klasë, në rastin e vektorëve, kthen llojin e vektorit (ka një emër të ndryshëm nga ai i brendshëm, por gjithashtu ju lejon të kuptoni llojin e të dhënave).
Listë
Nga një varg dy-dimensional, i njohur edhe si matricë, mund të shkoni në një listë (?base::list).
Kod
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Disa gjëra ndodhin në të njëjtën kohë:
- Dimensioni i dytë i matricës shembet, domethënë marrim njëkohësisht një listë dhe një vektor.
- Kështu, një listë trashëgon nga këto klasa. Mbani mend se çdo element i listës do të korrespondojë me një vlerë të vetme (skalare) nga një qelizë e vargut matricor.
Meqenëse një listë është gjithashtu një vektor, disa funksione vektoriale mund të aplikohen në të.
Korniza e të dhënave
Nga një listë, matricë ose vektor mund të shkoni në një kornizë të dhënash (?base::data.frame).
Kod
## data.frames ------------
df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)
is.list(df)
df$V6 <- df$V1 + df$V2
Ajo që është interesante në lidhje me të është se dataframe trashëgon nga një listë! Kolonat e dataframe janë qelizat e listës. Kjo do të jetë e rëndësishme më vonë kur të përdorim funksione që zbatohen për listat.
të dhëna.tabela
Merr DT (?data.table::data.table) mund të jetë nga kornizë të dhënash, listë, vektor ose matricë. Për shembull, si kjo (në vend).
Kod
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
Ajo që është e dobishme është se, ashtu si një kornizë të dhënash, një DT trashëgon vetitë e një liste.
DT dhe kujtesa
Ndryshe nga të gjitha objektet e tjera në bazën R, DT-të kalohen me referencë. Nëse duhet t'i kopjoni ato në një vendndodhje të re memorieje, ju nevojitet një funksion. data.table::copy ose duhet të bësh një përzgjedhje nga objekti i vjetër.
Kod
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)
Këtu përmbyllet hyrja. DT është një vazhdim i zhvillimit të strukturave të të dhënave në R, kryesisht përmes zgjerimit dhe përshpejtimit të operacioneve të kryera në objektet e dataframe. Duke ruajtur trashëgiminë nga primitivët e tjerë.
Disa shembuj të përdorimit të vetive data.table
Si një listë…
Iterimi mbi rreshtat e një dataframe ose DT nuk është ideja më e mirë, pasi kodi i lakut është në gjuhën R shumë më ngadalë C, por kalimi nëpër kolona, të cilat zakonisht janë shumë më të pakta, është plotësisht i mundur. Kur kaloni nëpër kolona, mbani mend se çdo kolonë është një element liste, që zakonisht përmban një vektor. Dhe operacionet mbi vektorët janë të vektorizuara mirë në funksionet themelore të gjuhës. Gjithashtu mund të përdorni operatorët e përzgjedhjes të natyrshëm në lista dhe vektorë: `[[`, `$`.
Kod
## 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)))
Vektorizimi
Nëse duhet të përsërisni rreshtat e një DT të madh, zgjidhja më e mirë është të shkruani një funksion të vektorizuar. Por nëse kjo nuk funksionon, mbani mend se cikli brenda DT është akoma më i shpejtë se cikli në R, meqenëse kryhet në C.
Le ta provojmë në një shembull më të madh me 100 mijë rreshta. Do të nxjerrim shkronjën e parë nga fjalët e përfshira në vektorin e kolonës. w.
Përditësuar
Kod
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))
]
})
Ekzekutimi i parë me përsëritje mbi rreshta:
Njësia: milisekonda
shprehje min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = "", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
mediana mesatare lq uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100
Ekzekutimi i dytë, ku vektorizimi ndodh duke e shndërruar listën në një matricë dhe duke marrë elementët e prerjes me indeks 1 (ky i fundit është vektorizimi aktual). Korrigjimi: vektorizimi në nivelin e funksionit. strsplit, e cila mund të pranojë një vektor si të dhënë hyrëse. Rezulton se procedura për konvertimin e një liste në një matricë është shumë më komplekse sesa vetë vektorizimi, por edhe në këtë rast, është shumë më e shpejtë sesa versioni jo-vektorizuar.
Njësia: milisekonda
expr min lq mesatarja mesatare uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100
Përshpejtimi sipas medianës në Herë 3.
Vrapimi i tretë, ku skema e konvertimit të matricës u ndryshua.
Njësia: milisekonda
expr min lq mesatarja mesatare uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100
Përshpejtimi sipas medianës në Herë 13.
Ju duhet të eksperimentoni me këtë çështje, sa më shumë aq më mirë.
Ja një shembull tjetër vektorizimi, gjithashtu me tekst, por më afër kushteve të botës reale: gjatësi të ndryshme fjalësh dhe numërim i ndryshëm fjalësh. Qëllimi është të nxirren tre fjalët e para. Si kjo:
Funksioni i mëparshëm nuk funksionon këtu sepse vektorët kanë gjatësi të ndryshme dhe ne specifikuam madhësinë e matricës. Le ta ripërpunojmë këtë duke kërkuar në internet.
Kod
# 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))
]
Njësia: milisekonda
shpreh min lq mesatare mediane
{ dt[, `:=`((paste0("w_", 1:3)), strsplit(w, ndarë = "", fiksuar = T))] } 851.7623 916.071 1054.5 1035.199
UQ max neval
1178.738 1356.816 100
Skripti u zhvillua me një shpejtësi mesatare prej 1 sekonde. Jo keq.
Të lidhur nga një zinxhir…
Mund të punosh me objekte DT duke përdorur zinxhirin. Kjo duket si zinxhiri i sintaksës së kllapave në të djathtë, në thelb një shtresë sheqeri.
Kod
# 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)]
Po rrjedh nëpër tuba...
Të njëjtat operacione mund të kryhen duke përdorur tubacione; duket e ngjashme, por është më e pasur nga ana funksionale, pasi mund të përdoret çdo metodë, jo vetëm DT. Le të nxjerrim koeficientët e regresionit logjistik për të dhënat tona sintetike me një numër filtrash DT.
Kod
# 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]]
Statistikat, të mësuarit automatik dhe më shumë brenda DT
Funksionet Lambda mund të përdoren, por ndonjëherë është më mirë t'i krijoni veçmas, të shkruani të gjithë procesin e analizës së të dhënave dhe të filloni - ato funksionojnë brenda DT-së. Shembulli është i pasuruar me të gjitha veçoritë e përmendura më sipër, plus disa gjëra të dobishme nga arsenali i DT-së (siç është qasja në vetë DT-në brenda DT-së nëpërmjet një lidhjeje, ndonjëherë e futur jashtë sekuencës, por vetëm për t'u siguruar).
Kod
# 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)
Përfundim
Shpresoj se kam arritur të krijoj një pamje gjithëpërfshirëse, megjithëse sigurisht jo të plotë, të objektit data.table, nga vetitë e tij që lidhen me trashëgiminë nga klasat R deri te veçoritë e tij dhe mjedisi i elementëve të tidyverse. Shpresoj se kjo do t'ju ndihmojë ta kuptoni dhe aplikoni më mirë këtë bibliotekë në punën tuaj. argëtim.
Ju faleminderit!
Kodi i plotë
Kod
## 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)
Burimi: www.habr.com
