R: flatten inner part of a list of lists while keeping its structure

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) and also the value of the two parameters of the model beta = list(b1 = value, b2 = value).

My problem is related to the last part. I want to flatten the list beta and get each component inside of the list as a component of the upper list that contains it, but keeping the whole structure described in the beginning unchanged.

Below an example:

Sample of the data.

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, beta = list(b1 = 0.575, b2 =0.745)),     
       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, beta = list(b1 = 0.535, b2 =0.775))), 
  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, beta = list(b1 = 0.541, b2 =0.702) ), 
       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, beta = list(b1 = 0.545, b2 =0.793) )), 
  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, beta = list(b1 = 0.500, b2 =0.722) ), 
       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, beta = list(b1 = 0.555, b2 =0.712) )), 
  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, beta = list(b1 = 0.578, b2 =0.701) ), 
       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, beta = list(b1 = 0.501, b2 =0.777) )))

Illustration of the obtained output.

str(res[[1]][[1]], max = 3)
# List of 9
# $ modeltype: chr "tree"
# $ time_iter: 'difftime' num 0.7099
# ..- attr(*, "units")= chr "secs"
# $ seed     : num 1
# $ nobs     : num 75
# $ hyperpar1: num 0.5
# $ hyperpar2: num 0.5
# $ metric1  : num 0.485
# $ metric2  : num 0.258
# $ beta     :List of 2  #### <----- ( here is what I want to flatten/unlist ) 
# ..$ b1: num 0.575 
# ..$ b2: num 0.745

Desired output (betas flattened)

str(res[[1]][[1]], max = 3)
# List of 9
# $ modeltype: chr "tree"
# $ time_iter: 'difftime' num 0.7099
# ..- attr(*, "units")= chr "secs"
# $ seed     : num 1
# $ nobs     : num 75
# $ hyperpar1: num 0.5
# $ hyperpar2: num 0.5
# $ metric1  : num 0.485
# $ metric2  : num 0.258
# $ b1: num 0.575 #### <----- ( here is new  because  ) 
# $ b2: num 0.745 #### <----- ( this part is flat now! )

PS: as a side note, the simulation takes a couple of days to complete, and not all the time the number of parameters is constant across the models; this is why I want to flatten the list beta no matter what it is inside of it. Packaged solutions are welcome (e,g,.data.table or dplyr). Thanks.

Upvotes: 1

Views: 125

Answers (2)

Ferroao
Ferroao

Reputation: 3033

This works

res2 <- map_depth(res, 2, ~ list_flatten(., name_spec = "{inner}"))

str(res2)
List of 4
 $ :List of 2
  ..$ :List of 10
  .. ..$ modeltype: chr "tree"
  .. ..$ time_iter: 'difftime' num 0.7099
  .. .. ..- attr(*, "units")= chr "secs"
  .. ..$ seed     : num 1
  .. ..$ nobs     : num 75
  .. ..$ hyperpar1: num 0.5
  .. ..$ hyperpar2: num 0.5
  .. ..$ metric1  : num 0.485
  .. ..$ metric2  : num 0.258
  .. ..$ b1       : num 0.575
  .. ..$ b2       : num 0.745

Upvotes: 1

TimTeaFan
TimTeaFan

Reputation: 18541

I'm not sure if this will work for the real data, but it seems to produce the desire for the example data above.

map_depth(res, 2, flatten)

Here is the full output with str:

library(purrr)

map_depth(res, 2, flatten) %>% str

#> List of 4
#>  $ :List of 2
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: num 0.71
#>   .. ..$ seed     : num 1
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.5
#>   .. ..$ hyperpar2: num 0.5
#>   .. ..$ metric1  : num 0.485
#>   .. ..$ metric2  : num 0.258
#>   .. ..$ b1       : num 0.575
#>   .. ..$ b2       : num 0.745
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: num 0.058
#>   .. ..$ seed     : num 2
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.5
#>   .. ..$ hyperpar2: num 0.5
#>   .. ..$ metric1  : num 0.401
#>   .. ..$ metric2  : num 0.257
#>   .. ..$ b1       : num 0.535
#>   .. ..$ b2       : num 0.775
#>  $ :List of 2
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: num 0.046
#>   .. ..$ seed     : num 1
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.8
#>   .. ..$ hyperpar2: num 0.5
#>   .. ..$ metric1  : num 0.475
#>   .. ..$ metric2  : num 0.299
#>   .. ..$ b1       : num 0.541
#>   .. ..$ b2       : num 0.702
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: num 0.0474
#>   .. ..$ seed     : num 2
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.8
#>   .. ..$ hyperpar2: num 0.5
#>   .. ..$ metric1  : num 0.241
#>   .. ..$ metric2  : num 0.215
#>   .. ..$ b1       : num 0.545
#>   .. ..$ b2       : num 0.793
#>  $ :List of 2
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: num 0.0502
#>   .. ..$ seed     : num 1
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.5
#>   .. ..$ hyperpar2: num 1
#>   .. ..$ metric1  : num 0.713
#>   .. ..$ metric2  : num 0.502
#>   .. ..$ b1       : num 0.5
#>   .. ..$ b2       : num 0.722
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: num 2.94
#>   .. ..$ seed     : num 2
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.5
#>   .. ..$ hyperpar2: num 1
#>   .. ..$ metric1  : num 0.425
#>   .. ..$ metric2  : num 0.282
#>   .. ..$ b1       : num 0.555
#>   .. ..$ b2       : num 0.712
#>  $ :List of 2
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: num 0.041
#>   .. ..$ seed     : num 1
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.8
#>   .. ..$ hyperpar2: num 1
#>   .. ..$ metric1  : num 0.671
#>   .. ..$ metric2  : num 0.409
#>   .. ..$ b1       : num 0.578
#>   .. ..$ b2       : num 0.701
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: num 0.0396
#>   .. ..$ seed     : num 2
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.8
#>   .. ..$ hyperpar2: num 1
#>   .. ..$ metric1  : num 0.459
#>   .. ..$ metric2  : num 0.411
#>   .. ..$ b1       : num 0.501
#>   .. ..$ b2       : num 0.777

Created on 2021-02-21 by the reprex package (v0.3.0)

Update
The problem of the approach above is that all other variables are converted to numeric, which is not desirable, since time_iter was originally a difftime object.

The approach below is more verbose, but doesn't convert other variables to numeric:

res %>%
  map(
    ~ modify(.x, function(x) {
      x <- append(x, unlist(x$beta))
      x$beta <- NULL 
      x
      })

Below is the output of str:

res %>%
  map(
    ~ modify(.x, function(x) {
      x <- append(x, unlist(x$beta))
      x$beta <- NULL 
      x
      })
  ) %>% str

#> List of 4
#>  $ :List of 2
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: 'difftime' num 0.7099
#>   .. .. ..- attr(*, "units")= chr "secs"
#>   .. ..$ seed     : num 1
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.5
#>   .. ..$ hyperpar2: num 0.5
#>   .. ..$ metric1  : num 0.485
#>   .. ..$ metric2  : num 0.258
#>   .. ..$ b1       : num 0.575
#>   .. ..$ b2       : num 0.745
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: 'difftime' num 0.058
#>   .. .. ..- attr(*, "units")= chr "secs"
#>   .. ..$ seed     : num 2
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.5
#>   .. ..$ hyperpar2: num 0.5
#>   .. ..$ metric1  : num 0.401
#>   .. ..$ metric2  : num 0.257
#>   .. ..$ b1       : num 0.535
#>   .. ..$ b2       : num 0.775
#>  $ :List of 2
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: 'difftime' num 0.046
#>   .. .. ..- attr(*, "units")= chr "secs"
#>   .. ..$ seed     : num 1
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.8
#>   .. ..$ hyperpar2: num 0.5
#>   .. ..$ metric1  : num 0.475
#>   .. ..$ metric2  : num 0.299
#>   .. ..$ b1       : num 0.541
#>   .. ..$ b2       : num 0.702
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: 'difftime' num 0.0474
#>   .. .. ..- attr(*, "units")= chr "secs"
#>   .. ..$ seed     : num 2
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.8
#>   .. ..$ hyperpar2: num 0.5
#>   .. ..$ metric1  : num 0.241
#>   .. ..$ metric2  : num 0.215
#>   .. ..$ b1       : num 0.545
#>   .. ..$ b2       : num 0.793
#>  $ :List of 2
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: 'difftime' num 0.0502
#>   .. .. ..- attr(*, "units")= chr "secs"
#>   .. ..$ seed     : num 1
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.5
#>   .. ..$ hyperpar2: num 1
#>   .. ..$ metric1  : num 0.713
#>   .. ..$ metric2  : num 0.502
#>   .. ..$ b1       : num 0.5
#>   .. ..$ b2       : num 0.722
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: 'difftime' num 2.9419
#>   .. .. ..- attr(*, "units")= chr "secs"
#>   .. ..$ seed     : num 2
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.5
#>   .. ..$ hyperpar2: num 1
#>   .. ..$ metric1  : num 0.425
#>   .. ..$ metric2  : num 0.282
#>   .. ..$ b1       : num 0.555
#>   .. ..$ b2       : num 0.712
#>  $ :List of 2
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: 'difftime' num 0.041
#>   .. .. ..- attr(*, "units")= chr "secs"
#>   .. ..$ seed     : num 1
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.8
#>   .. ..$ hyperpar2: num 1
#>   .. ..$ metric1  : num 0.671
#>   .. ..$ metric2  : num 0.409
#>   .. ..$ b1       : num 0.578
#>   .. ..$ b2       : num 0.701
#>   ..$ :List of 10
#>   .. ..$ modeltype: chr "tree"
#>   .. ..$ time_iter: 'difftime' num 0.0396
#>   .. .. ..- attr(*, "units")= chr "secs"
#>   .. ..$ seed     : num 2
#>   .. ..$ nobs     : num 75
#>   .. ..$ hyperpar1: num 0.8
#>   .. ..$ hyperpar2: num 1
#>   .. ..$ metric1  : num 0.459
#>   .. ..$ metric2  : num 0.411
#>   .. ..$ b1       : num 0.501
#>   .. ..$ b2       : num 0.777

Created on 2021-03-27 by the reprex package (v0.3.0)

Upvotes: 2

Related Questions