Hierarchical/Nested 自举手段

Question

我正在尝试执行分层 bootstrapping 以从具有嵌套数据结构的大型数据集中获取一些样本均值。

我有一个类似于此的数据集：

ball <- c(1:13)
box <- c('1', '1', '1', '1', '2', '2', '2',
     '3', '3', '3', '3', '3', '3')
triangles <- c(1,0,1,3,1,1,2,2,0,1,1,0,4)
df <- data.frame(cbind(ball, box, triangles))
df
--
ball box triangles
   1   1         1
   2   1         0
   3   1         1
   4   1         3
   5   2         1
   6   2         1
   7   2         2
   8   3         2
   9   3         0
  10   3         1
  11   3         1
  12   3         0
  13   3         4

想法是三个盒子，每个盒子里都有一些球。每个球上都有许多三角形，因此它看起来像这样：

我的目标是使用 bootstrapping 来估计每个球上三角形的平均数量，同时控制球所在的盒子。

我希望模拟从盒子中放回抽样 10,000 次，每次随机抽取一个盒子，然后放回随机抽取球 n 次，其中 n 是盒子中球的数量（即如果盒子1 被选中，然后模拟将随机采样这四个球，四次，以任意数量的响应结束，例如球 1、球 1、球 3、球 4）。

我希望它计算它采样的球上三角形数量的平均值，存储该值，然后采样一个新框，从而重复该过程。

到目前为止，我已经尝试使用这样的 rsample 方法（here: 描述）：

#we need to sample groups aka boxes from 
#the dataframe so use list-columns in 
#tibbles
library(tidyverse)
library(tibble)
library(rsample)

Test <- df %>% nest(-box)
head(Test)

#now use bootstraps on this new tibble to 
#sample by ID
set.seed(002)
testbs <- bootstraps(Test, times = 10)
testbs

#let's look at one of the bootstrap 
#samples
as_tibble(testbs$splits[[1]]) %>% head()

#we can unnest the tibble and assess the 
#averages by box 
bs_avgtri<- map(testbs$splits, 
      ~as_tibble(.) %>% unnest() %>% 
                   group_by(box) %>% 
                   summarize(mean_tri = 
                   mean(triangles))) %>% 
                  bind_rows(.id = 'boots')
bs_avgtri

但是，由于我嵌套数据的方式，我认为这是有缺陷的。我得到的输出也没有意义，通常显示多个 bootstrap 级别。所以我倾向于认为它出错了，但我也不确定如何真正解析出不同功能在做什么。

我也知道我借鉴的方法并不真正适用于我正在做的事情，我正在尝试偷工减料，但我不认为它正在做我正在做的事情需要它做。

我能想到的唯一其他方法是编写几个嵌套的 for 循环，但我不擅长 R 中的 for 循环，而且我相当确定有更好的方法。

如果有人对此有任何见解，我将非常非常感谢！！！！

Answer 1

我不太了解rsample。

不过根据你的描述，我觉得基本功能sample就够了。

我写了一个简单的版本来实现平均值（基于我的理解）。看看是不是你想要的。

set.seed(100)

ball <- c(1:13)
box <- c('1', '1', '1', '1', '2', '2', '2',
         '3', '3', '3', '3', '3', '3')
triangles <- c(1,0,1,3,1,1,2,2,0,1,1,0,4)

names(ball) = box
names(triangles) = ball

sample_balls = function(input_ball){
  chosen_box = sample(names(input_ball), 1, replace = T)
  chosen_balls = ball[which(names(input_ball) == chosen_box)]
  sampled_balls = sample(chosen_balls, length(chosen_balls), replace = T)
  return(sampled_balls)
}

nTriangles = unlist(lapply(1:100, function(x){
  nTriangle = triangles[sample_balls(ball)]
}))

mean(nTriangles)
#> [1] 1.331237

Answer 2

tidyr::crossing 非常适合模拟。

library("tidyverse")

ball <- c(1:13)
box <- c('1', '1', '1', '1', '2', '2', '2',
         '3', '3', '3', '3', '3', '3')
triangles <- c(1,0,1,3,1,1,2,2,0,1,1,0,4)
df <- tibble(ball, box, triangles)

df %>%
  # How many times do you want to run the simulation?
  crossing(rep = seq(3)) %>%
  # Next describe the sampling.
  # For each simulation and for each box...
  group_by(rep, box) %>%
  # randomly sample n() balls with replacement,
  # where n() is the number of balls in the box.
  sample_n(n(), ball, replace = TRUE) %>%
  # Compute the mean number of triangles (for each replicate, for each box)
  summarise(triangles = mean(triangles))
#> # A tibble: 9 x 3
#> # Groups:   rep [3]
#>     rep box   triangles
#>   <int> <chr>     <dbl>
#> 1     1 1          1.5 
#> 2     1 2          1.67
#> 3     1 3          2   
#> 4     2 1          2   
#> 5     2 2          1.33
#> 6     2 3          1.33
#> 7     3 1          2   
#> 8     3 2          1.67
#> 9     3 3          1.5

^{由 reprex package (v0.2.1)}

于 2019-03-04 创建

Hierarchical/Nested 自举手段

Hierarchical/Nested Bootstrapping Means

r

for-loop

tidyverse

hierarchical-clustering

statistics-bootstrap