R中嵌套大列表的高效摘要统计

R中嵌套大列表的高效摘要统计,r,dataframe,data.table,aggregate,lapply,R,Dataframe,Data.table,Aggregate,Lapply,我正在运行模拟研究,其中我的结果存储在嵌套列表结构中。列表的第一级表示模型生成的不同超参数。第二个级别是同一模型的复制次数(更改种子) 在下面的示例中,我列出了由两个超参数(hyperpar1和hyperpar2)控制的模型的输出,其中两个超参数都可以取2个不同的值,从而导致结果模型的4个不同组合。此外,4种可能的组合中的每一种都运行了两次(不同的种子),从而产生了8种可能的组合(如下所示,使用str(res,max=2))。最后,从模型的每个可能迭代中恢复两个性能指标(metric1和metr

我正在运行模拟研究,其中我的结果存储在嵌套列表结构中。列表的第一级表示模型生成的不同超参数。第二个级别是同一模型的复制次数(更改种子)

在下面的示例中,我列出了由两个超参数(
hyperpar1
hyperpar2
)控制的模型的输出,其中两个超参数都可以取2个不同的值,从而导致结果模型的4个不同组合。此外,4种可能的组合中的每一种都运行了两次(不同的种子),从而产生了8种可能的组合(如下所示,使用
str(res,max=2)
)。最后,从模型的每个可能迭代中恢复两个性能指标(
metric1
metric2

我的问题是,在我的实际数据中,迭代次数(列表的第二级)是巨大的(多达10000次),并且在某些情况下,超参数数量的完整阶乘多达2000次。因此,取消上市的过程变得相当缓慢

下面我列出了我当前的程序和我想要的输出,但同样,它相对较慢。特别是,有一部分我取消了所有内容的列表,并将其放在一个大数据框架中,时间太长了,但我没有更快地解决这个问题

res <-list(
  list(list(modeltype = "tree", time_iter = structure(0.7099, class = "difftime", units = "secs"),seed = 1, nobs = 75, hyperpar1 = 0.5, hyperpar2 = 0.5, metric1 = 0.4847, metric2 = 0.2576 ),
       list(modeltype = "tree", time_iter = structure(0.058 , class = "difftime", units = "secs"),seed = 2, nobs = 75, hyperpar1 = 0.5, hyperpar2 = 0.5, metric1 = 0.4013, metric2 = 0.2569 )), 
  list(list(modeltype = "tree", time_iter = structure(0.046 , class = "difftime", units = "secs"),seed = 1, nobs = 75, hyperpar1 = 0.8, hyperpar2 = 0.5, metric1 = 0.4755, metric2 = 0.2988 ), 
       list(modeltype = "tree", time_iter = structure(0.0474, class = "difftime", units = "secs"),seed = 2, nobs = 75, hyperpar1 = 0.8, hyperpar2 = 0.5, metric1 = 0.2413, metric2 = 0.2147 )), 
  list(list(modeltype = "tree", time_iter = structure(0.0502, class = "difftime", units = "secs"),seed = 1, nobs = 75, hyperpar1 = 0.5, hyperpar2 = 1  , metric1 = 0.7131, metric2 = 0.5024 ), 
       list(modeltype = "tree", time_iter = structure(2.9419, class = "difftime", units = "secs"),seed = 2, nobs = 75, hyperpar1 = 0.5, hyperpar2 = 1  , metric1 = 0.4254, metric2 = 0.2824 )), 
  list(list(modeltype = "tree", time_iter = structure(0.041 , class = "difftime", units = "secs"),seed = 1, nobs = 75, hyperpar1 = 0.8, hyperpar2 = 1  , metric1 = 0.6709, metric2 = 0.4092 ), 
       list(modeltype = "tree", time_iter = structure(0.0396, class = "difftime", units = "secs"),seed = 2, nobs = 75, hyperpar1 = 0.8, hyperpar2 = 1  , metric1 = 0.4585, metric2 = 0.4115 )))


hyperpar1   <-   c(0.5 , 0.8 ) 
hyperpar2   <-   c(0.5 , 1   )
expand.grid(hyperpar1 = hyperpar1, hyperpar2 = hyperpar2)

#   hyperpar1 hyperpar2
# 1       0.5       0.5
# 2       0.8       0.5
# 3       0.5       1.0
# 4       0.8       1.0

#List structure:
#The 4 elements represent the 4 combinations of the hyperparams
#Inside each of the 4 combinations of the hyperparams, 2 lists represent the 2 simulations (with different seeds)
str(res, max = 1)
#Finally, inside each of the final level (level=3) there is a list of 10 objects that are the results of each simulation
str(res, max = 2)

# List of 4
# $ :List of 2
# ..$ :List of 8
# ..$ :List of 8
# $ :List of 2
# ..$ :List of 8
# ..$ :List of 8
# $ :List of 2
# ..$ :List of 8
# ..$ :List of 8
# $ :List of 2
# ..$ :List of 8
# ..$ :List of 8

#e.g Fist iteration of first model 
t(res[[1]][[1]])
# modeltype time_iter seed nobs hyperpar1 hyperpar2 metric1 metric2
# [1,] "tree"    0.7099    1    75   0.5       0.5       0.4847  0.2576 


最后是期望的输出。
您可以尝试
数据。表

库(data.table)
tmp=数据表(res)
tmp=tmp[,t(res[1]),by=1:nrow(tmp)]
tmp=tmp[,V1[[1]],by=1:nrow(tmp)]
g=功能(x)列表(平均值=平均值(x),标准差=标准差(x))
tmp[,未列出(lappy(.SD,g),递归=FALSE)
,.SDcols=hyperpar1:metric2,
,by=(nobs,hyperpar1,hyperpar2,modeltype)]
#>nobs hyperpar1 hyperpar2模型类型hyperpar1.mean hyperpar1.sd
#>1:75 0.50.5树0.50
#>2:75 0.80.5树0.80
#>3:75 0.51.0树0.50
#>4:75 0.81.0树0.80
#>hyperpar2.mean hyperpar2.sd metric1.mean metric1.sd metric2.mean
#> 1:            0.5            0      0.44300 0.05897271      0.25725
#> 2:            0.5            0      0.35840 0.16560441      0.25675
#> 3:            1.0            0      0.56925 0.20343462      0.39240
#> 4:            1.0            0      0.56470 0.15018948      0.41035
#>metric2.sd
#> 1: 0.0004949747
#> 2: 0.0594676803
#> 3: 0.1555634919
#> 4: 0.0016263456

此代码使用连续取消列表列的测试,这是我在本笔记本中描述的一种策略:

您可以尝试
数据。表

库(data.table)
tmp=数据表(res)
tmp=tmp[,t(res[1]),by=1:nrow(tmp)]
tmp=tmp[,V1[[1]],by=1:nrow(tmp)]
g=功能(x)列表(平均值=平均值(x),标准差=标准差(x))
tmp[,未列出(lappy(.SD,g),递归=FALSE)
,.SDcols=hyperpar1:metric2,
,by=(nobs,hyperpar1,hyperpar2,modeltype)]
#>nobs hyperpar1 hyperpar2模型类型hyperpar1.mean hyperpar1.sd
#>1:75 0.50.5树0.50
#>2:75 0.80.5树0.80
#>3:75 0.51.0树0.50
#>4:75 0.81.0树0.80
#>hyperpar2.mean hyperpar2.sd metric1.mean metric1.sd metric2.mean
#> 1:            0.5            0      0.44300 0.05897271      0.25725
#> 2:            0.5            0      0.35840 0.16560441      0.25675
#> 3:            1.0            0      0.56925 0.20343462      0.39240
#> 4:            1.0            0      0.56470 0.15018948      0.41035
#>metric2.sd
#> 1: 0.0004949747
#> 2: 0.0594676803
#> 3: 0.1555634919
#> 4: 0.0016263456

这段代码使用列表列的连续取消测试,这是我在本笔记本中描述的一种策略:

使用
dplyr::bind_rows()
,嵌套列表直接取消作为data.frame的测试,之后可以直接计算摘要统计信息:

library(dplyr)

bind_rows(res) %>%
  group_by(modeltype, nobs, hyperpar1, hyperpar2) %>%
  summarize(across(everything(), list(mean = mean, sd = sd)), .groups = "drop")

#> # A tibble: 4 x 12
#>   modeltype  nobs hyperpar1 hyperpar2 time_iter_mean time_iter_sd seed_mean
#>   <chr>     <dbl>     <dbl>     <dbl> <drtn>                <dbl>     <dbl>
#> 1 tree         75       0.5       0.5 0.38395 secs       0.461          1.5
#> 2 tree         75       0.5       1   1.49605 secs       2.04           1.5
#> 3 tree         75       0.8       0.5 0.04670 secs       0.000990       1.5
#> 4 tree         75       0.8       1   0.04030 secs       0.000990       1.5
#> # … with 5 more variables: seed_sd <dbl>, metric1_mean <dbl>, metric1_sd <dbl>,
#> #   metric2_mean <dbl>, metric2_sd <dbl>
库(dplyr)
绑定_行(res)%>%
分组依据(型号、nobs、hyperpar1、hyperpar2)%>%
汇总(跨越(所有内容(),列表(平均值=平均值,标准差=标准差)),.groups=“drop”)
#>#tibble:4 x 12
#>型号nobs hyperpar1 hyperpar2时间平均时间sd种子平均
#>                                        
#>1树75 0.5 0.5 0.38395秒0.461 1.5
#>2树75 0.5 1 1.49605秒2.04 1.5
#>3树75 0.8 0.5 0.04670秒0.000990 1.5
#>4树75 0.8 1 0.04030秒0.000990 1.5
#>#…还有5个变量:seed_sd、metric1_mean、metric1_sd、,
#>#metric2_平均值,metric2_标准差

使用
dplyr::bind_rows()
,嵌套列表直接不列为data.frame,之后可以直接计算摘要统计信息:

library(dplyr)

bind_rows(res) %>%
  group_by(modeltype, nobs, hyperpar1, hyperpar2) %>%
  summarize(across(everything(), list(mean = mean, sd = sd)), .groups = "drop")

#> # A tibble: 4 x 12
#>   modeltype  nobs hyperpar1 hyperpar2 time_iter_mean time_iter_sd seed_mean
#>   <chr>     <dbl>     <dbl>     <dbl> <drtn>                <dbl>     <dbl>
#> 1 tree         75       0.5       0.5 0.38395 secs       0.461          1.5
#> 2 tree         75       0.5       1   1.49605 secs       2.04           1.5
#> 3 tree         75       0.8       0.5 0.04670 secs       0.000990       1.5
#> 4 tree         75       0.8       1   0.04030 secs       0.000990       1.5
#> # … with 5 more variables: seed_sd <dbl>, metric1_mean <dbl>, metric1_sd <dbl>,
#> #   metric2_mean <dbl>, metric2_sd <dbl>
库(dplyr)
绑定_行(res)%>%
分组依据(型号、nobs、hyperpar1、hyperpar2)%>%
汇总(跨越(所有内容(),列表(平均值=平均值,标准差=标准差)),.groups=“drop”)
#>#tibble:4 x 12
#>型号nobs hyperpar1 hyperpar2时间平均时间sd种子平均
#>                                        
#>1树75 0.5 0.5 0.38395秒0.461 1.5
#>2树75 0.5 1 1.49605秒2.04 1.5
#>3树75 0.8 0.5 0.04670秒0.000990 1.5
#>4树75 0.8 1 0.04030秒0.000990 1.5
#>#…还有5个变量:seed_sd、metric1_mean、metric1_sd、,
#>#metric2_平均值,metric2_标准差

我想说,如果数据真的很大,
base R
中的
aggregate
会很慢。使用
data.table
tidyverse
(如果包装正常)I
# nobs hyperpar1 hyperpar2 modeltype time_iter_mean metric1_mean metric2_mean time_iter_sd metric1_sd   metric2_sd
# 1   75       0.5       0.5      tree   0.38395 secs      0.44300      0.25725 0.4609629107 0.05897271 0.0004949747
# 2   75       0.5       1.0      tree   1.49605 secs      0.56925      0.39240 2.0447406792 0.20343462 0.1555634919
# 3   75       0.8       0.5      tree   0.04670 secs      0.35840      0.25675 0.0009899495 0.16560441 0.0594676803
# 4   75       0.8       1.0      tree   0.04030 secs      0.56470      0.41035 0.0009899495 0.15018948 0.0016263456
library(dplyr)

bind_rows(res) %>%
  group_by(modeltype, nobs, hyperpar1, hyperpar2) %>%
  summarize(across(everything(), list(mean = mean, sd = sd)), .groups = "drop")

#> # A tibble: 4 x 12
#>   modeltype  nobs hyperpar1 hyperpar2 time_iter_mean time_iter_sd seed_mean
#>   <chr>     <dbl>     <dbl>     <dbl> <drtn>                <dbl>     <dbl>
#> 1 tree         75       0.5       0.5 0.38395 secs       0.461          1.5
#> 2 tree         75       0.5       1   1.49605 secs       2.04           1.5
#> 3 tree         75       0.8       0.5 0.04670 secs       0.000990       1.5
#> 4 tree         75       0.8       1   0.04030 secs       0.000990       1.5
#> # … with 5 more variables: seed_sd <dbl>, metric1_mean <dbl>, metric1_sd <dbl>,
#> #   metric2_mean <dbl>, metric2_sd <dbl>