在 R 中引導一個簡單的 function

Question

我有一個名為foo的簡單 function 。 為了引導它（隨機洗牌），我使用這里的說明使用庫boot 。 但看起來我遇到了索引問題，因為我收到以下錯誤：

number of items to replace is not a multiple of replacement length ，這可以修復嗎？

library(boot)
foo <- function(X) {
  X <- as.matrix(X)
 tab <- table(row(X), factor(X, levels = sort(unique(as.vector(X)))))
 w <- diag(ncol(tab))
 rosum <- rowSums(tab)
 obs_oc <- tab * (t(w %*% t(tab)) - 1)
 obs_c <- colSums(obs_oc)
 max_oc <- tab * (rosum - 1)
 max_c <- colSums(max_oc)
 SA <- obs_c / max_c
 h <- names(SA)
 h[is.na(h)] <- "NA"
 setNames(SA, h)
 }  
 # EXAMPLE OF USE:
 dat <- data.frame(a = 1:4, b = c(2,1, 3, 4))

 foo(dat)

 # Tried the following to bootstrap it:

 boot_fun <- function(data, i){

  resample <- data[i, ,drop = FALSE]
  foo(resample)
 }

boot::boot(
 data = dat,
statistic = boot_fun,
R = 200)

Answer 1

實際上，您可以使用replicate來進行引導，並且不需要boot來引導。 但是，您的 function 可能會產生與預期不同的結果。

set.seed(42)
R <- 5
replicate(R, foo(dat[sample(1:nrow(dat), replace=TRUE),]))
# [[1]]
# 1 2 
# 0 0 
# 
# [[2]]
# 1 2 4 
# 0 0 1 
# 
# [[3]]
# 1 2 3 4 
# 0 0 1 1 
# 
# [[4]]
# 1 2 3 4 
# 0 0 1 1 
# 
# [[5]]
# 1 2 4 
# 0 0 1 

如您所見，結果可能具有不同的長度，從而導致錯誤。

我不確定你在追求什么，但我認為第二條線是問題的症結所在。 table沒有得到不存在的級別。 您可以嘗試使用一個factor並定義一組完整的levels= 。 不過，我不確定您的真實數據的獨特級別是什么，我只是使用了行號。 但這可能會對您有所幫助。

foo <- function(X) {
  X <- as.matrix(X)
  # tab <- table(row(X), unlist(X))  ## NB: unlisting a matrix is pointless, use as.vector()
  tab <- table(row(X), factor(as.vector(X), levels=1:nrow(X)))
  w <- diag(ncol(tab))
  rosum <- rowSums(tab)
  obs_oc <- tab * (t(w %*% t(tab)) - 1)
  obs_c <- colSums(obs_oc)
  max_oc <- tab * (rosum - 1)
  max_c <- colSums(max_oc)
  SA <- obs_c / max_c
  h <- names(SA)
  h[is.na(h)] <- "NA"
  setNames(SA, h)
}  

set.seed(42)
replicate(5, foo(dat[sample(1:nrow(dat), replace=TRUE),]))
#   [,1] [,2] [,3] [,4] [,5]
# 1    0    0    0    0    0
# 2    0    0    0    0    0
# 3  NaN  NaN    1    1  NaN
# 4  NaN    1    1    1    1

或使用boot 。

set.seed(42)
boot::boot(
  data = dat,
  statistic = boot_fun,
  R = 200)
# ORDINARY NONPARAMETRIC BOOTSTRAP
# 
# 
# Call:
#   boot::boot(data = dat, statistic = boot_fun, R = 200)
# 
# 
# Bootstrap Statistics :
#     original  bias    std. error
# t1*        0       0           0
# t2*        0       0           0
# t3*        1       0           0
# t4*        1       0           0