Este post será de interesse para aqueles que utilizam a biblioteca de processamento de dados em tabela do R, data.table, e ficarão satisfeitos em ver a flexibilidade de sua aplicação em diversos exemplos.
Inspirado por um bom exemplo E, esperando que você já tenha lido o artigo dele, sugiro que se aprofunde na otimização de código e no desempenho com base em Tabela de dados.
Introdução: De onde vem o data.table?
É melhor começar a familiarizar-se com a biblioteca de um ponto um pouco mais distante, ou seja, com as estruturas de dados a partir das quais o objeto data.table (doravante, DT) pode ser obtido.
Matriz
código
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Uma dessas estruturas é uma matriz (?base::arrayAssim como em outras linguagens, os arrays aqui são multidimensionais. No entanto, o interessante é que, por exemplo, um array bidimensional começa a herdar propriedades da classe de matrizes. (?base::matriz), e um array unidimensional, o que também é importante, não herda de um vetor (?base::vector).
É importante entender que o tipo de dados contidos em qualquer objeto deve ser verificado pela função. base::tipo de, que retorna a descrição interna do tipo de acordo com R Internals — um protocolo de linguagem comum associado ao original C.
Outro comando para determinar a classe de um objeto, base::class, no caso de vetores, retorna o tipo do vetor (tem um nome diferente do interno, mas também permite entender o tipo de dados).
Lista
A partir de uma matriz bidimensional, também conhecida como array, você pode acessar uma lista (?base::lista).
código
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Várias coisas acontecem ao mesmo tempo:
- A segunda dimensão da matriz colapsa, ou seja, obtemos simultaneamente uma lista e um vetor.
- Assim, uma lista herda dessas classes. Lembre-se de que cada elemento da lista corresponderá a um único valor (escalar) de uma célula da matriz.
Como uma lista também é um vetor, algumas funções vetoriais podem ser aplicadas a ela.
Dataframe
A partir de uma lista, matriz ou vetor, você pode ir para um quadro de dados (?base::data.frame).
código
## data.frames ------------
df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)
is.list(df)
df$V6 <- df$V1 + df$V2
O interessante é que o dataframe herda de uma lista! As colunas do dataframe são as células da lista. Isso será importante mais tarde, quando usarmos funções que se aplicam a listas.
Tabela de dados
Obtenha DT (?data.table::data.table) pode ser de quadro de dados, lista, vetor ou matriz. Por exemplo, assim (no local).
código
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
O que é útil é que, assim como um dataframe, uma DT herda as propriedades de uma lista.
DT e memória
Ao contrário de todos os outros objetos no R base, as árvores de decisão (DTs) são passadas por referência. Se você precisar copiá-las para um novo local de memória, precisará de uma função. data.table::copy ou você precisa fazer uma seleção do objeto antigo.
código
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)
Isso conclui a introdução. DT é uma continuação do desenvolvimento de estruturas de dados em R, principalmente através da expansão e aceleração das operações realizadas em objetos dataframe. Mantendo, ao mesmo tempo, a herança de outras primitivas.
Alguns exemplos de uso das propriedades do data.table
Como uma lista…
Iterar sobre as linhas de um dataframe ou DT não é a melhor ideia, visto que o código do loop está na linguagem. R muito mais lento CMas percorrer colunas, que geralmente são muito menos numerosas, é perfeitamente possível. Ao percorrer colunas, lembre-se de que cada coluna é um elemento de lista, normalmente contendo um vetor. E as operações com vetores são bem vetorizadas nas funções básicas da linguagem. Você também pode usar os operadores de seleção inerentes a listas e vetores: `[[`, `$`.
código
## 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)))
Vetorização
Se você precisar iterar pelas linhas de uma árvore de decisão grande, a melhor solução é escrever uma função vetorizada. Mas se isso não funcionar, lembre-se de que o loop dentro DT ainda é mais rápido que o ciclo em R, visto que é realizado em C.
Vamos tentar com um exemplo maior, com 100 mil linhas. Vamos extrair a primeira letra das palavras incluídas no vetor coluna. w.
Atualização do
código
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))
]
})
Primeira execução com iteração sobre as linhas:
Unidade: milissegundos
expr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq média mediana uq máximo neval
451.9998 460.1593 456.2505 460.9147 621.4042 100
Na segunda execução, a vetorização ocorre convertendo a lista em uma matriz e extraindo os elementos da fatia com índice 1 (esta última é a vetorização propriamente dita). Correção: vetorização no nível da função. strsplit, que pode aceitar um vetor como entrada. Acontece que o procedimento para converter uma lista em uma matriz é muito mais complexo do que a própria vetorização, mas mesmo assim, é muito mais rápido do que a versão não vetorizada.
Unidade: milissegundos
expr min lq média mediana uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100
Aceleração pela mediana em 3 vezes.
Na terceira execução, o esquema de conversão da matriz foi alterado.
Unidade: milissegundos
expr min lq média mediana uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100
Aceleração pela mediana em 13 vezes.
Você precisa experimentar com isso, quanto mais, melhor.
Aqui está outro exemplo de vetorização, também com texto, mas mais próximo das condições do mundo real: diferentes comprimentos e contagens de palavras. O objetivo é extrair as três primeiras palavras. Assim:
A função anterior não funciona aqui porque os vetores têm comprimentos diferentes e especificamos o tamanho da matriz. Vamos reformular isso pesquisando online.
código
# 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))
]
Unidade: milissegundos
expr min lq média mediana
{ dt[, `:=`((paste0(“w_”, 1:3)), strsplit(w, split = " ", fixed = T))] } 851.7623 916.071 1054.5 1035.199
uq máximo neval
1178.738 1356.816 100
O script foi executado a uma velocidade média de 1 segundo. Nada mal.
Unidos por uma corrente…
Você pode trabalhar com objetos DT usando encadeamento. Isso se parece com o encadeamento da sintaxe de parênteses à direita, essencialmente uma forma mais simples de explicar.
código
# 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)]
Está vazando pelos canos...
As mesmas operações podem ser realizadas usando encadeamento; a aparência é semelhante, mas a funcionalidade é mais rica, pois qualquer método pode ser usado, não apenas a árvore de decisão. Vamos derivar os coeficientes de regressão logística para nossos dados sintéticos com vários filtros de árvore de decisão.
código
# 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]]
Estatística, aprendizado de máquina e muito mais em DT
Funções lambda podem ser usadas, mas às vezes é melhor criá-las separadamente, escrever todo o pipeline de análise de dados e pronto — elas funcionam dentro da DT. O exemplo é enriquecido com todos os recursos mencionados acima, além de várias funcionalidades úteis do arsenal da DT (como acessar a própria DT dentro da DT por meio de um link, às vezes inserido fora de ordem, mas apenas para garantir).
código
# 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)
Conclusão
Espero ter conseguido criar uma visão abrangente, embora certamente não completa, do objeto `data.table`, desde suas propriedades relacionadas à herança de classes R até seus próprios recursos e ambiente de elementos do tidyverse. Espero que isso ajude você a entender e aplicar melhor esta biblioteca ao seu trabalho. diversão.
Obrigado!
Código completo
código
## 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
