data.table ümber

See märkus huvitab neid, kes kasutavad R-i tabeliandmete töötlemise raamatukogu data.table, ja võib-olla on rõõm näha selle paindlikkust erinevates näidetes.

Häid näiteid inspireerituna kolleegid, ja loodes, et olete juba tema artikli läbi lugenud, pakun sügavamalt uurida koodi ja tootlikkuse optimeerimist, lähtudes data.table.

Sissejuhatus: kust data.table pärineb?

Parim on alustada raamatukoguga tutvumist veidi kaugemalt, nimelt andmestruktuuridest, millest võib saada data.table objekti (edaspidi DT).

Maatrikssüsteem

Kood

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

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

class(arrmatr)

typeof(arrmatr)

is.array(arrmatr)

is.matrix(arrmatr)

Üks selliseid struktuure on maatriks (?base::array). Nagu teistes keeltes, on maatrit siin mitmemõõtmelised. Kuid huvitav on see, et näiteks kahe mõõtmega maatriks hakkab pärima omadusi maatriksi klassilt (?base::matrix), kuid ühe mõõtmega maatriks, mis on samuti oluline, ei pärige vektoritelt (?base::vector).

Samuti tuleb mõista, et mingis objekti sisaldavate andmete tüüp tuleks kontrollida funktsiooniga base::typeof, mis tagastab sisemise tüübi kirjelduse vastavalt R Internals — üldine keeleprotokoll, mis on seotud algse C.

Veel üks käsk objekti klassi määramiseks, base::class, tagastab vektorite puhul vektori tüübi (see erineb sisemisest nimest, kuid võimaldab samuti mõista andmetüüpi).

Loend

Kaks mõõdet, millele järgneb maatriks, saab muundada nimekirjaks (?base::list).

Kood

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

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

Samas juhtuvad mitu asja korraga:

• Maatriksi teine mõõde kokkutõmbub, s.t. saame korraga nii nimekirja kui vektori.
• Nimekiri pärib seega neist klassidest. Tuleb arvestada, et nimekirja elemendile vastab üks (skalaarne) väärtus maatriksi-massiivist.

Kuna nimekiri on ka vektor, saab sellele rakendada teatud vektorite funktsioone.

Andmeraam

Nimekirjast, maatriksist või vektorist saab luua andmeraami (?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

Mida on huvitav: andmeraam pärib nimekirjast! Andmeraami veerud on nimekirja lahtrid. See on oluline hiljem, kui hakkame kasutama nimekirjadele rakendatavaid funktsioone.

data.table

Saada DT (?data.table::data.table) saab andmeraamilt, nimekirjast, vektorist või maatriksist. Näiteks, nii (in place).

Kood

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

data.table::setDT(df)

is.list(df)

is.data.frame(df)

is.data.table(df)

Kasulik on see, et, nagu andmeraam, pärib DT nimekirja omadusi.

DT ja mälu

Erinevalt teistest objektidest R põhijas, edastatakse DT viidatud. Kui on vajalik kopeerida uude mäluala, on vajalik funktsioon data.table::copy või on vajalik valiku tegemine vanalt objektilt.

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 sissejuhatus jõuab lõpule. DT on R andmestruktuuride arendamise jätk, mis suuresti toimub objektide klassi andframe kohta tehtavate toimingute laiendamise ja kiirendamise kaudu. Samuti säilib pärimine teistelt primitiividelt.

Mõned näited data.table omaduste kasutamisest

Nagu nimekiri…

Itereerimine andframe või DT ridade kaudu pole parim idee, kuna tsüklikeel on R oluliselt aeglasem C, kuid tsüklites veergude kaudu liikuda, mida on tavaliselt oluliselt vähem, on täiesti võimalik. Kui liigelda veergude kaudu, peame meeles, et iga veerg on nimekirja element, mis sisaldab tavaliselt vektorit. Ja operatsioonid vektoritega on hästi vektoreeritud keele põhifunktsioonide seas. Samuti on võimalik kasutada valikutehnikaid, mis on iseloomulikud nimekirjadele ja vektoritele: `[[`, `$`.

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

Vektoreerimine

Kui on vajadus töötada suure andmetabeli ridadega, on parim lahendus funktsiooni kirjutamine vektorisusega. Kuid kui see ei õnnestu, tuleb meeles pidada, et tsükkel sisemine andmetabel on siiski kiirem kui tsükkel R, sest see toimub C.

Proovime suuremal näitel, kus on 100 000 rida. Vaatame, kuidas välja tuua esimene täht sõnadest, mis kuuluvad vektorveergu w.

Uuendatud

Kood

library(magrittr)
library(microbenchmark)

## Suurem näide ----

rown <- 100000

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

# vektorisus

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 jooks ridade järgi iteratsiooniga:

Ühik: 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 katse, kus vektoriseerimine toimub nimekirja maatriksiks muutmise kaudu ja elementide võtmisega lõikes indeksiga 1 (see ongi tegelikult vektoriseerimine). Täpsustan: vektoriseerimine funktsiooni tasemel strsplit, mis suudab vastu võtta vektori. Selgub, et nimekirja maatriksiks muutmise protseduur on palju keerulisem kui ise vektoriseerimine, kuid ka sel juhul on see palju kiirem kui vektoriseerimata variant.

Ühik: 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 järgi kiirus 3 korda.

Kolmas katse, kus on muudetud maatriksiks muutmise skeemi.

Ühik: 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 järgi kiirus 13 korda.

Selle asjaga tuleb katsetada, mida rohkem — seda parem saab olema.

Veel üks näide vektoriseerimisest, kus samuti tekst, kuid see on lähedane reaalsetele tingimustele: erineva sõna pikkusega, erinev sõnade arv. On vaja välja võtta esimesed 3 sõna. Nii:

Siin eelmine funktsioon ei tööta, kuna vektorid on erineva pikkusega, ja me määrasime maatriksi suuruse. Teeme selle ümber, uurides internetist.

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

Ühik: 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 kiirus 1 sekund. Mitte paha.

Seotud ketiga…

Objektidega DТ saab töötada, kasutades chaining. See näeb välja nagu sulgude õigelt külgede kinni panemine, sisuliselt on see magusam.

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

Voolab torude kaudu…

Sarnaseid operatsioone saab teha läbi piping, see näeb välja sarnane, kuid on funktsionaalselt rikkam, kuna saab kasutada mis tahes meetodeid, mitte ainult DТ-d. Väljastame logistikaregressiooni koefitsiendid meie sünteetiliste andmete jaoks koos mitmete filtritega DТ-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 DТ sees

Saab kasutada lambda-funktsioone, kuid mõnikord on parem luua need eraldi, kirjutada kogu andmeanalüüsi pipeline, ja edasi — need töötavad DТ sees. Näide on rikastatud kõigi ülaltoodud funktsioonidega, pluss mõned kasulikud asjad DТ arsenalist (näiteks viitamine DТ-le oma DТ-sse, mõnikord järjestikku mitte, aga 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 olen suutnud luua tervikliku, kuid kindlasti mitte täieliku, ülevaate sellisest objektist nagu data.table, alates selle omadustest, mis on seotud R klassidelt pärimisega, kuni selle enda eripärade ja tidyverse elementidega. Loodan, et see aitab teil paremini uurida ja kasutada seda teeki töötamiseks ja meelelahutuseks.

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