1

I am running a simulation study where my results are stored in a nested list structure. The first level of the list represents the different hyperparameters generated by the model. The second level is the number of replications of the same model (changing the seed).

In the example below, I list the output of a model that is governed by two hyperparameters (hyperpar1 and hyperpar2) where both can take 2 different values, leading to 4 different combinations of the resulting model. Additionally, each of the 4 possible combinations was run twice (different seeds), leading to eight possible combinations (as can be seen below with str(res, max = 2)). Finally, two performance metrics were recovered from each possible iteration of the models (metric1 and metric2).

My problem is that in my real data, the number of iterations (second level of the list) is huge (up to 10000), and the full factorial of the number of hyperparameters is up to 2000 in some cases. Therefore the unlisting process becomes rather slow.

Below I list my current procedure with my desired output, but again, it is relatively slow. In particular, there is one part when I unlist everything, and I put it together in one big data.frame that takes way too long, but I haven't solved this in a faster way.

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

Parsing the list

In the following code, I unnest the list and put everything into a data.frame.

#Unlist the nested structure of the list `res`
all_in_list <- lapply(1:length(res), function(i) {
     unlisting <- unlist(res[i],recursive = FALSE)
     to_df <- do.call(rbind, lapply(unlisting, as.data.frame))
     return(to_df)})

#Here is where averything get really really slow when the list is huge
all_in_df <- do.call(rbind, lapply(all_in_list, as.data.frame))

#   modeltype   time_iter seed nobs hyperpar1 hyperpar2 metric1 metric2
# 1      tree 0.7099 secs    1   75       0.5       0.5  0.4847  0.2576
# 2      tree 0.0580 secs    2   75       0.5       0.5  0.4013  0.2569
# 3      tree 0.0460 secs    1   75       0.8       0.5  0.4755  0.2988
# 4      tree 0.0474 secs    2   75       0.8       0.5  0.2413  0.2147
# 5      tree 0.0502 secs    1   75       0.5       1.0  0.7131  0.5024
# 6      tree 2.9419 secs    2   75       0.5       1.0  0.4254  0.2824
# 7      tree 0.0410 secs    1   75       0.8       1.0  0.6709  0.4092
# 8      tree 0.0396 secs    2   75       0.8       1.0  0.4585  0.4115

Summary statistics of the output

In the following, I recovered the mean and the standard deviation of the performance metrics adding their subfix to each colname to identify it later (graphing purposes).

#auxiliar function to compute the metrics at aggregate level. 
foo_summary <- function(df ,
                        metrics =c("time_iter","metric1", "metric2") ,
                        by = c("nobs","hyperpar1", "hyperpar2", "modeltype"),
                        summary_function =  mean)
{
#compute the aggregate metrics  
out <-  as.data.frame(aggregate(
    x = df[metrics],
    by = df[by],
    FUN = summary_function, 
    na.rm = TRUE))
#rename conviniently the metric computed
oldnames <- colnames(out[metrics])
names(out)[match(oldnames,names(out))] <- paste(colnames(out[metrics]), 
                                                as.character(substitute(summary_function)),
                                                sep = "_")
return(out)
}



df_mean <- foo_summary(df = all_in_df, 
            metrics =c("time_iter","metric1", "metric2"),
            by = c("nobs","hyperpar1", "hyperpar2", "modeltype"),
            summary_function =  mean)


df_sd <- foo_summary(df = all_in_df, 
            metrics =c("time_iter","metric1", "metric2"),
            by = c("nobs","hyperpar1", "hyperpar2", "modeltype"),
            summary_function =  sd)

final_df <- merge(df_mean,df_sd )

Finally, the desired output.

# 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
Álvaro A. Gutiérrez-Vargas
  • 1,896
  • 2
  • 8
  • 24
  • 1
    I would say `aggregate` from `base R` would be slow if the data is really big. Use either `data.table` or `tidyverse` (if packages are okay) – akrun Dec 14 '20 at 19:50

2 Answers2

2

You could try data.table:

library(data.table)

tmp = data.table(res)
tmp = tmp[, t(res[1]), by=1:nrow(tmp)]
tmp = tmp[, V1[[1]], by=1:nrow(tmp)]


g = function(x) list(mean = mean(x), sd = sd(x))
tmp[, unlist(lapply(.SD, g), recursive=FALSE)
    , .SDcols=hyperpar1:metric2,
    , by=.(nobs, hyperpar1, hyperpar2, modeltype)]

#>    nobs hyperpar1 hyperpar2 modeltype hyperpar1.mean hyperpar1.sd
#> 1:   75       0.5       0.5      tree            0.5            0
#> 2:   75       0.8       0.5      tree            0.8            0
#> 3:   75       0.5       1.0      tree            0.5            0
#> 4:   75       0.8       1.0      tree            0.8            0
#>    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

This code uses successive unnesting of list-columns, a strategy which I have described in this notebook: http://arelbundock.com/posts/datatable_nesting/

Vincent
  • 15,809
  • 7
  • 37
  • 39
  • 1
    Wow, this is brilliant and ridiculously elegant. It took me some time to understand the `data.table` syntax but definitely worth it. One small question, unfortunately, in my first iteration `V1[[1]]`, I have a `NULL` because that some metrics cannot be computed to all the models. I fix the error using the following [answer on SO](https://stackoverflow.com/questions/58965541/when-using-data-tables-dt-i-j-by-is-it-possible-to-set-the-column-types). Would you recommend this approach or something else? Thx you a lot! – Álvaro A. Gutiérrez-Vargas Dec 15 '20 at 16:00
  • 1
    This approach seems quite reasonable to me. You'll probably get a performance hit, but it's hard to avoid that if you need to check individual values for NULL. Good luck! – Vincent Dec 15 '20 at 16:29
1

Using dplyr::bind_rows(), the nested list is directly unnested as a data.frame after which it is straightforward to calculate the summary statistics:

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>
Joris C.
  • 5,721
  • 3
  • 12
  • 27
  • Hi, @Joris, thank you for your answer. Unfortunately, I am getting the following error after running it ``Error: Internal error in `vec_proxy_assign_opts()`: `proxy` of type `double` incompatible with `value` proxy of type `NULL``. Could you please indicate to me your `dplyr` version? – Álvaro A. Gutiérrez-Vargas Dec 16 '20 at 13:52
  • it was suggested the following: ``Run `rlang::last_error()` to see where the error occurred`` and after doing it the following was printed on the console: ``Internal error in `vec_proxy_assign_opts()`: `proxy` of type `double` incompatible with `value` proxy of type `NULL`. Backtrace: 1. base::source("~/.active-rstudio-document", echo = TRUE) 8. dplyr::bind_rows(res) 9. vctrs::vec_rbind(!!!dots, .names_to = .id)`` – Álvaro A. Gutiérrez-Vargas Dec 16 '20 at 13:55