Dizze notysje sil fan belang wêze foar dyjingen dy't de bibleteek foar tabelgegevensferwurking brûke foar R - data.table, en kin bliid wêze om de fleksibiliteit fan it gebrûk yn ferskate foarbylden te sjen.
Ynspirearre troch in goed foarbyld , en hoopje dat jo syn artikel al lêzen hawwe, stel ik foar om djipper te graven nei koade-optimalisaasje en prestaasjes basearre op data.table.
Ynlieding: Wêr komt data.table wei?
It is it bêste om in bytsje fan fierren yn 'e kunde te kommen mei de bibleteek, nammentlik mei de gegevensstruktueren dêr't it data.table-objekt (hjirnei oantsjutten as DT) út te krijen is.
Массив
koade
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Ien sa'n struktuer is in array (?base::array). Lykas yn oare talen binne arrays hjir meardiminsjonaal. It nijsgjirrige is lykwols dat bygelyks in twadiminsjonale array eigenskippen begjint te erven fan 'e matrixklasse (?base::matrix), en in iendiminsjonale array, dy't ek wichtich is, erft net fan in fektor (?base::vector).
It moat begrepen wurde dat it type gegevens yn elk objekt moat wurde kontrolearre mei de funksje basis :: typeof, dat jout de ynterne type beskriuwing neffens R Ynterne - it algemiene protokol fan 'e taal ferbûn mei it orizjineel C.
In oar kommando om de klasse fan in objekt te bepalen is basis :: klasse, yn it gefal fan vectoren, jout it vectortype werom (it ferskilt yn namme fan 'e ynterne, mar lit jo ek it gegevenstype begripe).
List fan
Fanút in twadiminsjonale array, ek wol in matrix neamd, kinne jo nei de list gean (?base::list).
koade
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Ferskate dingen barre tagelyk:
- De twadde diminsje fan 'e matrix falt yninoar, dat is, wy krije tagelyk in list en in fektor.
- De list erft dus fan dizze klassen. It moat wurde hâlden yn gedachten dat in list elemint sil oerienkomme mei ien (scalar) wearde út in sel fan de array matrix.
Om't in list ek in fektor is, kinne guon fektorfunksjes dêrop tapast wurde.
Dataframe
Jo kinne fan in list, matrix of fektor gean nei in dataframe (?base::data.frame).
koade
## data.frames ------------
df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)
is.list(df)
df$V6 <- df$V1 + df$V2
Wat der nijsgjirrich is: it dataframe erft út de list! Dataframe kolommen binne list sellen. Dit sil letter wichtich wêze as wy funksjes brûke dy't tapast wurde op listen.
data.table
Get DT (?data.table::data.table) kin wêze fan dataframe, list, vector of matrix. Bygelyks, lykas dit (yn plak).
koade
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
It is handich dat, lykas in dataframe, in DT de eigenskippen fan in list erft.
DT en ûnthâld
Oars as alle oare objekten yn R basis, wurde DTs trochjûn troch referinsje. As jo moatte meitsje in kopy nei in nij ûnthâld gebiet, Jo moatte in funksje data.table :: kopy of jo moatte in seleksje meitsje út it âlde objekt.
koade
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)
Dit konkludearret de ynlieding. DT is in fuortsetting fan 'e ûntwikkeling fan gegevensstruktueren yn R, dy't benammen bart troch de útwreiding en fersnelling fan operaasjes útfierd op objekten fan' e dataframe-klasse. Tagelyk bliuwt it erfskip fan oare primitiven bewarre.
Guon foarbylden fan it brûken fan data.table eigenskippen
Lykas in list ...
Iterearjen oer de rigen fan in dataframe of DT is gjin goed idee, om't de loopkoade yn 'e taal R folle stadiger C, mar it is hiel mooglik om te loop troch de kolommen, dy't meastal folle lytser. Troch de kolommen te gean, tink derom dat elke kolom in elemint is fan in list, meastentiids in fektor befettet. En operaasjes op vectoren binne goed vectorized yn 'e basisfunksjes fan' e taal. Jo kinne ek seleksjeoperators brûke dy't mienskiplik binne foar listen en vectoren: `[[`, `$`.
koade
## 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)))
Vectorization
As der ferlet is om troch de rigels fan in grutte DT te gean, soe de bêste oplossing wêze om in funksje te skriuwen mei vectorization. Mar as dit net wurket, dan moatte jo betinke dat de syklus binnen DT is noch flugger as de syklus R, sûnt it wurdt útfierd op C.
Litte wy it besykje op in grutter foarbyld mei 100K rigen. Wy sille de earste letter ekstrahearje fan 'e wurden opnommen yn' e fektorkolom w.
Updated
koade
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))
]
})
Earste run iterearjen oer rigen:
Ienheid: millisekonden
expr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq gemiddelde mediaan uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100
De twadde run, dêr't vectorization optreedt troch in kear de list yn in matriks en nimme eleminten op it plak mei yndeks 1 (it lêste is de vectorization sels). Korreksje: vectorization op it funksje nivo strsplit, dy't in fektor as ynfier akseptearje kin. It docht bliken dat de proseduere foar it omsette fan in list yn in matrix is folle dreger as vectorization sels, mar yn dit gefal is it folle flugger as de net-vectorized ferzje.
Ienheid: millisekonden
expr min lq gemiddelde mediaan uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100
Fersnelling troch mediaan yn 3 tiden.
De tredde run, wêrby't it transformaasjeskema yn 'e matrix waard feroare.
Ienheid: millisekonden
expr min lq gemiddelde mediaan uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100
Fersnelling troch mediaan yn 13 tiden.
Jo moatte eksperimintearje mei dizze saak, hoe mear, hoe better it sil wêze.
In oar foarbyld mei vectorization, dêr't der ek tekst, mar it is tichtby echte betingsten: ferskillende lingten fan wurden, ferskillende oantal wurden. Jo moatte de earste 3 wurden krije. Lykas dit:
Hjir wurket de foarige funksje net, om't de vectoren fan ferskillende lingten binne, en wy sette de matrixgrutte yn. Litte wy dit opnij meitsje troch te graven op it ynternet.
koade
# 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))
]
Ienheid: millisekonden
expr min lq gemiddelde mediaan
{ dt[, `:=`((paste0(“w_”, 1:3)), strsplit(w, split = " ", fêst = T))] } 851.7623 916.071 1054.5 1035.199
uq max neval
1178.738 1356.816 100
It skript rûn mei in gemiddelde snelheid fan 1 sekonde. Net min.
Ferbûn troch ien ketting ...
Jo kinne wurkje mei DT-objekten mei ketting. It liket as it heakjen fan beugelsyntaksis nei rjochts, yn wêzen sûker.
koade
# 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)]
Troch de pipen streamt...
Deselde operaasjes kinne dien wurde fia piping, it liket ferlykber, mar is funksjoneel riker, om't jo elke metoade kinne brûke, net allinich DT. Litte wy logistyske regressionkoeffizienten ôfliede foar ús syntetyske gegevens mei in oantal filters op DT.
koade
# 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]]
Statistiken, masine learen en mear binnen DT
Jo kinne lambda-funksjes brûke, mar soms is it better om se apart te meitsjen, de heule pipeline foar gegevensanalyse te skriuwen, en gean troch - se wurkje yn 'e DT. It foarbyld is ferrike mei alle boppesteande funksjes, plus ferskate nuttige dingen út it DT arsenal (lykas tagong ta de DT sels binnen de DT fia in keppeling, soms ynfoege net sequentially, mar sa dat it is).
koade
# 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)
konklúzje
Ik hoopje dat ik koe meitsje in folslein, mar, fansels, net folslein, byld fan sa'n objekt as data.table, útgeande fan syn eigenskippen ferbûn mei erfenis fan R-klassen en einiget mei syn eigen funksjes en omjouwing fan tidyverse eleminten . Ik hoopje dat dit jo sil helpe om dizze bibleteek better te learen en te brûken foar wurk en entertainment.
Tankewol!
Folsleine koade
koade
## 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)
Boarne: www.habr.com
