Why are those 3 loops faster than 1 short lapply - r

Question

While trying to optimize and benchmark a function, I was able to shrink 3 for loops into 1 short lapply call, but the function got slower.
I am trying to understand why that happens, as with the 3 loops I preallocate 3 lists with the same length and fill them in 3 different loops, which doesnt seem necessary and inefficient.
## Data #################
Grid = structure(list(ID = 1:81, X = c(99.99922283, 299.99922281, 499.9992228,
699.99922279, 899.99922277, 1099.99922275, 1299.99922274, 1499.99922273,
1699.99922271, 99.99922293, 299.99922291, 499.99922291, 699.99922289,
899.99922287, 1099.99922286, 1299.99922284, 1499.99922283, 1699.99922282,
99.99922303, 299.99922302, 499.99922301, 699.999223, 899.99922298,
1099.99922296, 1299.99922295, 1499.99922294, 1699.99922292, 99.99922314,
299.99922312, 499.99922311, 699.9992231, 899.99922308, 1099.99922307,
1299.99922306, 1499.99922304, 1699.99922303, 99.99922324, 299.99922323,
499.99922322, 699.9992232, 899.99922319, 1099.99922317, 1299.99922316,
1499.99922315, 1699.99922313, 99.99922335, 299.99922333, 499.99922332,
699.99922331, 899.9992233, 1099.99922328, 1299.99922327, 1499.99922325,
1699.99922324, 99.99922345, 299.99922344, 499.99922342, 699.99922341,
899.9992234, 1099.99922338, 1299.99922337, 1499.99922335, 1699.99922334,
99.99922356, 299.99922354, 499.99922353, 699.99922352, 899.9992235,
1099.99922348, 1299.99922347, 1499.99922345, 1699.99922344, 99.99922367,
299.99922365, 499.99922364, 699.99922362, 899.99922361, 1099.99922359,
1299.99922358, 1499.99922356, 1699.99922355), Y = c(1699.9975638,
1699.99756369, 1699.99756357, 1699.99756347, 1699.99756336, 1699.99756325,
1699.99756314, 1699.99756303, 1699.99756292, 1499.99756399, 1499.99756388,
1499.99756377, 1499.99756366, 1499.99756355, 1499.99756344, 1499.99756333,
1499.99756322, 1499.99756311, 1299.99756418, 1299.99756408, 1299.99756396,
1299.99756386, 1299.99756375, 1299.99756363, 1299.99756353, 1299.99756342,
1299.99756331, 1099.99756438, 1099.99756427, 1099.99756416, 1099.99756405,
1099.99756394, 1099.99756384, 1099.99756372, 1099.99756361, 1099.99756351,
899.99756457, 899.99756446, 899.99756434, 899.99756424, 899.99756414,
899.99756403, 899.99756392, 899.99756381, 899.9975637, 699.99756477,
699.99756466, 699.99756454, 699.99756443, 699.99756433, 699.99756422,
699.99756411, 699.99756401, 699.99756389, 499.99756496, 499.99756485,
499.99756474, 499.99756463, 499.99756452, 499.99756441, 499.9975643,
499.9975642, 499.99756409, 299.99756516, 299.99756505, 299.99756494,
299.99756483, 299.99756472, 299.99756461, 299.9975645, 299.99756439,
299.99756428, 99.99756535, 99.99756524, 99.99756513, 99.99756502,
99.99756491, 99.9975648, 99.99756469, 99.99756458, 99.99756448
)), row.names = c("11", "12", "13", "14", "15", "16", "17", "18",
"19", "21", "22", "23", "24", "25", "26", "27", "28", "29", "31",
"32", "33", "34", "35", "36", "37", "38", "39", "41", "42", "43",
"44", "45", "46", "47", "48", "49", "51", "52", "53", "54", "55",
"56", "57", "58", "59", "61", "62", "63", "64", "65", "66", "67",
"68", "69", "71", "72", "73", "74", "75", "76", "77", "78", "79",
"81", "82", "83", "84", "85", "86", "87", "88", "89", "91", "92",
"93", "94", "95", "96", "97", "98", "99"), class = "data.frame")
mut2 = sapply(1:100, function(i) sample(c(0,1), size = nrow(Grid), replace = T))
## Functions #################
## Triple For loop
getRects <- function(trimtonOut, Grid){
len1 <- dim(trimtonOut)[2]
childli = childnew = rectidli = vector("list", len1);
for (i in 1:len1) {
childli[[i]] <- trimtonOut[,i]
}
for (u in 1:len1){
rectidli[[u]] <- which(childli[[u]]==1, arr.ind = T)
}
for (z in 1:len1) {
childnew[[z]] <- Grid[rectidli[[z]],];
}
return(childnew)
}
## Shortest Lapply
getRects1 <- function(trimtonOut, Grid){
lapply(1:dim(trimtonOut)[2], function(i) {
Grid[which(trimtonOut[,i]==1, arr.ind = T),]
})
}
## Shorter Lapply
getRects2 <- function(trimtonOut, Grid){
lapply(1:dim(trimtonOut)[2], function(i) {
tmp = which(trimtonOut[,i]==1, arr.ind = T)
Grid[tmp,]
})
}
## Longest Lapply
getRects3 <- function(trimtonOut, Grid){
lapply(1:dim(trimtonOut)[2], function(i) {
tmp = trimtonOut[,i]
tmp1 = which(tmp==1, arr.ind = T)
Grid[tmp1,]
})
}
## Execute and Compare #################
getRectV <- getRects(mut2, Grid)
getRectV1 <- getRects1(mut2, Grid)
getRectV2 <- getRects2(mut2, Grid)
getRectV3 <- getRects3(mut2, Grid)
identical(getRectV,getRectV1)
identical(getRectV,getRectV2)
identical(getRectV,getRectV3)
## Benchmark #################
library(microbenchmark)
# mut2 = sapply(1:400, function(i) sample(c(0,1), size = nrow(Grid), replace = T))
mc = microbenchmark(
loop = getRects(mut2, Grid),
lap1 = getRects1(mut2, Grid),
lap2 = getRects2(mut2, Grid),
lap3 = getRects3(mut2, Grid)
)
mc

Answer 1

Are you sure that those time differences are that significant?
library(microbenchmark)
# mut2 = sapply(1:400, function(i) sample(c(0,1), size = nrow(Grid), replace = T))
mc = microbenchmark(
loop = getRects(mut2, Grid),
lap1 = getRects1(mut2, Grid),
lap2 = getRects2(mut2, Grid),
lap3 = getRects3(mut2, Grid)
)
mc
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> loop 2.651485 2.699166 3.195301 2.756171 3.136741 8.010173 100
#> lap1 2.755571 2.828128 3.098850 2.877806 3.012487 7.427598 100
#> lap2 2.737105 2.808924 3.118260 2.863221 2.939996 13.706736 100
#> lap3 2.719101 2.787040 3.191893 2.852963 3.004811 8.490867 100