Search code examples
rlistapplybindreplication

bbind from a list inside a list after replication in R


I'm trying to replicate an experiment in R n=5 times with the replicate function. The code is as follows:

library(glmnet)
library(coefplot)

code <- replicate(10,{
  data<-matrix(rnorm(100*5,mean=0,sd=1), 100, 5) 
  colnames(data) <- c("X1", "X2", "X3", "X4", "X5")
  data <- as.data.frame(data)
  a <- 5 
  b <- 0.8
  c <- 100
  
  data[,2] <- a*data[,1] - b*rnorm(c)
  data[,3] <- a*data[,1] + b*rnorm(c)
  data[,4] <- a*data[,1] - b*rnorm(c)
  
  A <- as.matrix(data)
  set.seed(1)
  results <- lapply(seq_len(ncol(A)), function(i) {
    list(
      cvfit = cv.glmnet(A[, -i] , A[, i] , standardize = TRUE , type.measure = "mse" , nfolds = 10 , alpha = 1)
    )
  })
  
  lam <- as.data.frame(`names<-`(
    lapply(results, function(x) (x$cvfit$lambda.min)), 
    paste0("X", seq_along(results))
  ))
  
  sigma<- matrix(rnorm(1*5,mean=0,sd=1), 1, 5) 
  colnames(sigma) <- c("X1", "X2", "X3", "X4", "X5")
  sub1.sigma <- subset(sigma, select = sigma <= sum(lam))
  sub2.sigma <- subset(sigma, select = sigma <= 2*sum(lam))
  sub3.sigma <- subset(sigma, select = sigma <= 3*sum(lam))
  dplyr::lst(sigma, sub1.sigma, sub2.sigma, sub3.sigma)
  
}, simplify = FALSE)

which results in a list called code in the environment. This list contains 10 list with 4 double each (sigma,sub1.sigma,sub2.sigma, and sub3.sigma. I want to create 4 dataframes (sigma, sub1.sigma,... that each contains the values of each Xi in every run and when no value exist (since i am subseting) to display NA, like the following

X1    X2    X3    X4    X5 
0.83  0.83  0.83  0.83  0.83
0.33  0.33  0.33  0.33  NA
0.46  NA    0.46  0.46  0.46
0.22  0.22  NA    0.22  0.22
0.57  0.57  0.57  0.57  0.57

I tried to use the following after suggestion

result <- lapply(purrr::transpose(code), function(x) do.call(rbind, x))

but the error Error in rbind(deparse.level, ...) : numbers of columns of arguments do not match was diplayed. Can someone help me figured it out?


Solution

  • Here is an option with bind_rows

    library(dplyr)
    library(purrr)
    map_dfr(code, ~ bind_rows(Filter(function(x) ncol(x) > 0,
             map(.x, as_tibble))))
    

    If we want to transpose

    transpose(code) %>% 
       map_dfr(~ keep(.x, ~ ncol(.) > 0) %>% 
            map_dfr(as_tibble), .id = 'grp')%>%
         filter(grp %in% 'sigma')