I get an empty list in applying the function lapply

I am trying to replace a loop in order to optimize the code. I was looking for a way to make analysis_sample_a and pass_buffer_list_w reproducible without writing so much code but I did not succeed because both objects were lists.

Here is how the data looks like of the object analyis_sample_a

analysis_sample_a <- structure(list(prs_id = structure(c(5413941, 5173912, 5155959, 
5399763, 5331026, 5058319), label = " ESP", format.stata = "%12.0g"), 
    year = structure(c(2011, 2007, 2010, 2008, 2013, 2005), label = "Calendar year", format.stata = "%8.0g"), 
    X = structure(c(13.42006, 13.368156, 10.631321, 13.423421, 
    10.75336, 9.158268), label = "geo_xWGS84", format.stata = "%12.0g"), 
    Y = structure(c(52.476585, 52.551794, 48.446771, 52.485964, 
    53.009095, 48.780813), label = "geo_yWGS84", format.stata = "%12.0g"), 
    X_proj = c(800129.781458432, 796100.497439696, 620632.880007759, 
    800293.921457125, 617638.859690204, 511626.830156876), Y_proj = c(5823237.00413242, 
    5831381.69520824, 5367244.21158149, 5824293.43326152, 5874720.17139051, 
    5403102.34693945), pgq_id = structure(c(27, 27, 27, 27, 27, 
    27), label = "GEO Ebene", format.stata = "%8.0g", labels = c(`          -9 Nicht zuordenbar` = -9, 
    `          -7 Keine Angabe` = -7, `          -5 (leer)` = -5, 
    `           8 Gemeinde` = 8, `           9 Postleitzahl` = 9, 
    `          11 Ortsteil` = 11, `          13 Gemeinde/PLZ` = 13, 
    `          16 Ortsteil/PLZ` = 16, `          20 Block` = 20, 
    `          22 Blockseite` = 22, `          24 Gebäude` = 24, 
    `          27 Hausnummer` = 27), class = c("haven_labelled", 
    "vctrs_vctr", "double")), aqk_id = structure(c(7, 7, 7, 7, 
    7, 7), label = "GEO Matchqual.", format.stata = "%8.0g", labels = c(`          -9 Nicht zuordenbar` = -9, 
    `          -7 Keine Angabe` = -7, `          -5 (leer)` = -5, 
    `           1 Sonstiges` = 1, `           2 Ort/Str. tls 1:1, Rest fehlt` = 2, 
    `           3 PLZ/Ort/Str. tls 1:1,Hsn fehlt` = 3, `           4 PLZ fehlt, Rest teils 1:1` = 4, 
    `           5 Ort fehlt, Rest teils 1:1` = 5, `           6 fast alles 1:1` = 6, 
    `           7 alles 1:1` = 7), class = c("haven_labelled", 
    "vctrs_vctr", "double")), htq_id = structure(c(4, 4, 4, 4, 
    4, 4), label = "GEO Treffgenau.", format.stata = "%8.0g", labels = c(`          -9 Nicht zuordenbar` = -9, 
    `          -7 Keine Angabe` = -7, `          -5 (leer)` = -5, 
    `           1 sehr mehrdeutig` = 1, `           2 etwas mehrdeutig` = 2, 
    `           3 fast eindeutig` = 3, `           4 eindeutig` = 4
    ), class = c("haven_labelled", "vctrs_vctr", "double")), 
    female = structure(c(1, 0, 0, 1, 0, 0), label = "Female", format.stata = "%8.0g"), 
    age = structure(c(31.1671237945557, 55.145206451416, 40.4630126953125, 
    60.687671661377, 45.6575355529785, 43.4438362121582), format.stata = "%9.0g"), 
    age_1525 = structure(c(0, 0, 0, 0, 0, 0), label = "Age group: 15-25 years", format.stata = "%8.0g"), 
    age_2635 = structure(c(1, 0, 0, 0, 0, 0), label = "Age group: 26-35 years", format.stata = "%8.0g"), 
    age_3650 = structure(c(0, 0, 1, 0, 1, 1), label = "Age group: 36-50 years", format.stata = "%8.0g"), 
    age_51ret = structure(c(0, 1, 0, 1, 0, 0), label = "Age group: 51-retirement age", format.stata = "%8.0g"), 
    age_ret75 = structure(c(0, 0, 0, 0, 0, 0), label = "Age group: retirement age-75 years", format.stata = "%8.0g"), 
    german = structure(c(1, 1, 1, 0, 1, 1), label = "German citizen", format.stata = "%8.0g"), 
    foreign = structure(c(0, 0, 0, 1, 0, 0), label = "No german citizenship", format.stata = "%8.0g"), 
    refugee = structure(c(0, 0, 0, 0, 0, 0), label = "Refugee", format.stata = "%8.0g"), 
    employed = structure(c(0, 0, 1, 0, 1, 0), format.stata = "%8.0g"), 
    fulltime = structure(c(0, 0, 1, 0, 1, 0), format.stata = "%8.0g"), 
    parttime = structure(c(0, 0, 0, 0, 0, 0), format.stata = "%8.0g"), 
    marginal = structure(c(0, 0, 0, 0, 0, 0), label = "Employed but below marginal earning threshold", format.stata = "%8.0g"), 
    not_emp = structure(c(1, 1, 0, 1, 0, 1), format.stata = "%8.0g"), 
    ub1_unemp = structure(c(1, 0, 0, 0, 0, 0), format.stata = "%8.0g"), 
    ub1_emp = structure(c(0, 0, 0, 0, 0, 0), format.stata = "%8.0g"), 
    ub2_unemp = structure(c(0, 1, 0, 1, 0, 1), format.stata = "%8.0g"), 
    ub2_emp = structure(c(0, 0, 0, 0, 0, 0), format.stata = "%8.0g"), 
    ub2_ub1 = structure(c(0, 0, 0, 0, 0, 0), format.stata = "%8.0g"), 
    jobsearch = structure(c(1, 1, 0, 1, 0, 1), format.stata = "%9.0g"), 
    educ = structure(c(3, 2, 2, 1, 2, 2), format.stata = "%9.0g"), 
    educ_low = structure(c(0, 0, 0, 1, 0, 0), format.stata = "%8.0g"), 
    educ_med = structure(c(0, 1, 1, 0, 1, 1), format.stata = "%8.0g"), 
    educ_high = structure(c(1, 0, 0, 0, 0, 0), format.stata = "%8.0g"), 
    yearly_income = structure(c(4911.39990234375, 0, 55056.59765625, 
    0, 69598.1953125, 0), format.stata = "%9.0g"), ieb_wo_gem_num = structure(c(1.1e+07, 
    1.1e+07, 9772216, 1.1e+07, 3360018, 8111000), label = "Gem 12/2017", format.stata = "%10.0g"), 
    `_ID` = structure(c(8326, 8262, 5592, 8326, 5738, 3412), format.stata = "%12.0g"), 
    longitude = structure(c(13.4231042861938, 13.3653039932251, 
    10.653510093689, 13.4231042861938, 10.7989225387573, 9.16147613525391
    ), label = "x-coordinate of area centroid", format.stata = "%9.0g")), row.names = c(NA, 
-6L), class = c("tbl_df", "tbl", "data.frame"))

Then I tried to divide the dataframe into different lists by year

splited <- analysis_sample_a %>%
  filter(year %in% c(2007:2017))

analysis_sample_year_a <- splited  %>%
          group_split(year)

This is how the data of pass_buffer_a looks like

pass_buffer_a <- structure(list(welle = c("Welle 11 (2017)", "Welle 8 (2014)", 
"Welle 4 (2010)", "Welle 6 (2012)", "Welle 8 (2014)", "Welle 5 (2011)"
), g__2017 = c("09564000", "03241001", "13075136", "05958020", 
"05913000", "07332049"), pass_geo_i = c("20090", "14978", "28451", 
"9862", "6059", "7906"), state = c("Bayern", "Niedersachsen", 
"Mecklenburg-Vorpommern", "Nordrhein-Westfalen", "Nordrhein-Westfalen", 
"Rheinland-Pfalz"), plz = c("90443", "30165", "17373", "59969", 
"44328", "67273"), pop_pc = c("97", "90", "36", "7", "79", "29"
), kde_bandwi = c(60.7424210253877, 68.1159472633942, 240.487367481696, 
510.263978381978, 79.7029170659758, 305.605859767971), buffer_siz = c(182.227263076163, 
204.347841790183, 721.462102445088, 1530.79193514593, 239.108751197927, 
916.817579303913)), row.names = 0:5, class = "data.frame")

This is the code in which I also create a lists by waves.

convert_to_shp_list <- function(shp){
  y <- as(shp, "SpatialPolygons")
  p <- slot(y, "polygons")
  v <- lapply(p, function(z) { SpatialPolygons(list(z)) })
  return(v)}

pass_buffer_list <- convert_to_shp_list(pass_buffer_proj)

pass_buffer_list <- convert_to_shp_list(pass_buffer)

pass_buffer_list_w4 <- pass_buffer_list[pass_buffer$welle == "Welle 4 (2010)"]
pass_buffer_list_w5 <- pass_buffer_list[pass_buffer$welle == "Welle 5 (2011)"]
pass_buffer_list_w6 <- pass_buffer_list[pass_buffer$welle == "Welle 6 (2012)"]
pass_buffer_list_w8 <- pass_buffer_list[pass_buffer$welle == "Welle 8 (2014)"]
pass_buffer_list_w11 <- pass_buffer_list[pass_buffer$welle == "Welle 11 (2017)"]

 pass_buffer_list_w <- list(pass_buffer_list_w4,
                            pass_buffer_list_w5, pass_buffer_list_w6, pass_buffer_list_w8, pass_buffer_list_w11)

This is the loop which I tried to replace.

analysis_buf <- list()
c <- 1
for(i in 1:length(analysis_sample_year_a)){
  for(j in 1:length(pass_buffer_list_w[[i]])){
    analysis_buf[[c]] <- analysis_sample_year_a[[i]][which(!is.na(sp::over(SpatialPoints(data.frame(analysis_sample_year_a[[i]]$X_proj,analysis_sample_year_a[[i]]$Y_proj)), pass_buffer_list_w[[i]][[j]]))), ]
    c <- c + 1
  }
}

This is how the output should look like

enter image description here

My idea to replace the loop is to apply the base::lapply() function into different objects data1, data2,....,data11 by each wave. In this way in each wave I have a point assigned to its determined buffer. The problem is that I get an empty list but I dont know the why.


analysis_2007 <- list(analysis_sample_year_a[[1]]
analysis_2008 <- list(analysis_sample_year_a[[2]]
...
analysis_2017 <- list(analysis_sample_year_a[[11]]


data1 <- lapply(seq(nrow(pass_buffer_list_w)), function(x) sp::over(pass_buffer_list_w[x,], analysis_2007))
data2 <- lapply(seq(nrow(pass_buffer_list_w)), function(x) sp::over(pass_buffer_list_w[x,], analysis_2008))
...
data11 <- lapply(seq(nrow(pass_buffer_list_w)), function(x) sp::over(pass_buffer_list_w[x,], analysis_2017))

Then, my next step to replace the loop would be to create a single list where there are the lists from data1,...,data11


list_data <- tibble(list(data1, data2, ...,data11)

I hope someone can help me with this matter because I am stuck since 3 weeks and I do not find an answer. Thank you for your help :slight_smile: