看起来主要的瓶颈是内部循环。我们可以通过替换以下内容使内部循环的速度提高20倍：

tictoc::tic()
for (s in boot_students) {
  student_data <- final %>% filter(student_id == s)
  x <- sample(nrow(student_data), 1)
  y <- sample(x:nrow(student_data), 1)
  student_data <- student_data[x:y, ]
  boot_data <- rbind(boot_data, student_data)
}
tictoc::toc()
# around 2.5s on my machine

字符串
与

tictoc::tic()
boot_data <- final %>%
    left_join(
      final %>%
        ungroup() %>%
        summarize(n = n(), .by = student_id) %>%
        rowwise() %>%
        mutate(x = sample(1:n, 1),
               y = sample(x:n, 1))
    ) %>%
    filter(flip_number >= x, flip_number <= y)
tictoc::toc()
# around 0.1s on my machine

型
你的原始循环包括一些低效的步骤：
1.为1000名学生中的每一个创建单独的final子集（我们可以跳过此操作）
1.为每个学生从x：n中随机选取开始（x）和结束（y）。（让我们做一次，成为vectorized）
1.对数据进行子集化（让我们只做一次，而不是1000x）
1.附加到以前的学生数据（如果我们从不按学生分开数据，我们可以跳过这一步）
更有效率的做法是一次对所有学生执行（2），然后跳过（3），跳过1+4。4是特别昂贵的，见第2章（“成长的对象”）的R地狱：https://www.burns-stat.com/pages/Tutor/R_inferno.pdf
我相信这可以进一步加快，但也许这进入了“目前足够快”的区域。

如果我们想在没有任何权重的情况下对每个student_id进行采样，我们可以通过分组而不是加入来接近它，类似于@JonSpring的精彩答案。对于我的计算机，data.table方法比下面的dplyr方法快3倍。

my_sample = function(data) {
  x = sample(nrow(data), 1L)
  y = sample(x:nrow(data), 1L)
  return(data[x:y,])
}

## dplyr
final %>%
  group_by(student_id) %>%
  group_modify(~(my_sample(.x)))

## data.table
library(data.table)
finalDT = as.data.table(ungroup(final))
finalDT[, my_sample(.SD), student_id]

字符串
如果我们想做一些类似于boot_students = sample(unique(final$student_id), replace = TRUE)的事情并循环遍历它们，那么data.table解决方案应该相对性能更好，因为我们可以预先设置一个键，然后循环遍历所有学生以进行过滤。

setkey(finalDT, student_id)
boot_students = sample(unique(final$student_id), replace = TRUE)

lapply(boot_students,
       function (student)  finalDT[student_id == student, my_sample(.SD)]) |>
  rbindlist()

型
对我来说，它比OP快20倍，并提供与原始内部循环相同的结果。如果我们放弃使用Rcpp，这种方法可以变得更高效，因为现在有一些方法可以在Rcpp中子集data.table，这应该更有效。但是...可能已经够快了）.
顺便说一句，我们可能可以使用table和潜在的prop.table()更有效地完成最后部分。

## from above
boot_data = lapply(boot_students,
       function (student)  finalDT[student_id == student, my_sample(.SD)]) %>%
  rbindlist()

## table and prop.table on separate lines so intermediate results can be seen
table(head(boot_data$coin_result, -1), tail(boot_data$coin_result, -1)) |>
  prop.table()

##              H         T
##    H 0.2820237 0.2035307
##    T 0.2035307 0.3109150

型
为了绘制图表，我们可以简单地用上面的例子之一替换OP的内部循环。或者，这可以是使用data.table和ggplot进行绘图的方法。这里不是geom_line()，它可能不是离散数据的最佳选择，而是geom_boxplot()，但可以更多地考虑如何将其可视化。

library(data.table)
library(ggplot2)

## initializing data.table 
finalDT = as.data.table(ungroup(final))
setkey(finalDT, student_id)

## helper methods to subset and then transform into prop.table
my_sample = function(data) {
  x = sample(nrow(data), 1L)
  y = sample(x:nrow(data), 1L)
  return(data[x:y,])
}

create_prop_table = function (x) {
  table(head(x, -1L), tail(x, -1L)) |>
    prop.table()
}

## subset up front for small optimization
unique_students = unique(finalDT[["student_id"]])

## lapply is just a loop
lapply(seq_len(n_boot), 
       function(iteration) {
         boot_students = sample(unique_students, replace = TRUE)
         finalDT[.(boot_students), my_sample(.SD), by = .EACHI
                 ][, as.data.table(create_prop_table(coin_result))
                   ][,c("iteration", "coin") := .(iteration, paste0("P(",V1, "|", V2, ")"))]
       }) |> 
  rbindlist() |> ## combine 100 simulations into one data.table
  ggplot(aes(x = coin, y = N, color = coin)) +
  geom_boxplot() +
  labs(x = "Coin", y = "Probability", color = "Coin") +
  scale_color_discrete(labels = c("P(H|H)", "P(T|H)", "P(H|T)", "P(T|T)")) +
  ggtitle(paste0("Randomized trials based on ", n_boot, " bootstrap simulations"))

型
x1c 0d1x的数据