Ushbu post R jadvali ma'lumotlarini qayta ishlash kutubxonasi data.tabledan foydalanadiganlar uchun qiziqarli bo'ladi va uni turli misollarda qo'llashning moslashuvchanligini ko'rishdan mamnun bo'lishi mumkin.
Yaxshi namunadan ilhomlangan , va siz uning maqolasini allaqachon o'qib chiqdingiz degan umidda, men kodni optimallashtirish va ishlashga asoslangan holda chuqurroq o'rganishni taklif qilaman. ma'lumotlar jadvali.
Kirish: Data.table qayerdan keladi?
Kutubxona bilan tanishishni biroz uzoqroqdan, ya'ni data.table ob'ektini (bundan buyon matnda DT) olish mumkin bo'lgan ma'lumotlar tuzilmalari bilan tanishishni boshlagan ma'qul.
Array
da
## arrays ---------
arrmatr <- array(1:20, c(4,5))
class(arrmatr)
typeof(arrmatr)
is.array(arrmatr)
is.matrix(arrmatr)
Bunday tuzilmalardan biri massiv (?base::massiv). Boshqa tillarda bo'lgani kabi, bu erda massivlar ko'p o'lchovli. Biroq, qiziq tomoni shundaki, masalan, ikki o'lchovli massiv matritsa sinfidan xususiyatlarni meros qilib olishni boshlaydi. (?asosiy::matritsa) va bir o'lchovli massiv, bu ham muhim, vektordan meros bo'lmaydi (?base::vektor).
Har qanday ob'ektdagi ma'lumotlar turini funktsiya tomonidan tekshirish kerakligini tushunish muhimdir tayanch::typeofga muvofiq turning ichki tavsifini qaytaradi R ichki — asl nusxa bilan bog'langan umumiy til protokoli C.
Ob'ekt sinfini aniqlash uchun yana bir buyruq, baza :: sinf, vektorlar bo'lsa, vektor turini qaytaradi (u ichki nomdan boshqacha nomga ega, ammo ma'lumotlar turini tushunishga imkon beradi).
ro'yxat
Matritsa deb ham ataladigan ikki o'lchovli massivdan siz ro'yxatga o'tishingiz mumkin (?base::list).
da
## lists ------------------
mylist <- as.list(arrmatr)
is.vector(mylist)
is.list(mylist)
Bir vaqtning o'zida bir nechta narsa sodir bo'ladi:
- Matritsaning ikkinchi o'lchami qulab tushadi, ya'ni biz bir vaqtning o'zida ro'yxatni ham, vektorni ham olamiz.
- Shunday qilib, ro'yxat ushbu sinflardan meros bo'lib qoladi. Shuni yodda tutingki, har bir ro'yxat elementi matritsa massivining yacheykasidan bitta (skalar) qiymatga mos keladi.
Ro'yxat ham vektor bo'lgani uchun unga ba'zi vektor funktsiyalarni qo'llash mumkin.
Dataframe
Ro'yxat, matritsa yoki vektordan ma'lumotlar ramkasiga o'tishingiz mumkin (?base::data.frame).
da
## data.frames ------------
df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)
is.list(df)
df$V6 <- df$V1 + df$V2
Qizig'i shundaki, dataframe ro'yxatdan meros qilib oladi! Dataframe ustunlari ro'yxatning kataklaridir. Bu keyinchalik ro'yxatlarga tegishli funksiyalardan foydalanganda muhim bo'ladi.
ma'lumotlar jadvali
DT (?data.table::data.table) dan bo'lishi mumkin ma'lumotlar ramkasi, roʻyxat, vektor yoki matritsa. Masalan, bu kabi (joyida).
da
## data.tables -----------------------
library(data.table)
data.table::setDT(df)
is.list(df)
is.data.frame(df)
is.data.table(df)
Foydali tomoni shundaki, dataframe kabi, DT ro'yxat xususiyatlarini meros qilib oladi.
DT va xotira
R bazasidagi barcha boshqa ob'ektlardan farqli o'laroq, DT mos yozuvlar orqali uzatiladi. Agar siz ularni yangi xotira joyiga nusxalashingiz kerak bo'lsa, sizga funktsiya kerak bo'ladi data.table::copy yoki eski ob'ektdan tanlov qilishingiz kerak.
da
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)
Bu kirishni yakunlaydi. DT R da ma'lumotlar tuzilmalari rivojlanishining davomi bo'lib, birinchi navbatda dataframe ob'ektlari ustida bajariladigan operatsiyalarni kengaytirish va tezlashtirish orqali amalga oshiriladi. Boshqa ibtidoiylardan merosni saqlab qolishda.
Data.table xususiyatlaridan foydalanishning ba'zi misollari
Roʻyxat sifatida…
Dataframe yoki DT satrlarini takrorlash eng yaxshi fikr emas, chunki sikl kodi tilda. R ancha sekinroq C, lekin odatda ancha kam bo'lgan ustunlar orqali aylanish mutlaqo mumkin. Ustunlar bo'ylab aylanayotganda, har bir ustun odatda vektorni o'z ichiga olgan ro'yxat elementi ekanligini unutmang. Vektorlar ustidagi amallar esa asosiy til funksiyalarida yaxshi vektorlashtirilgan. Roʻyxat va vektorlarga xos boʻlgan tanlash operatorlaridan ham foydalanishingiz mumkin: `[[`, `$`.
da
## 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)))
Vektorlashtirish
Katta DT satrlari bo'ylab takrorlash kerak bo'lsa, eng yaxshi yechim vektorlashtirilgan funktsiyani yozishdir. Ammo bu ishlamasa, tsiklni unutmang ichida DT hali ham tsikldan tezroq R, chunki u amalga oshiriladi C.
Keling, 100K qatorli kattaroq misolda sinab ko'raylik. Ustun vektoriga kiritilgan so'zlardan birinchi harfni ajratib olamiz. w.
yangilangan
da
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))
]
})
Avval satrlar bo'ylab iteratsiya bilan ishga tushirish:
Birlik: millisekundlar
eksr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq o‘rtacha median uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100
Ikkinchi ishga tushirish, bu erda vektorlashtirish ro'yxatni matritsaga aylantirish va 1 indeksli bo'lim elementlarini olish orqali sodir bo'ladi (oxirgisi haqiqiy vektorizatsiya). Tuzatish: funktsiya darajasida vektorlashtirish. strsplit, bu vektorni kirish sifatida qabul qilishi mumkin. Ma'lum bo'lishicha, ro'yxatni matritsaga aylantirish tartibi vektorlashtirishning o'ziga qaraganda ancha murakkab, ammo bu holda ham vektorlashtirilmagan versiyaga qaraganda ancha tezroq.
Birlik: millisekundlar
expr min lq o'rtacha median uq max neval
{ dt[, `:=`(birinchi_l, .(birinchi_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100
Median bo'yicha tezlashuv 3 marta.
Uchinchi yugurish, bu erda matritsani o'zgartirish sxemasi o'zgartirildi.
Birlik: millisekundlar
expr min lq o'rtacha median uq max neval
{ dt[, `:=`(birinchi_l, .(birinchi_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100
Median bo'yicha tezlashuv 13 marta.
Siz bu masalada tajriba qilishingiz kerak, qanchalik ko'p bo'lsa, shuncha yaxshi.
Mana yana bir vektorlashtirish misoli, shuningdek, matn bilan, lekin real sharoitlarga yaqinroq: turli so'z uzunliklari va har xil so'zlar soni. Maqsad birinchi uchta so'zni ajratib olishdir. Shunga o'xshash:
Oldingi funktsiya bu erda ishlamaydi, chunki vektorlar turli uzunliklarga ega va biz matritsa o'lchamini aniqladik. Keling, buni Internetda qazish orqali qayta ishlaymiz.
da
# 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))
]
Birlik: millisekundlar
expr min lq o'rtacha median
{ dt[, `:=`((paste0("w_", 1:3)), strsplit(w, split = " ", belgilangan = T))] } 851.7623 916.071 1054.5 1035.199
uq max neval
1178.738 1356.816 100
Skript o'rtacha 1 soniya tezlikda ishladi. Yomon emas.
Bitta zanjir bilan bog‘langan…
Zanjirlash yordamida DT ob'ektlari bilan ishlashingiz mumkin. Bu o'ngdagi qavslar sintaksisini zanjirband qilish kabi ko'rinadi, asosan shakar qoplamasi.
da
# 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)]
Quvurlardan oqib chiqyapti...
Xuddi shu operatsiyalar quvurlar yordamida amalga oshirilishi mumkin; u o'xshash ko'rinadi, lekin funktsional jihatdan ancha boy, chunki faqat DT emas, balki har qanday usullardan foydalanish mumkin. Keling, bir qator DT filtrlari yordamida sintetik ma'lumotlarimiz uchun logistik regressiya koeffitsientlarini chiqaramiz.
da
# 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]]
DT doirasida statistika, mashinani oʻrganish va boshqalar
Lambda funktsiyalaridan foydalanish mumkin, lekin ba'zida ularni alohida yaratish, ma'lumotlarni tahlil qilish jarayonini to'liq yozish va siz to'xtashingiz yaxshiroqdir - ular DT ichida ishlaydi. Misol yuqorida aytib o'tilgan barcha xususiyatlar, shuningdek, DT arsenalidagi bir nechta foydali narsalar bilan boyitilgan (masalan, DTning o'ziga DT ichidagi havola orqali kirish, ba'zan ketma-ket kiritilgan, ammo ishonch hosil qilish uchun).
da
# 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)
xulosa
Umid qilamanki, men data.table ob'ektining R sinflaridan meros bo'lish bilan bog'liq xususiyatlaridan tortib, o'ziga xos xususiyatlari va tartibli elementlar muhitigacha bo'lgan keng qamrovli, ammo to'liq bo'lmasa-da rasmini yarata oldim. Umid qilamanki, bu sizga ushbu kutubxonani yaxshiroq tushunishga va ishingizda qo'llashga yordam beradi. o'yin-kulgi.
Rahmat!
To'liq kod
da
## 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)
Manba: www.habr.com
