ProHoster > Blogi > Haldamine > data.table'i ĂŒmber

data.table'i ĂŒmber

See mÀrkmeid on huvitav lugeda nende jaoks, kes kasutavad R-i tabelite töötlemise teeki - data.table, ja ilmselt on nad rÔÔmsad, et nÀevad selle rakendamise paindlikkust erinevates nÀidetes.

Inspireerituna heast nĂ€itest kolleegid, ja lootes, et olete juba lugenud tema artiklit, pakun sĂŒgavamalt uurida koodi optimeerimise ja jĂ”udluse suunda, tuginedes data.table.

Sissejuhatus: kust pÀrineb data.table?

Parim on alustada teegiga tutvumist natuke kaugemalt, nimelt andmestruktuuridest, mille alusel vÔib saada data.table objekti (edaspidi DT).

Massiiv

Kood

## arrays ---------

arrmatr <- array(1:20, c(4,5))

class(arrmatr)

typeof(arrmatr)

is.array(arrmatr)

is.matrix(arrmatr)

Üks sellistest struktuuridest on massiiv (?base::array). Nagu teistes keeltes on ka siin massiivid mitmemÔÔtmelised. Siiski on huvitav, et nĂ€iteks kahemÔÔtmeline massiiv hakkab pĂ€rima omadusi maatriksi klassilt (?base::matrix), ja ĂŒhe mÔÔtme massiiv ei pĂ€randi vektorilt (?base::vector).

Samas tuleks mĂ”ista, et andmetĂŒĂŒbi sisu, mis mĂ”nes objektis sisaldub, tuleb kontrollida funktsiooniga base::typeof, mis tagastab seadme sisu tĂŒĂŒbi vastavalt R Internals — keele pĂ”hiprotokoll, mis on seotud primitiivsete C.

Veel ĂŒks kĂ€sk, et mÀÀrata objekti klass, base::class, tagastab vektorite puhul veetori tĂŒĂŒbi (see erineb nimetuse poolest sisemisest, kuid vĂ”imaldab samuti mĂ”ista andme tĂŒĂŒpi).

Loend

KahemÔÔtmelisest massiivist, mida kutsutakse ka maatriksiks, saab liikuda loendisse (?base::list).

Kood

## lists ------------------

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

Sellega juhtub mitmeid asju korraga:

  • Maatriksi teine mÔÔde kokkutĂ”mbub, see tĂ€hendab, et saame korraga nii loendi kui ka vektori.
  • Loend pĂ€rib seega nende klasside omadusi. Tuleb meeles pidada, et loendi elemendile vastab ĂŒks (skalaarne) vÀÀrtus maatriksi-massivi lahtris.

Kuna loend on samuti veektor, siis saab sellele rakendada mÔningaid funktsioone vektorite jaoks.

Andmeframe

Loendist, maatriksist vÔi veektorist saab liikuda andmeframe'i (?base::data.frame).

Kood

## data.frames ------------

df <- as.data.frame(arrmatr)
df2 <- as.data.frame(mylist)

is.list(df)

df$V6 <- df$V1 + df$V2

Mis on selles huvitav: andmeframe pÀrib loendist! Andmeframe'i veerud on loendi lahtrid. See on oluline edaspidi, kui hakkame kasutama loenditele rakendatavaid funktsioone.

data.table

Saada DT (?data.table::data.table) saab andmeframe'ist , loendist, vektorist vÔi maatriksist. NÀiteks niimoodi (in place).Kasulik on see, et, nagu andmeframe, pÀrib DT loendi omadusi.

Kood

## data.tables -----------------------
library(data.table)

data.table::setDT(df)

is.list(df)

is.data.frame(df)

is.data.table(df)

DT ja mÀlu

DT ja mÀlu

Erinevalt kÔigist teistest objektidest R baasil edastatakse DT viidena. Juhul, kui soovite kopeerida uude mÀlu, on vajalik funktsioon data.table::copy vÔi tuleb teha valik vanast objektist.

Kood

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)

Selle sissejuhatuse lÔpetuseks. DT on R andmestruktuuride arengu jÀtk, mis toimub peamiselt andmeraami klassi objektide toimingute laiendamise ja kiirendamise kaudu. Samuti sÀilib pÀrimine teistelt primitiividelt.

MÔned nÀited data.table omaduste kasutamisest

Nagu loendis


Itereerimine andmeraami vĂ”i DT ridade ĂŒle ei ole parim idee, kuna tsĂŒkli kood keeles R on oluliselt aeglasem C, kuid tsĂŒkli kĂ€imine veergude kaudu, mida tavaliselt on oluliselt vĂ€hem, on tĂ€iesti vĂ”imalik. Veergude kaudu liikudes pidage meeles, et iga veerg on loendi element, mis sisaldab tavaliselt vektorit. Vektoritega seotud toimingud on keele baastegevustes vĂ€ga heas vektorkujulisuses. Samuti on vĂ”imalik kasutada loendite ja vektorite puhul iseloomulikke valikuoperaatoreid: `[[`, `$`.

Kood

## 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)))

Vektorisatsioon

Kui on vajalik lĂ€bida suur DT read, on parim lahendus funktsiooni kirjutamine vektorisatsiooniga. Kuid kui see ei Ă”nnestu, tuleks meeles pidada, et tsĂŒkkel sees DT on ikkagi kiirem kui tsĂŒkkel R, kuna see toimub C.

Proovime suurema nÀite puhul, millel on 100K rida. Vaatame, kuidas tuua esimest tÀhte sÔnadest, mis on veeru-vektorisse kuuluvad w.

Uuendatud

Kood

library(magrittr)
library(microbenchmark)

## Suurem nÀide ----

rown <- 100000

dt %
	.[, d := 1 + b + c + rnorm(nrow(.))]

# vektorisatsioon

microbenchmark({
	dt[
		, first_l := unlist(strsplit(w, split = ' ', fixed = T))[1]
		, by = 1:nrow(dt)
	   ]
})

# teine

first_l_f %
		do.call(rbind, .) %>%
		`[`(,1)
}

dt[, first_l := NULL]

microbenchmark({
	dt[
		, first_l := .(first_l_f(w))
		]
})

# kolmas

first_l_f2 %
		unlist %>%
		matrix(nrow = 3) %>%
		`[`(1,)
}

dt[, first_l := NULL]

microbenchmark({
	dt[
		, first_l := .(first_l_f2(w))
		]
})

Esimene katse ridade iteratsiooni puhul:

Üksus: millisekundid
expr min
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)] } 439.6217
lq mean median uq max neval
451.9998 460.1593 456.2505 460.9147 621.4042 100

Teine töötlus, kus vektoreerimine toimub nimekirja muutmisel maatriksiks ja elementide vÔtmine lÔikes, mille indeks on 1 (see ongi tegelik vektoreerimine). TÀpsustan: vektoreerimine funktsioonitasemel strsplit, mis suudab vastu vÔtta vektori. Selgub, et nimekirja muutmine maatriksiks on palju raskem kui vektoreerimine, kuid ka selle puhul on see siiski palju kiirem kui mitte-vektoreeritud variant.

Üksus: millisekundid
expr min lq mean median uq max neval
{ dt[, `:=`(first_l, .(first_l_f(w)))] } 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100

Keskmise kiirus 3 korda.

Kolmas töötlus, kus on muudetud maatriksiks muutmise skeemi.

Üksus: millisekundid
expr min lq mean median uq max neval
{ dt[, `:=`(first_l, .(first_l_f2(w)))] } 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100

Keskmise kiirus 13 korda.

Selle asjaga tuleb katsetada, mida rohkem - seda parem.

Veel ĂŒks nĂ€ide vektoreerimisest, kus on samuti tekst, kuid see on lĂ€hemal reaalsusele: erineva pikkusega sĂ”nad, erinev arv sĂ”nu. Tuleb vĂ€lja vĂ”tta esimesed 3 sĂ”na. Siin on nĂ€ide:

data.table'i ĂŒmber

Siin ei tööta eelmine funktsioon enam, kuna vektorid on erineva pikkusega, aga me mÀÀrasime maatriksi suuruse. Muudame selle ĂŒle, uurides veebi.

Kood

# 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))
	]

Üksus: millisekundid
expr min lq mean median

{ 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

Skript töötas keskmise kiirusena 1 sekund. Pole paha.

Olgem seotud ĂŒhe ahelaga


DT objektidega saab töötada, kasutades chaining'ut. See nĂ€eb vĂ€lja nagu sulgude sĂŒntaksi liitmine paremale, pĂ”himĂ”tteliselt, maitseasi.

Kood

# 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)]

Voogab torude kaudu


Sarnaseid toiminguid saab teha ka piping'u kaudu, see nĂ€eb vĂ€lja sarnane, kuid on funktsionaalselt rikkam, kuna saab kasutada kĂ”iki meetodeid, mitte ainult DT-d. VĂ€ljastame logistilise regressiooni koefitsiendid meie sĂŒnteetiliste andmete jaoks koos mitmete filtritega DT-l.

Kood

# 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]]

Statistika, masinÔpe ja muu sarnane DT sees

Saab kasutada lambda-funktsioone, kuid mĂ”nikord on parem luua need eraldi, kirjutada kogu andmeanalĂŒĂŒsi töövoog ja edasi - nad töötavad DT sees. NĂ€ide on rikastatud kĂ”ikide eelmainitud omadustega, pluss mĂ”ned kasulikud asjad DT arsenalist (nagu viitamine DT-le ise DT sees, mĂ”nikord mitte jĂ€rjestikku, aga nii, et see oleks).

Kood

# 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)

KokkuvÔte

Loodan, et suutsin luua tervikliku, kuigi mitte tingimata tĂ€ieliku, ĂŒlevaate sellisest objekti nagu data.table, alates selle omadustest, mis on seotud R klasside pĂ€rimisega, kuni selle enda eripĂ€rade ja tidyverse'i elementidega. Loodan, et see aitab teil paremini mĂ”ista ja rakendada seda teeki töö ja meelelahutuse.

data.table'i ĂŒmber

AitÀh!

TĂ€ielik kood

Kood

## 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)

Allikas: habr.com

Osta usaldusvÀÀrne hostimine veebilehtede jaoks DDoS-i kaitsega, VPS VDS serverid đŸ”„ Osta usaldusvÀÀrne hostimine veebilehtede jaoks DDoS-i kaitsega, VPS VDS serverid | ProHoster