Nota ini akan menarik minat mereka yang menggunakan perpustakaan pemprosesan data jadual untuk R - data.table, dan mungkin gembira melihat fleksibiliti penggunaannya dalam pelbagai contoh.
Diilhamkan oleh contoh yang baik , dan berharap anda telah membaca artikelnya, saya mencadangkan untuk menggali lebih mendalam ke arah pengoptimuman dan prestasi kod berdasarkan data.tabel.
Pengenalan: Dari mana datangnya data.table?
Adalah lebih baik untuk mula membiasakan diri dengan perpustakaan sedikit dari jauh, iaitu, dengan struktur data dari mana objek data.table (selepas ini dirujuk sebagai DT) boleh diperolehi.
Массив
Kod
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Satu struktur tersebut ialah tatasusunan (?base::array). Seperti dalam bahasa lain, tatasusunan di sini adalah multidimensi. Walau bagaimanapun, perkara yang menarik ialah, sebagai contoh, tatasusunan dua dimensi mula mewarisi sifat daripada kelas matriks (?asas::matriks), dan tatasusunan satu dimensi, yang juga penting, tidak mewarisi daripada vektor (?asas::vektor).
Perlu difahami bahawa jenis data yang terkandung dalam mana-mana objek harus diperiksa menggunakan fungsi tersebut asas::jenis, yang mengembalikan perihalan jenis dalaman mengikut R Dalaman - protokol umum bahasa yang dikaitkan dengan bahasa asal C.
Perintah lain untuk menentukan kelas objek ialah asas::kelas, dalam kes vektor, mengembalikan jenis vektor (ia berbeza dalam nama daripada yang dalaman, tetapi juga membolehkan anda memahami jenis data).
Senarai
Daripada tatasusunan dua dimensi, juga dikenali sebagai matriks, anda boleh pergi ke senarai (?base::list).
Kod
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Beberapa perkara berlaku serentak:
- Dimensi kedua matriks runtuh, iaitu, kita mendapat kedua-dua senarai dan vektor pada masa yang sama.
- Senarai itu mewarisi daripada kelas ini. Perlu diingat bahawa elemen senarai akan sepadan dengan satu nilai (skalar) daripada sel matriks tatasusunan.
Oleh kerana senarai juga merupakan vektor, beberapa fungsi vektor boleh digunakan padanya.
Bingkai data
Anda boleh pergi dari senarai, matriks atau vektor ke bingkai data (?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
Apa yang menarik tentangnya: kerangka data mewarisi daripada senarai! Lajur bingkai data ialah sel senarai. Ini akan menjadi penting kemudian apabila kita menggunakan fungsi yang digunakan pada senarai.
data.tabel
Dapatkan DT (?data.table::data.table) boleh dari rangka data, senarai, vektor atau matriks. Sebagai contoh, seperti ini (di tempat).
Kod
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
Adalah berguna bahawa, seperti bingkai data, DT mewarisi sifat senarai.
DT dan ingatan
Tidak seperti semua objek lain dalam pangkalan R, DT diluluskan melalui rujukan. Jika anda perlu membuat salinan ke kawasan memori baharu, anda memerlukan fungsi data.table::copy atau anda perlu membuat pilihan daripada objek lama.
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)
Ini menyimpulkan pengenalan. DT ialah kesinambungan pembangunan struktur data dalam R, yang kebanyakannya berlaku disebabkan oleh pengembangan dan pecutan operasi yang dilakukan pada objek kelas bingkai data. Pada masa yang sama, warisan daripada primitif lain dipelihara.
Beberapa contoh penggunaan sifat data.table
Seperti senarai...
Mengulangi baris bingkai data atau DT bukanlah idea yang baik, kerana kod gelung dalam bahasa itu R jauh lebih perlahan C, tetapi sangat mungkin untuk melingkari lajur, yang biasanya lebih kecil. Menerusi lajur, ingat bahawa setiap lajur ialah elemen senarai, biasanya mengandungi vektor. Dan operasi pada vektor divektorkan dengan baik dalam fungsi asas bahasa. Anda juga boleh menggunakan operator pilihan yang biasa digunakan untuk senarai dan 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)))
Vektorisasi
Sekiranya terdapat keperluan untuk melalui garisan DT yang besar, penyelesaian terbaik ialah menulis fungsi dengan vektorisasi. Tetapi jika ini tidak berfungsi, maka anda harus ingat bahawa kitaran dalam DT masih lebih laju daripada kitaran R, kerana ia dilakukan pada C.
Mari cuba pada contoh yang lebih besar dengan 100K baris. Kami akan mengekstrak huruf pertama daripada perkataan yang disertakan dalam lajur vektor w.
dikemaskini
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))
]
})
Larian pertama berulang ke atas baris:
Unit: milisaat
expr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq min median uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100
Larian kedua, di mana vektorisasi berlaku dengan menukar senarai menjadi matriks dan mengambil elemen pada kepingan dengan indeks 1 (yang terakhir ialah vektorisasi itu sendiri). Pembetulan: vektorisasi pada tahap fungsi strsplit, yang boleh menerima vektor sebagai input. Ternyata prosedur untuk menukar senarai menjadi matriks adalah jauh lebih sukar daripada vektorisasi itu sendiri, tetapi dalam kes ini ia lebih cepat daripada versi bukan vektor.
Unit: milisaat
expr min lq min median uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100
Pecutan oleh median dalam 3 kali.
Larian ketiga, di mana skema transformasi ke dalam matriks telah diubah.
Unit: milisaat
expr min lq min median uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100
Pecutan oleh median dalam 13 kali.
Anda perlu bereksperimen dengan perkara ini, lebih banyak, lebih baik ia akan menjadi.
Satu lagi contoh dengan vektorisasi, di mana terdapat juga teks, tetapi ia hampir dengan keadaan sebenar: panjang perkataan yang berbeza, bilangan perkataan yang berbeza. Anda perlu mendapatkan 3 perkataan pertama. seperti ini:
Di sini fungsi sebelumnya tidak berfungsi, kerana vektor mempunyai panjang yang berbeza, dan kami menetapkan saiz matriks. Mari kita buat semula ini dengan mencari-cari di 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))
]
Unit: milisaat
expr min lq min median
{ dt[, `:=`((tampal0(“w_”, 1:3)), strsplit(w, belah = " ", tetap = T))] } 851.7623 916.071 1054.5 1035.199
uq max neval
1178.738 1356.816 100
Skrip berjalan pada kelajuan purata 1 saat. Boleh tahan.
Disambungkan dengan satu rantai...
Anda boleh bekerja dengan objek DT menggunakan rantaian. Ia kelihatan seperti melampirkan sintaks kurungan di sebelah kanan, pada asasnya gula.
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)]
Mengalir melalui paip...
Operasi yang sama boleh dilakukan melalui paip, ia kelihatan serupa, tetapi lebih kaya dari segi fungsi, kerana anda boleh menggunakan sebarang kaedah, bukan hanya DT. Mari dapatkan pekali regresi logistik untuk data sintetik kami dengan beberapa penapis pada 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]]
Statistik, pembelajaran mesin dan banyak lagi dalam DT
Anda boleh menggunakan fungsi lambda, tetapi kadangkala lebih baik untuk menciptanya secara berasingan, menulis keseluruhan saluran analisis data, dan teruskan - ia berfungsi di dalam DT. Contoh ini diperkaya dengan semua ciri di atas, ditambah dengan beberapa perkara berguna daripada senjata DT (seperti mengakses DT itu sendiri di dalam DT melalui pautan, kadang-kadang dimasukkan tidak secara berurutan, tetapi supaya ia).
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)
Kesimpulan
Saya berharap bahawa saya dapat mencipta gambar yang lengkap, tetapi, sudah tentu, tidak lengkap, objek seperti data.table, bermula dari sifatnya yang dikaitkan dengan warisan dari kelas R dan berakhir dengan ciri dan persekitarannya sendiri dari unsur tidyverse . Saya harap ini akan membantu anda untuk belajar dengan lebih baik dan menggunakan perpustakaan ini untuk bekerja dan hiburan.
Thank you!
Kod penuh
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)
Sumber: www.habr.com
