డేటా. టేబుల్ చుట్టూ

R - data.table కోసం పట్టిక డేటా ప్రాసెసింగ్ లైబ్రరీని ఉపయోగించే వారికి ఈ గమనిక ఆసక్తిని కలిగిస్తుంది మరియు వివిధ ఉదాహరణలలో దాని ఉపయోగం యొక్క సౌలభ్యాన్ని చూసి సంతోషించవచ్చు.

ఒక మంచి ఉదాహరణ ద్వారా ప్రేరణ పొందింది సహచరులు, మరియు మీరు అతని కథనాన్ని ఇప్పటికే చదివారని ఆశిస్తూ, కోడ్ ఆప్టిమైజేషన్ మరియు పనితీరు ఆధారంగా మరింత లోతుగా త్రవ్వాలని నేను ప్రతిపాదించాను. డేటా. టేబుల్.

పరిచయం: data.table ఎక్కడ నుండి వస్తుంది?

లైబ్రరీతో కొంచెం దూరం నుండి పరిచయం చేసుకోవడం ప్రారంభించడం ఉత్తమం, అనగా, data.table object (ఇకపై DTగా సూచిస్తారు) పొందగలిగే డేటా నిర్మాణాలతో.

అమరిక

కోడ్

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

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

class(arrmatr)

typeof(arrmatr)

is.array(arrmatr)

is.matrix(arrmatr)

అటువంటి నిర్మాణం ఒక శ్రేణి (?బేస్::అరే) ఇతర భాషలలో వలె, ఇక్కడ శ్రేణులు బహుమితీయమైనవి. అయితే, ఆసక్తికరమైన విషయం ఏమిటంటే, ఉదాహరణకు, ద్విమితీయ శ్రేణి మాతృక తరగతి నుండి లక్షణాలను వారసత్వంగా పొందడం ప్రారంభమవుతుంది. (?బేస్::మాతృక), మరియు ఒక డైమెన్షనల్ శ్రేణి, ఇది కూడా ముఖ్యమైనది, వెక్టర్ నుండి వారసత్వంగా పొందదు (?బేస్::వెక్టర్).

ఏదైనా వస్తువులో ఉన్న డేటా రకాన్ని ఫంక్షన్ ఉపయోగించి తనిఖీ చేయాలని అర్థం చేసుకోవాలి బేస్:: రకం, ఇది ప్రకారం అంతర్గత రకం వివరణను అందిస్తుంది R ఇంటర్నల్స్ - ఒరిజినల్‌తో అనుబంధించబడిన భాష యొక్క సాధారణ ప్రోటోకాల్ C.

వస్తువు యొక్క తరగతిని నిర్ణయించడానికి మరొక ఆదేశం బేస్ :: తరగతి, వెక్టర్స్ విషయంలో, వెక్టార్ రకాన్ని తిరిగి అందిస్తుంది (ఇది అంతర్గత పేరు నుండి పేరులో భిన్నంగా ఉంటుంది, కానీ డేటా రకాన్ని అర్థం చేసుకోవడానికి మిమ్మల్ని అనుమతిస్తుంది).

జాబితా

మాతృక అని కూడా పిలువబడే రెండు డైమెన్షనల్ శ్రేణి నుండి, మీరు జాబితాకు వెళ్లవచ్చు (?బేస్:: జాబితా).

కోడ్

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

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

అనేక విషయాలు ఒకేసారి జరుగుతాయి:

  • మాతృక యొక్క రెండవ పరిమాణం కూలిపోతుంది, అంటే, మేము ఒకే సమయంలో జాబితా మరియు వెక్టర్ రెండింటినీ పొందుతాము.
  • జాబితా ఈ తరగతుల నుండి వారసత్వంగా పొందుతుంది. జాబితా మూలకం శ్రేణి మాతృక యొక్క సెల్ నుండి ఒక (స్కేలార్) విలువకు అనుగుణంగా ఉంటుందని గుర్తుంచుకోవాలి.

జాబితా కూడా వెక్టర్ అయినందున, దానికి కొన్ని వెక్టార్ ఫంక్షన్‌లు వర్తించవచ్చు.

డేటాఫ్రేమ్

మీరు జాబితా, మాతృక లేదా వెక్టర్ నుండి డేటాఫ్రేమ్‌కి వెళ్లవచ్చు (?బేస్::data.frame).

కోడ్

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

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

is.list(df)

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

దాని గురించి ఆసక్తికరమైన విషయం ఏమిటి: డేటాఫ్రేమ్ జాబితా నుండి వారసత్వంగా పొందుతుంది! డేటాఫ్రేమ్ నిలువు వరుసలు జాబితా సెల్‌లు. మేము జాబితాలకు వర్తించే ఫంక్షన్‌లను ఉపయోగించినప్పుడు ఇది తర్వాత ముఖ్యమైనది.

డేటా. టేబుల్

DT పొందండి (?data.table::data.table) నుండి కావచ్చు డేటాఫ్రేమ్, జాబితా, వెక్టర్ లేదా మాతృక. ఉదాహరణకు, ఇలా (స్థానంలో).

కోడ్

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

data.table::setDT(df)

is.list(df)

is.data.frame(df)

is.data.table(df)

డేటాఫ్రేమ్ లాగా, DT జాబితా యొక్క లక్షణాలను వారసత్వంగా పొందడం ఉపయోగకరంగా ఉంటుంది.

DT మరియు మెమరీ

R బేస్‌లోని అన్ని ఇతర వస్తువుల వలె కాకుండా, DTలు సూచన ద్వారా ఆమోదించబడతాయి. మీరు కొత్త మెమరీ ప్రాంతానికి కాపీని చేయాలనుకుంటే, మీకు ఒక ఫంక్షన్ అవసరం data.table::copy లేదా మీరు పాత వస్తువు నుండి ఎంపిక చేసుకోవాలి.

కోడ్

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)

ఇది పరిచయాన్ని ముగించింది. DT అనేది R లో డేటా స్ట్రక్చర్‌ల అభివృద్ధి యొక్క కొనసాగింపు, ఇది ప్రధానంగా డేటాఫ్రేమ్ క్లాస్ యొక్క వస్తువులపై చేసే కార్యకలాపాల విస్తరణ మరియు త్వరణం కారణంగా సంభవిస్తుంది. అదే సమయంలో, ఇతర ఆదిమానవుల నుండి వారసత్వం భద్రపరచబడుతుంది.

data.table లక్షణాలను ఉపయోగించడం కోసం కొన్ని ఉదాహరణలు

జాబితా లాగా...

భాషలో లూప్ కోడ్ ఉన్నందున, డేటాఫ్రేమ్ లేదా DT వరుసలపై మళ్లించడం మంచిది కాదు. R చాలా నెమ్మదిగా C, కానీ నిలువు వరుసల ద్వారా లూప్ చేయడం చాలా సాధ్యమే, ఇవి సాధారణంగా చాలా చిన్నవి. నిలువు వరుసల ద్వారా వెళుతున్నప్పుడు, ప్రతి నిలువు వరుస జాబితా యొక్క మూలకం అని గుర్తుంచుకోండి, సాధారణంగా వెక్టర్ ఉంటుంది. మరియు వెక్టర్స్‌పై కార్యకలాపాలు భాష యొక్క ప్రాథమిక విధుల్లో బాగా వెక్టరైజ్ చేయబడ్డాయి. మీరు జాబితాలు మరియు వెక్టర్‌లకు సాధారణ ఎంపిక ఆపరేటర్‌లను కూడా ఉపయోగించవచ్చు: `[[`, `$`.

కోడ్

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

వెక్టరైజేషన్

పెద్ద DT యొక్క పంక్తుల ద్వారా వెళ్లవలసిన అవసరం ఉన్నట్లయితే, వెక్టరైజేషన్తో ఒక ఫంక్షన్ రాయడం ఉత్తమ పరిష్కారం. కానీ ఇది పని చేయకపోతే, మీరు చక్రం అని గుర్తుంచుకోవాలి లోపల DT ఇప్పటికీ చక్రం కంటే వేగంగా ఉంటుంది R, ఇది ప్రదర్శించబడుతుంది కాబట్టి C.

100K అడ్డు వరుసలతో పెద్ద ఉదాహరణలో దీనిని ప్రయత్నిద్దాం. మేము వెక్టర్ కాలమ్‌లో చేర్చబడిన పదాల నుండి మొదటి అక్షరాన్ని సంగ్రహిస్తాము w.

నవీకరించబడింది

కోడ్

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

మొదటి పరుగు అడ్డు వరుసల మీద మళ్ళా:

యూనిట్: మిల్లీసెకన్లు
ఎక్స్‌ఆర్ నిమి
{ dt[, `:=`(first_l, unlist(strsplit(w, split = " ", fixed = T))[1]), by = 1:nrow(dt)]} 439.6217
lq అంటే మధ్యస్థ uq మాక్స్ నెవల్
451.9998 460.1593 456.2505 460.9147 621.4042 100

రెండవ పరుగు, ఇక్కడ జాబితాను మ్యాట్రిక్స్‌గా మార్చడం ద్వారా మరియు సూచిక 1తో స్లైస్‌లోని మూలకాలను తీసుకోవడం ద్వారా వెక్టరైజేషన్ జరుగుతుంది (తరువాతిది వెక్టరైజేషన్). దిద్దుబాటు: ఫంక్షన్ స్థాయిలో వెక్టరైజేషన్ strsplit, ఇది వెక్టర్‌ను ఇన్‌పుట్‌గా అంగీకరించగలదు. జాబితాను మ్యాట్రిక్స్‌గా మార్చే విధానం వెక్టరైజేషన్ కంటే చాలా కష్టం అని తేలింది, అయితే ఈ సందర్భంలో ఇది వెక్టరైజ్ కాని సంస్కరణ కంటే చాలా వేగంగా ఉంటుంది.

యూనిట్: మిల్లీసెకన్లు
expr min lq అంటే మధ్యస్థ uq మాక్స్ నెవల్
{ dt[, `:=`(first_l, .(first_l_f(w)))] 93.07916 112.1381 161.9267 149.6863 185.9893 442.5199 100

మధ్యస్థం ద్వారా త్వరణం 3 సార్లు.

మూడవ పరుగు, ఇక్కడ పరివర్తన పథకం మాతృకలోకి మార్చబడింది.

యూనిట్: మిల్లీసెకన్లు
expr min lq అంటే మధ్యస్థ uq మాక్స్ నెవల్
{ dt[, `:=`(first_l, .(first_l_f2(w)))] 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100

మధ్యస్థం ద్వారా త్వరణం 13 సార్లు.

మీరు ఈ విషయంలో ప్రయోగాలు చేయాలి, మరింత, అది మంచి ఉంటుంది.

వెక్టరైజేషన్‌తో మరొక ఉదాహరణ, ఇక్కడ టెక్స్ట్ కూడా ఉంది, కానీ ఇది వాస్తవ పరిస్థితులకు దగ్గరగా ఉంటుంది: వివిధ పదాల పొడవు, వివిధ పదాల సంఖ్య. మీరు మొదటి 3 పదాలను పొందాలి. ఇలా:

డేటా. టేబుల్ చుట్టూ

ఇక్కడ మునుపటి ఫంక్షన్ పనిచేయదు, ఎందుకంటే వెక్టర్స్ వేర్వేరు పొడవులను కలిగి ఉంటాయి మరియు మేము మాతృక పరిమాణాన్ని సెట్ చేస్తాము. ఇంటర్నెట్‌లో త్రవ్వడం ద్వారా దీన్ని మళ్లీ చేద్దాం.

కోడ్

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

యూనిట్: మిల్లీసెకన్లు
expr min lq అంటే మధ్యస్థం

{ dt[, `:=`((పేస్ట్0(“w_”, 1:3)), strsplit(w, split = " ", fixed = T))] 851.7623 916.071 1054.5 1035.199
uq మాక్స్ neval
1178.738 1356.816 100

స్క్రిప్ట్ సగటున 1 సెకను వేగంతో నడిచింది. చెడ్డది కాదు.

ఒక చైన్ ద్వారా కనెక్ట్ చేయబడింది...

మీరు చైనింగ్ ఉపయోగించి DT వస్తువులతో పని చేయవచ్చు. ఇది బ్రాకెట్ సింటాక్స్‌ను కుడి వైపున, ముఖ్యంగా చక్కెరను జోడించినట్లు కనిపిస్తోంది.

కోడ్

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

పైపుల ద్వారా ప్రవహిస్తూ...

అదే కార్యకలాపాలను పైపింగ్ ద్వారా చేయవచ్చు, ఇది సారూప్యంగా కనిపిస్తుంది, కానీ క్రియాత్మకంగా ధనికమైనది, ఎందుకంటే మీరు DT మాత్రమే కాకుండా ఏదైనా పద్ధతులను ఉపయోగించవచ్చు. DTలో అనేక ఫిల్టర్‌లతో మా సింథటిక్ డేటా కోసం లాజిస్టిక్ రిగ్రెషన్ కోఎఫీషియంట్‌లను పొందుదాం.

కోడ్

# 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 లోపల గణాంకాలు, మెషిన్ లెర్నింగ్ మరియు మరిన్ని

మీరు లాంబ్డా ఫంక్షన్‌లను ఉపయోగించవచ్చు, కానీ కొన్నిసార్లు వాటిని విడిగా సృష్టించడం, మొత్తం డేటా విశ్లేషణ పైప్‌లైన్‌ను వ్రాయడం మరియు ముందుకు వెళ్లడం మంచిది - అవి DT లోపల పని చేస్తాయి. ఉదాహరణ పైన పేర్కొన్న అన్ని లక్షణాలతో పాటు DT ఆయుధాగారం నుండి అనేక ఉపయోగకరమైన విషయాలతో సుసంపన్నం చేయబడింది (ఒక లింక్ ద్వారా DT లోపల DTని యాక్సెస్ చేయడం వంటివి, కొన్నిసార్లు వరుసగా చొప్పించబడవు, కానీ అది అలా ఉంటుంది).

కోడ్

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

తీర్మానం

R తరగతుల నుండి వారసత్వంతో అనుబంధించబడిన దాని లక్షణాల నుండి ప్రారంభించి మరియు చక్కని మూలకాల నుండి దాని స్వంత లక్షణాలు మరియు పర్యావరణంతో ముగిసే డేటా.టేబుల్ వంటి ఒక వస్తువు యొక్క పూర్తి చిత్రాన్ని నేను సృష్టించగలిగానని ఆశిస్తున్నాను. . పని కోసం ఈ లైబ్రరీని బాగా నేర్చుకోవడానికి మరియు ఉపయోగించడానికి ఇది మీకు సహాయపడుతుందని నేను ఆశిస్తున్నాను వినోదం.

డేటా. టేబుల్ చుట్టూ

ధన్యవాదాలు!

పూర్తి కోడ్

కోడ్

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

మూలం: www.habr.com

ఒక వ్యాఖ్యను జోడించండి