Questa nota sarà di interesse per coloro che utilizzano la libreria di elaborazione dati delle tabelle R data.table e potrebbero essere lieti di vedere la flessibilità della sua applicazione in vari esempi.
Ispirato da un buon esempio e sperando che tu abbia già letto il suo articolo, ti suggerisco di approfondire l'ottimizzazione del codice e le prestazioni basate su tabella dati.
Introduzione: da dove viene data.table?
È meglio iniziare a familiarizzare con la libreria da lontano, in particolare con le strutture dati da cui è possibile ottenere l'oggetto data.table (di seguito, DT).
schieramento
codice
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Una di queste strutture è un array (?base::array). Come in altri linguaggi, gli array qui sono multidimensionali. Tuttavia, ciò che è interessante è che, ad esempio, un array bidimensionale inizia a ereditare le proprietà dalla classe matrice. (?base::matrice), e un array unidimensionale, che è anche importante, non eredita da un vettore (?base::vettore).
È importante capire che il tipo di dati contenuti in qualsiasi oggetto deve essere controllato dalla funzione base::tipo di, che restituisce la descrizione interna del tipo secondo Interni R — un protocollo linguistico comune associato all'originale C.
Un altro comando per determinare la classe di un oggetto, base::class, restituisce il tipo vettore nel caso di vettori (ha un nome diverso da quello interno, ma permette comunque di comprendere il tipo di dati).
Elenco
Da un array bidimensionale, noto anche come matrice, è possibile passare a un elenco (?base::list).
codice
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Accadono diverse cose contemporaneamente:
- La seconda dimensione della matrice collassa, ovvero otteniamo contemporaneamente sia una lista che un vettore.
- L'elenco eredita quindi da queste classi. È importante tenere presente che l'elemento dell'elenco corrisponderà a un valore (scalare) della cella della matrice-array.
Poiché un elenco è anche un vettore, è possibile applicargli alcune funzioni vettoriali.
Dataframe
Da un elenco, matrice o vettore è possibile passare a un dataframe (?base::data.frame).
codice
## data.frames ------------
df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)
is.list(df)
df$V6 <- df$V1 + df$V2
La cosa interessante è che il dataframe eredita dalla lista! Le colonne del dataframe sono le celle della lista. Questo sarà importante più avanti, quando utilizzeremo funzioni che si applicano alle liste.
tabella dati
Ottieni DT (?data.table::data.table) può essere da dataframe, elenco, vettore o matrice. Ad esempio, in questo modo (sul posto).
codice
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
Ciò che è utile è che, come un dataframe, un DT eredita le proprietà di un elenco.
DT e memoria
A differenza di tutti gli altri oggetti in R base, i DT vengono passati per riferimento. Se è necessario copiare in una nuova area di memoria, è necessaria la funzione dati.tabella::copia oppure è necessario effettuare una selezione dal vecchio oggetto.
codice
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)
Con questo si conclude l'introduzione. DT è una continuazione dello sviluppo delle strutture dati in R, che avviene principalmente grazie all'espansione e all'accelerazione delle operazioni eseguite sugli oggetti della classe dataframe. Allo stesso tempo, viene preservata l'ereditarietà da altre primitive.
Alcuni esempi di utilizzo delle proprietà data.table
Come elenco…
L'iterazione sulle righe di un dataframe o DT non è una buona idea, poiché il codice del ciclo è nel linguaggio R molto più lento C, ed è possibile scorrere le colonne in un ciclo, che di solito sono molto più piccole. Quando si esaminano le colonne, è importante ricordare che ogni colonna è un elemento di una lista, che di solito contiene un vettore. Le operazioni sui vettori sono ben vettorializzate nelle funzioni di base del linguaggio. È anche possibile utilizzare gli operatori di selezione propri di liste e vettori: `[[`, `$`.
codice
## 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)))
Vettorizzazione
Se è necessario esaminare le linee di un DT di grandi dimensioni, la soluzione migliore sarebbe scrivere una funzione con vettorizzazione. Ma se questo non funziona, allora dovresti ricordare che il ciclo interno DT è ancora più veloce del ciclo R, poiché viene eseguito su C.
Proviamolo su un esempio più ampio con 100 righe. Estrarremo la prima lettera dalle parole incluse nella colonna del vettore. w.
aggiornato
codice
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))
]
})
Prima esecuzione con iterazione sulle righe:
Unità: millisecondi
espr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq media mediana uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100
La seconda esecuzione, in cui la vettorizzazione avviene convertendo la lista in una matrice e prendendo gli elementi sulla slice con indice 1 (quest'ultima è in realtà una vettorizzazione). Mi correggo: vettorizzazione a livello di funzione. strsplit, che può accettare un vettore come input. Si scopre che la procedura per convertire una lista in una matrice è molto più complessa della vettorizzazione stessa, ma anche in questo caso è molto più veloce della versione non vettorizzata.
Unità: millisecondi
expr min lq media mediana uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100
Accelerazione per mediana in 3 volte.
La terza esecuzione, in cui è stato modificato lo schema di conversione della matrice.
Unità: millisecondi
expr min lq media mediana uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100
Accelerazione per mediana in 13 volte.
Bisogna sperimentare su questo argomento, più si fa meglio è.
Un altro esempio di vettorizzazione, in cui è presente anche del testo, ma è molto vicino alle condizioni reali: diverse lunghezze delle parole, diverso numero di parole. È necessario ottenere le prime 3 parole. In questo modo:
Qui la funzione precedente non funziona, perché i vettori hanno lunghezze diverse e abbiamo specificato la dimensione della matrice. Riproviamo a fare la stessa cosa cercando su Internet.
codice
# 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))
]
Unità: millisecondi
espr min lq media mediana
{ 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
La sceneggiatura ha funzionato a una velocità media di 1 secondo. Non male.
Collegati da una catena…
È possibile lavorare con gli oggetti DT utilizzando il concatenamento. È come collegare la sintassi delle parentesi a destra, in pratica zucchero filato.
codice
# 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)]
Scorre attraverso i tubi...
Le stesse operazioni possono essere eseguite tramite piping, un metodo simile ma funzionalmente più ricco, poiché è possibile utilizzare qualsiasi metodo, non solo DT. Deriviamo i coefficienti di regressione logistica per i nostri dati sintetici con una serie di filtri su DT.
codice
# 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]]
Statistiche, apprendimento automatico e altre cose all'interno di DT
È possibile utilizzare le funzioni lambda, ma a volte è meglio crearle separatamente, scrivere l'intera pipeline di analisi dei dati e procedere: funzionano all'interno del DT. L'esempio è arricchito con tutte le funzionalità di cui sopra, oltre a diverse funzionalità utili provenienti dall'arsenale del DT (come l'accesso al DT stesso all'interno del DT tramite riferimento, a volte inserito non in sequenza, ma in modo che sia presente).
codice
# 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)
conclusione
Spero di essere riuscito a creare un quadro completo, ma certamente non esaustivo, di un oggetto come data.table, partendo dalle sue proprietà relative all'ereditarietà dalle classi R e terminando con le sue caratteristiche e il suo ambiente dagli elementi di tidyverse. Spero che questo vi aiuti a comprendere e applicare meglio questa libreria per lavoro e divertimento.
Grazie!
Codice completo
codice
## 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)
Fonte: habr.com
