Change lapply syntax to nested for looping in R-CodePudding

I would like to ask for help in rephrasing syntax in my R function.

I have a following nested list:

x <- list(one = list(one_1 = list(seq = c(rep(1,5), rep(2,4)), start = -1, end = 5), 
    one_2 = list(seq = c(rep(2,5), rep(1,5), rep(3,4), rep(2,11)), start = 2, end = 6), one_3 = list(
        seq = c(rep(3,4), rep(1,12), rep(4,6)), start = -3, end = 7)), two = list(two_1 = list(
    seq = c(rep(1,7), rep(2,4), rep(1,3)), start = 8, end = 222), two_2 = list(seq = c(rep(4,4), rep(1,3), rep(2,6)), 
    start = -1, end = 54)))

I apply a following function for this list:

first <- function(input_list, value){
  filtered_input <- foreach::foreach(i = seq_along(input_list)) %dopar% {
    filtered_output <-  Filter(function(x) any(with(rle(x$seq), lengths[values==value]>=4)) & x$start>=0, input_list[[i]])
    lapply(filtered_output, function(x) x)
  }
}

with a following command:

y <- first(input_list = x, value = 2)

which produces a following output:

desired_y <- list(list(one_2 = list(seq = c(2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 
3, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2), start = 2, end = 6)), 
    list(two_1 = list(seq = c(1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 
    1, 1, 1), start = 8, end = 222)))

The function works fine. But I want to change its' syntax to use nested for loops. Here is my attempt which does not work:

second <- function(input_list, value){
  
  for (x in seq_along(input_list)){
    for (y in seq_along(input_list[[x]])){
      filtered_input <- c(filtered_input, foreach::foreach(y) %dopar% filtered_output <- Filter(function(z) any(with(rle(z$seq), lengths[values==value]>=4)) & z$start>=0, input_list[[x]]))
      }
  }
  return(filtered_input)
}

y <- second(input_list = x, value = 2)

CodePudding user response：

Here is second rewritten. The two outputs are identical.

library(parallel)
library(doParallel)
#> Loading required package: foreach
#> Loading required package: iterators
library(foreach)

x <- list(one = list(one_1 = list(seq = c(rep(1,5), rep(2,4)), start = -1, end = 5), 
                     one_2 = list(seq = c(rep(2,5), rep(1,5), rep(3,4), rep(2,11)), start = 2, end = 6), one_3 = list(
                       seq = c(rep(3,4), rep(1,12), rep(4,6)), start = -3, end = 7)), two = list(two_1 = list(
                         seq = c(rep(1,7), rep(2,4), rep(1,3)), start = 8, end = 222), two_2 = list(seq = c(rep(4,4), rep(1,3), rep(2,6)), 
                                                                                                    start = -1, end = 54)))
first <- function(input_list, value){
  filtered_input <- foreach::foreach(i = seq_along(input_list)) %dopar% {
    filtered_output <- Filter(function(x) 
      any(with(rle(x$seq), lengths[values==value]>=4)) & x$start>=0, input_list[[i]]
    )
    lapply(filtered_output, function(x) x)
  }
}

second <- function(input_list, value){
  filtered_input <- vector("list", length(input_list))
  for (x in seq_along(input_list)){
    for (y in seq_along(input_list[[x]])){
      z <- foreach::foreach(y, .combine = c) %dopar% 
        Filter(function(z) 
          any(with(rle(z$seq), lengths[values==value]>=4)) & z$start>=0, input_list[[x]]
        )
    }
    filtered_input[[x]] <- z
  }
  return(filtered_input)
}


cl <- makeCluster(4L)
registerDoParallel(cl)

y_first <- first(input_list = x, value = 2)
y_second <- second(input_list = x, value = 2)

identical(y_first, y_second)
#> [1] TRUE

stopCluster(cl)

^{Created on 2022-07-15 by the reprex package (v2.0.1)}