Иерархические / вложенные средства начальной загрузки

Question

Я пытаюсь выполнить иерархическую загрузку, чтобы получить некоторые примерные средства из большого набора данных с вложенной структурой данных.

У меня есть набор данных, аналогичный этому:

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

И идея состоит в том, что есть три коробки, каждая с количеством шаров в них.На каждом шаре есть несколько треугольников, так что он выглядит примерно так:

Моя цель здесь - с помощью начальной загрузки оценить среднее количество треугольников на каждоммяч, контролируя, в каком ящике находится шарик.

Я хочу, чтобы симуляция производила выборку с заменами 10 000 раз из ящиков, каждый раз случайным образом вытаскивая ящик, а затем случайным образом отбирая шарики n раз с заменой, гдеn - количество шаров в коробке (т. е. если выбрана коробка 1, то симуляция случайным образом выберет эти четыре шара четыре раза, получая любое количество ответов, например, шар 1, шар 1, шар 3, шар4).

Я хочу, чтобы он затем вычислил среднее число треугольников на выбранных шариках, сохранил это значение и затем сэмплировал новый прямоугольник, повторив таким образом процесс.

До сих пор я пытался использовать метод rsample (описанный здесь: https://www.r -bloggers.com / bootstrapping-clustertered-data / ) примерно так:

#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

Однако, я думаю, что это неправильно из-за того, как я вкладываю данные.Кроме того, результаты, которые я получаю, не имеют смысла, часто отображая несколько уровней начальной загрузки.Поэтому я склонен думать, что все идет не так, но я также не уверен, как на самом деле разобраться в том, что делают разные функции.

Я также знаю, что подход, который я заимствую, на самом деле не предназначен для того, что я делаю, я пытаюсь придумать способ сделать это, и я не думаю, что это делает то, что я делаюМне нужно это сделать.

Единственный другой способ, которым я могу подумать, это написать пару вложенных в циклы, но я не силен с циклами for в R, и я уверен, что есть лучшеепуть.

Если у кого-нибудь есть понимание этого, я был бы очень очень благодарен !!!!

Answer 1

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

^{Создано в 2019-03-04 пакетом Представить (v0.2.1)}

Answer 2

Я не знаю много о 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