以可擴展的方式在 data.table 中引導多列 R

Question

這是一個跟進問題這一個。 在最初的問題中，OP 希望在固定的兩列x1和x2上執行引導：

set.seed(1000)
data <- as.data.table(list(x1 = runif(200), x2 = runif(200), group = runif(200)>0.5))
stat <- function(x, i) {x[i, c(m1 = mean(x1), m2 = mean(x2))]}
data[, list(list(boot(.SD, stat, R = 10))), by = group]$V1

但是，我認為這個問題可以很好地擴展到通過將它們視為組來處理任意數量的列。 例如，讓我們使用iris數據集。 假設我想計算每個物種所有四個維度的 bootstrap 平均值。 我可以使用 Melt 來翻轉數據，然后使用Species 、 variable組合來一次性獲得平均值 - 我認為這種方法可以很好地擴展。

data(iris)
iris = data.table(iris)
iris[,mean(Sepal.Length),by=Species]
iris[,ID:=.N,]
iris_deep = melt(iris
                 ,id.vars = c("ID","Species")
                 ,measure.vars = c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width"))
#define a mean bootstrap function
stat <- function(x, i) {x[i, m=mean(value),]}
iris_deep[, list(list(boot(.SD, stat, R = 100))), by = list(Species,variable)]$V1

這是我這樣做的嘗試。 但是，引導部分似乎不起作用。 由於 R 引發以下錯誤：

Error in mean(value) : object 'value' not found

有人可以嘗試一下嗎？

Answer 1

我試過這個（加上括號括起來m=mean(value) ），它似乎工作：

stat <- function(x, i) {x[i, (m=mean(value))]}

Answer 2

我們可以充分利用每個引導程序，並計算每個組內每個變量的平均值，而不是為每個變量重新運行引導程序。

所以如果我們做這樣的事情，它會計算每個變量的平均值：

iris = data.table(iris)
iris[sample(nrow(iris),replace=TRUE),lapply(.SD,mean,na.rm=TRUE),by=Species]

因為 boot 需要一個向量/矩陣輸出，我們需要修改上面的輸出，並為向量提供名稱：

d = function(dat,ind){
 k = dat[ind,lapply(.SD,mean,na.rm=TRUE),by=Species]
 k_vec = unlist(k[,-1])
 names(k_vec) = paste(rep(colnames(k)[-1],each=nrow(k)),rep(k$Species,(ncol(k)-1)),sep="_")
 k_vec
}

d(iris,sample(nrow(iris),replace=TRUE))
 Sepal.Length_versicolor  Sepal.Length_virginica     Sepal.Length_setosa 
              5.8784314               6.4851852               4.9688889 
 Sepal.Width_versicolor   Sepal.Width_virginica      Sepal.Width_setosa 
              2.7392157               2.9814815               3.3977778 
Petal.Length_versicolor  Petal.Length_virginica     Petal.Length_setosa 
              4.1980392               5.5037037               1.4644444 
 Petal.Width_versicolor   Petal.Width_virginica      Petal.Width_setosa 
              1.2960784               2.0944444               0.2333333

並使用帶有strata = iris$Species boot 來確保對 Species 進行均勻采樣：

bo_strata = boot(iris,d,R=1000,strata=iris$Species)

我們可以將這種方法的分布與問題中的分布進行比較：

stat <- function(x, i) {x[i, (m=mean(value))]}
bo_melt = iris_deep[, list(list(boot(.SD, stat, R = 1000))), by = list(Species,variable)]$V1

par(mfrow=c(4,3))
par(mar=c(3,3,3,3))
for(i in 1:ncol(bo_strata$t)){
plot(density(bo_strata$t[,i]),main=names(bo_strata$t0)[i],col="#43658b")
lines(density(bo_melt[[i]]$t),col="#ffa372")
legend("topright",fill=c("#43658b","#ffa372"),c("strata","other"))
}