如何以 10000 次重复优化 r 中的分层随机抽样
How optimize stratified random sampling in r with 10000 repetitions
我需要一个使用分层随机抽样的函数重复(10000次)从我的数据中抽样改变样本大小,计算每个样本大小的均值和标准差以及return变异系数。样本量范围为 3 到 30。
到目前为止我已经写了这个但是它太慢了。我需要帮助使其 运行 更快 因为我 运行 多次使用这部分代码。
数据框 dt1 有大约 900 个观察值
K_level 有 6 个级别
谢谢
samp <- function(nn){
dt1 <- as.data.table(dt1)
dt2 <- replicate(10000, dt1[, .SD[sample(x = .N, size = nn)], by = K_level],
simplify = FALSE) %>%
data.table::rbindlist() %>%
.[,.(avg=mean(Bunch_weight), Sd = sd(Bunch_weight)),.(Trt)] %>%
.[, cvs:= Sd/avg]
dt3 <- data.table::transpose(dt2)
colnames(dt3) <- as.character(dt3[1,])
dt4 <- dt3 %>% .[-c(1:3),] %>% .[, sample:= paste0(nn,"mts")]
return(dt4)
}
# use the function
zzz <- c(3:30)
dat5 <- map_df(.x = c(3:30), .f = samp)
my data
Block Trt Matno Cycle Date.harvested Girth0 Girth100 Hands Fingers Bunch_weight Variety K_level
1: B1 T2 6 1 2020-03-05 1 1 1 1 5 NFUUKA 0K
2: B1 T6 2 1 2020-03-05 2 2 2 1 9 KIBUZI 150K
3: B1 T6 3 1 2020-03-09 3 3 1 2 5 NFUUKA 150K
4: B1 T6 24 1 2020-02-28 4 4 2 1 9 KIBUZI 150K
5: B1 T6 29 1 2020-03-03 5 5 3 3 14 NFUUKA 150K
---
780: B3 T9 12 1 2020-05-22 4 4 4 4 8 NFUUKA 0K
781: B3 T10 10 1 2020-05-25 145 47 5 5 17 NFUUKA 0K
782: B3 T11 14 1 2020-05-16 27 88 4 4 13 MBWAZIRUME 75K
783: B3 T14 25 1 2020-05-24 39 119 4 3 14 KISANSA 150K
784: B3 T14 34 1 2020-05-17 27 28 5 3 15 NAKITEMBE 150K
expected output
T9 T1 T6 T14 T13 T7 T15
1: 0.359418301512993 0.259396490785659 0.352112606549899 0.270098407993612 0.33255344147661 0.246297750226982 0.290376334651094
2: 0.36336940312546 0.260242995748078 0.347937570013322 0.26993786977025 0.327215546595358 0.247590005787063 0.290659581719395
T8 T3 T4 T18 T17 T10 T11
1: 0.203153174250691 0.31104051648633 0.308308574237779 0.352809537743834 0.380933443587759 0.345214551318585 0.265386556956891
2: 0.20127162406244 0.311140161227165 0.303006865683816 0.350513136037457 0.37965782184899 0.342121680883066 0.26389652807615
T5 T12 T16 T2 Sample
1: 0.424907358546752 0.262966077905422 0.292193075443918 0.366954072154349 3mts
2: 0.413114236465515 0.264733595838422 0.296869773806402 0.36574334095091 4mts
这是您的代码,只是稍微改了一下。我认为它会产生相同的输出,但很难说清楚,因为随机性是以不同的顺序完成的,因此重置随机种子无济于事。它应该快得多(> 10 倍)。
samp2 <- function(nn){
dt1 <- as.data.table(dt1)
dt2 <- dt1[, .SD[as.vector(replicate(10000, sample(.N, nn)))], by = K_level,
.SDcols = c('Trt', 'Bunch_weight')][,
.(avg=mean(Bunch_weight), Sd = sd(Bunch_weight)), by = .(Trt)]
dt2[, cvs:= Sd/avg]
dt3 <- data.table::transpose(dt2)
colnames(dt3) <- as.character(dt3[1,])
dt4 <- dt3 %>% .[-c(1:3),] %>% .[, sample:= paste0(nn,"mts")]
return(dt4[])
}
我需要一个使用分层随机抽样的函数重复(10000次)从我的数据中抽样改变样本大小,计算每个样本大小的均值和标准差以及return变异系数。样本量范围为 3 到 30。 到目前为止我已经写了这个但是它太慢了。我需要帮助使其 运行 更快 因为我 运行 多次使用这部分代码。 数据框 dt1 有大约 900 个观察值 K_level 有 6 个级别
谢谢
samp <- function(nn){
dt1 <- as.data.table(dt1)
dt2 <- replicate(10000, dt1[, .SD[sample(x = .N, size = nn)], by = K_level],
simplify = FALSE) %>%
data.table::rbindlist() %>%
.[,.(avg=mean(Bunch_weight), Sd = sd(Bunch_weight)),.(Trt)] %>%
.[, cvs:= Sd/avg]
dt3 <- data.table::transpose(dt2)
colnames(dt3) <- as.character(dt3[1,])
dt4 <- dt3 %>% .[-c(1:3),] %>% .[, sample:= paste0(nn,"mts")]
return(dt4)
}
# use the function
zzz <- c(3:30)
dat5 <- map_df(.x = c(3:30), .f = samp)
my data
Block Trt Matno Cycle Date.harvested Girth0 Girth100 Hands Fingers Bunch_weight Variety K_level
1: B1 T2 6 1 2020-03-05 1 1 1 1 5 NFUUKA 0K
2: B1 T6 2 1 2020-03-05 2 2 2 1 9 KIBUZI 150K
3: B1 T6 3 1 2020-03-09 3 3 1 2 5 NFUUKA 150K
4: B1 T6 24 1 2020-02-28 4 4 2 1 9 KIBUZI 150K
5: B1 T6 29 1 2020-03-03 5 5 3 3 14 NFUUKA 150K
---
780: B3 T9 12 1 2020-05-22 4 4 4 4 8 NFUUKA 0K
781: B3 T10 10 1 2020-05-25 145 47 5 5 17 NFUUKA 0K
782: B3 T11 14 1 2020-05-16 27 88 4 4 13 MBWAZIRUME 75K
783: B3 T14 25 1 2020-05-24 39 119 4 3 14 KISANSA 150K
784: B3 T14 34 1 2020-05-17 27 28 5 3 15 NAKITEMBE 150K
expected output
T9 T1 T6 T14 T13 T7 T15
1: 0.359418301512993 0.259396490785659 0.352112606549899 0.270098407993612 0.33255344147661 0.246297750226982 0.290376334651094
2: 0.36336940312546 0.260242995748078 0.347937570013322 0.26993786977025 0.327215546595358 0.247590005787063 0.290659581719395
T8 T3 T4 T18 T17 T10 T11
1: 0.203153174250691 0.31104051648633 0.308308574237779 0.352809537743834 0.380933443587759 0.345214551318585 0.265386556956891
2: 0.20127162406244 0.311140161227165 0.303006865683816 0.350513136037457 0.37965782184899 0.342121680883066 0.26389652807615
T5 T12 T16 T2 Sample
1: 0.424907358546752 0.262966077905422 0.292193075443918 0.366954072154349 3mts
2: 0.413114236465515 0.264733595838422 0.296869773806402 0.36574334095091 4mts
这是您的代码,只是稍微改了一下。我认为它会产生相同的输出,但很难说清楚,因为随机性是以不同的顺序完成的,因此重置随机种子无济于事。它应该快得多(> 10 倍)。
samp2 <- function(nn){
dt1 <- as.data.table(dt1)
dt2 <- dt1[, .SD[as.vector(replicate(10000, sample(.N, nn)))], by = K_level,
.SDcols = c('Trt', 'Bunch_weight')][,
.(avg=mean(Bunch_weight), Sd = sd(Bunch_weight)), by = .(Trt)]
dt2[, cvs:= Sd/avg]
dt3 <- data.table::transpose(dt2)
colnames(dt3) <- as.character(dt3[1,])
dt4 <- dt3 %>% .[-c(1:3),] %>% .[, sample:= paste0(nn,"mts")]
return(dt4[])
}