繁体   English   中英

在 R 中引导一个简单的 function

[英]Bootstrapping a simple function in R

我有一个名为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)

实际上,您可以使用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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM