data.table අවට

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)

එවැනි එක් ව්‍යුහයක් යනු අරාවකි (?base::array) වෙනත් භාෂා වල මෙන්ම මෙහි අරාවන් බහුමාන වේ. කෙසේ වෙතත්, සිත්ගන්නා කරුණ නම්, උදාහරණයක් ලෙස, ද්විමාන අරාවක් අනුකෘති පන්තියෙන් ගුණාංග උරුම වීමට පටන් ගැනීමයි. (?base::matrix), සහ දෛශිකයකින් උරුම නොවන ඒකමාන අරාවක් ද වැදගත් වේ (?පාදය::දෛශිකය).

ඕනෑම වස්තුවක අඩංගු දත්ත වර්ගය ශ්‍රිතය භාවිතයෙන් පරීක්ෂා කළ යුතු බව තේරුම් ගත යුතුය පදනම:: වර්ගය, අනුව අභ්‍යන්තර ආකාරයේ විස්තරය ලබා දෙයි ආර් අභ්යන්තර - මුල් පිටපත හා සම්බන්ධ භාෂාවේ සාමාන්‍ය ප්‍රොටෝකෝලය C.

වස්තුවක පන්තිය තීරණය කිරීමට තවත් විධානයක් වේ පදනම::පන්තිය, දෛශික වලදී, දෛශික වර්ගය ආපසු ලබා දෙයි (එය අභ්යන්තරයේ නමට වඩා වෙනස් වේ, නමුත් දත්ත වර්ගය තේරුම් ගැනීමට ඔබට ඉඩ සලසයි).

ලැයිස්තුව

අනුකෘතියක් ලෙසද හැඳින්වෙන ද්විමාන අරාවකින්, ඔබට ලැයිස්තුවට යා හැක (?base::list).

කේතය

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

mylist <- as.list(arrmatr)

is.vector(mylist)

is.list(mylist)

එකවර දේවල් කිහිපයක් සිදු වේ:

  • න්‍යාසයේ දෙවන මානය බිඳ වැටේ, එනම් අපට ලැයිස්තුවක් සහ දෛශිකයක් එකවර ලැබේ.
  • මේ අනුව ලැයිස්තුව මෙම පන්ති වලින් උරුම වේ. ලැයිස්තු මූලද්‍රව්‍යයක් අරා න්‍යාසයේ සෛලයකින් එක් (අදිශ) අගයකට අනුරූප වන බව මතක තබා ගත යුතුය.

ලැයිස්තුවක් ද දෛශිකයක් වන බැවින්, සමහර දෛශික ශ්‍රිත එයට යෙදිය හැක.

දත්ත රාමුව

ඔබට ලැයිස්තුවක්, අනුකෘතියක් හෝ දෛශිකයකින් දත්ත රාමුවකට යා හැක (?base::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 පදනමේ ඇති අනෙකුත් සියලුම වස්තූන් මෙන් නොව, DTs යොමු කිරීම මගින් සම්මත වේ. ඔබට නව මතක ප්‍රදේශයකට පිටපතක් සෑදීමට අවශ්‍ය නම්, ඔබට කාර්යයක් අවශ්‍ය වේ 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 properties භාවිතා කිරීමේ උදාහරණ කිහිපයක්

ලැයිස්තුවක් වගේ...

භාෂාවේ ඇති ලූප් කේතය නිසා දත්ත රාමුවක හෝ 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))
		]
})

පළමුව පේළි හරහා පුනරාවර්තනය ධාවනය කරන්න:

ඒකකය: මිලි තත්පර
expr min
{dt[, `:=`(first_l, unlist(strsplit(w, split = "", fixed = T))[1]), by = 1:nrow(dt)]} 439.6217
lq යනු මධ්‍ය Uq max neval යන්නයි
451.9998 460.1593 456.2505 460.9147 621.4042 100

දෙවන ධාවනය, ලැයිස්තුව අනුකෘතියක් බවට පත් කිරීමෙන් සහ දර්ශක 1 සමඟ පෙත්ත මත ඇති මූලද්‍රව්‍ය ගැනීමෙන් දෛශිකකරණය සිදු වේ (දෙවැන්න දෛශිකකරණය වේ). නිවැරදි කිරීම: කාර්යය මට්ටමේ දෛශිකකරණය strsplit, දෛශිකයක් ආදානය ලෙස පිළිගත හැකි. ලැයිස්තුවක් අනුකෘතියක් බවට පත් කිරීමේ ක්‍රියා පටිපාටිය දෛශිකකරණයට වඩා බෙහෙවින් දුෂ්කර බව පෙනේ, නමුත් මේ අවස්ථාවේ දී එය දෛශික නොවන අනුවාදයට වඩා වේගවත් ය.

ඒකකය: මිලි තත්පර
expr min lq යනු මධ්‍ය Uq max neval යන්නයි
{ 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 max neval යන්නයි
{ dt[, `:=`(first_l, .(first_l_f2(w)))] 32.60481 34.13679 40.4544 35.57115 42.11975 222.972 100

මධ්‍යන්‍ය තුලින් ත්වරණය 13 වාරයක්.

ඔබ මෙම කාරණය සමඟ අත්හදා බැලීම් කළ යුතුය, වැඩි වැඩියෙන්, එය වඩා හොඳ වනු ඇත.

දෛශිකකරණය සමඟ තවත් උදාහරණයක්, පෙළ ද ඇත, නමුත් එය සැබෑ තත්වයන්ට සමීප වේ: විවිධ වචන දිග, විවිධ වචන ගණන. ඔබ පළමු වචන 3 ලබා ගත යුතුය. මෙවැනි:

data.table අවට

මෙහිදී දෛශික විවිධ දිග ඇති බැවින් පෙර ශ්‍රිතය ක්‍රියා නොකරයි, සහ අපි matrix ප්‍රමාණය සකසමු. අපි අන්තර්ජාලය හාරා මෙය නැවත කරමු.

කේතය

# 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[, `:=`((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

පිටපත තත්පර 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 වෙත ප්‍රවේශ වීම වැනි, සමහර විට අනුක්‍රමිකව නොව එය එසේ වේ).

කේතය

# 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 පන්ති වලින් උරුමය හා සම්බන්ධ එහි ගුණාංග වලින් ආරම්භ වී පිළිවෙලට ඇති මූලද්‍රව්‍ය වලින් එහිම ලක්ෂණ සහ පරිසරයෙන් අවසන් වන data.table වැනි වස්තුවක සම්පූර්ණ, නමුත් ඇත්ත වශයෙන්ම සම්පූර්ණ නොවන පින්තූරයක් නිර්මාණය කිරීමට මට හැකි වූ බව මම බලාපොරොත්තු වෙමි. . මෙම පුස්තකාලය වඩා හොඳින් ඉගෙන ගැනීමට සහ වැඩ සඳහා භාවිතා කිරීමට මෙය ඔබට උපකාර වනු ඇතැයි මම බලාපොරොත්තු වෙමි විනෝදාස්වාදය.

data.table අවට

ස්තුතියි!

සම්පූර්ණ කේතය

කේතය

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

අදහස් එක් කරන්න