运行 for循环x次分析

Question

我有以下代码选择 4 行虹膜 1000x，并取每 4 行样本的平均值：

library(dplyr)

iris<- iris

storage<- list()


counter<- 0
for (i in 1:1000) {
  # sample 3 randomly selected transects 100 time
  tempsample<- iris[sample(1:nrow(iris), 4, replace=F),]

  storage[[i]]=tempsample

  
  counter<- counter+1
  print(counter)
}

# Unpack results into dataframe 
results<- do.call(rbind, storage)
View(results)

results_2<- as.data.frame(results)
results_2<- results_2 %>% mutate(Aggregate = rep(seq(1,ceiling(nrow(results_2)/4)),each = 4))
# View(results_2)


final_results<- aggregate(results_2[,1:4], list(results_2$Aggregate), mean)
# View(final_results)

我想计算每列与其真实总体参数相关的偏差。例如使用 SimDesign 的 bias():

library(SimDesign)
(bias(final_results[,2:5], parameter=c(5,3,2,1), type='relative'))*100

在这段代码中，参数的值是假设的真实弹出。数据框中每一列的值。我想执行此过程 100 次以获得数据框中每个变量的偏差估计分布。但是，我不确定如何将所有这些放入 for 循环中（我认为应该这样做）所以最终输出是一个数据帧，每个 iris 变量都有 100 行偏差测量值。

如有任何帮助，我们将不胜感激。

#-----------------------------

更新

尝试运行分层样本而不是随机样本的相同代码会给我以下错误：*[.data.table(setDT(copy(iris))，as.vector（应用（1:1000，函数（X）分层（虹膜，： i 是无效类型（矩阵）。也许将来一个 2 列矩阵可以 return DT 的元素列表 * 我认为这可能与 setDT 有关？

这是以下代码的结果：

do.call(rbind,lapply(1:100, function(x) {
  bias(
    setDT(copy(iris))[as.vector(sapply(1:1000, function(X) stratified(iris,group="Species", size=1)))][
      , lapply(.SD, mean), by=rep(c(1:1000),4), .SDcols=c(1:4)][,c(2:5)],
    parameter=c(5,3,2,1), 
    type='relative'
  )
}))

我研究了使用建议的以下代码：

get_samples <- function(n, sampsize=4) {
  rbindlist(lapply(1:n, function(x) { 
    splitstackshape::stratified(iris, group="Species",sampsize)[, id:=x]   }))[
      , lapply(.SD, mean), by=.(Species, id)] }

我想我明白这个函数在做什么（选择 4 行鸢尾分层，按物种取每一列的平均值），但我不确定如何将它应用于最初的问题（ 4*1000)*100 来测试偏差（我对此很陌生，如果我遗漏了一些明显的东西，我深表歉意）。

Answer 1

这是一种方法。我对您的代码做了一些小改动，并将其包装在一个函数中。然后，在一个序列上使用 lapply，比如 1:10 或 1:100，每次运行你的函数，并将结果从 SimDesign包。然后行绑定结果列表

library(dplyr)

get_samples <- function(df, size=4, n=1000) {

  storage<- list()
  counter<- 0
  
  for (i in 1:1000) {
    tempsample<- df[sample(1:nrow(df), size, replace=F),]
    storage[[i]]=tempsample
    counter<- counter+1
  }
  
  results<- do.call(rbind, storage)
  results_2<- as.data.frame(results)
  results_2<- results_2 %>% mutate(Aggregate = rep(seq(1,ceiling(nrow(results_2)/size)),each = size))
  final_results<- aggregate(results_2[,1:size], list(results_2$Aggregate), mean)
  return(final_results)
}


iris=iris

replicates = lapply(1:10, function(x) {
  result = get_samples(iris)
  (bias(result[,2:5], parameter=c(5,3,2,1), type='relative'))*100
})

replicates = do.call(rbind, replicates)

输出：

      Sepal.Length Sepal.Width Petal.Length Petal.Width
 [1,]     41.50617    3.292500     86.77408    8.859333
 [2,]     43.26058    2.763500     90.20758   10.825917
 [3,]     43.46642    3.551750     90.11767   10.576250
 [4,]     41.94683    2.970833     86.89625    8.817000
 [5,]     42.08733    3.380917     86.78642    8.996667
 [6,]     42.13050    2.942250     88.02983    9.707500
 [7,]     43.07383    2.775500     89.04583   10.102083
 [8,]     44.10192    2.895167     91.27208   11.188500
 [9,]     41.29408    2.314750     87.59208    9.244333
[10,]     42.77450    2.781583     90.37342   10.789500

快速解决问题

library(SimDesign)
library(data.table)

do.call(rbind,lapply(1:100, function(x) {
  bias(
    setDT(copy(iris))[as.vector(sapply(1:1000, function(X) sample(1:nrow(iris),4)))][
      , lapply(.SD, mean), by=rep(c(1:1000),4), .SDcols=c(1:4)][,c(2:5)],
    parameter=c(5,3,2,1), 
    type='relative'
  )
}))

Answer 2

由于您正在使用 mutate，您可以考虑继续使用 tidyverse。

map_df(1:1000, ~ sample_n(iris, 4, replace = FALSE)) %>%
glimpse() %>%
mutate(Aggregate_col = rep(seq(1, ceiling(n() / 4)), each = 4)) %>%
glimpse() %>%
select(starts_with("Sepal"),
       starts_with("Petal"),
       matches("Aggregate")) %>%
group_by(Aggregate_col) %>%
summarise(across(.cols = everything(), ~ mean(.x, na.rm = TRUE)))

备注：

在下面的示例中，您的第一个循环被替换为：
```
map_df(1:1000, ~ sample_n(iris, 4, replace = FALSE))
```
map_x 可用于迭代列表，或者在本例中为整数向量 1:1000，如果唯一的目的是重复调用函数，并且绑定结果转换为所需的格式，在本例中为 data.frame.
您可以在数据转换管道中利用 glimpse 来避免重复调用 View
select 提供了一种按名称或部分匹配选择列的可读方式。这通常比在 adding/removing 变量
时按索引选择列更安全

运行 for循环x次分析

Running analysis on for loop x times

for-loop

r

simulate

lapply

iris-dataset

快速解决问题