如何为大数据加速 R 中的嵌套 for 循环，目前在其中使用 append 并输出大列表？ 如何矢量化？

Question

Hopefully I get this right this time around, previously I posted (although that was years ago) and I remember that I didn't have much of a good example/ detail in my question.

So, I'm using the quakes dataset in R, for this example to hopefully make it easier to follow.

Hopefully this example is clear.

I have a function myfunc:

    myfunc <- function(x,y){
      z <- (x - y)^2
      return(z)
    }

So what I'm trying to do, is use this function for each and every row in the Quakes dataset. So for example using the head of the dataset:

> library(datasets)
> data(quakes)
> head(quakes)
     lat   long depth mag stations
1 -20.42 181.62   562 4.8       41
2 -20.62 181.03   650 4.2       15
3 -26.00 184.10    42 5.4       43
4 -17.97 181.66   626 4.1       19
5 -20.42 181.96   649 4.0       11
6 -19.68 184.31   195 4.0       12
> 

this first row would use the myfunc function with every other row in the dataset and then the same would happen with the second row for every other row in the dataset etc.

I'm currently using the following nested for loop and appending to a vector. I then cbind them all together.

lat <- vector()
long <- vector()
depth <- vector()
mag <- vector()
stations <- vector()
for (i in 1:6){
  for (j in 1:6){
    lat <- append(lat,(myfunc(quakes$lat[i], quakes$lat[j])))
    long <- append(long,(myfunc(quakes$long[i], quakes$long[j])))
    depth <- append(depth,(myfunc(quakes$depth[i], quakes$depth[j])))
    mag <- append(mag,(myfunc(quakes$mag[i], quakes$mag[j])))
    stations <- append(stations,(myfunc(quakes$stations[i], quakes$stations[j])))
  }
}
final <- as.data.frame(cbind(lat, long, depth, mag, stations))

The actual data I'm doing this on, has 1244 rows and 13 columns, and doesn't seem to run the full code (or takes too long, as I usually just stop when it's nearing 1 hour). I have tried my normal code on 191 rows and that seems to run fine, within 1 minute usually.

I've read up online about this and it's clear that the append is not good to do in for loops. I've come across sapply , vectorisation and some examples. However I'm really struggling to get this to work and output the exact same that it does currently.

I was wondering whether anyone has anyone can help me out with this/ has useful advice?

Thank you.

Update: Just to add that I'm going to be using the cbind function to bind two columns onto the results. For example if the quakes data had a letter assigned to each row ie A, B, C I would want the final output after the cbind to show from this

 ID    lat   long depth mag stations
1 A -20.42 181.62   562 4.8       41
2 B -20.62 181.03   650 4.2       15
3 C -26.00 184.10    42 5.4       43
4 D -17.97 181.66   626 4.1       19
5 E -20.42 181.96   649 4.0       11
6 F -19.68 184.31   195 4.0       12

to

 ID1 ID2   long depth mag stations
1  A   A  (row from final)
2  A   B  (row from final)
3  A   C  (row from final)
4  B   A  (row from final)
5  B   B  (row from final)
6  B   C  (row from final)

etc.

Currently I'm using something similar to this:

ID1 <- vector()
ID2 <- vector()
for (i in 1:1244){
  for (j in 1:1244){
    ID1 <- append(ID1,quakes$ID[i])
    ID2 <- append(ID2,quakes$ID[j])
  }
}

It currently returns large character lists. Do you have suggestion on how this could be improved?

Apologies for not mentioning this in my original post.

Answer 1

Here are two functions.
The first is my original answer made a function.According to a comment it's already faster than the original in the question but the second function is around twice as fast. It is also more memory efficient.

myfunc <- function(x, y){
  z <- (x - y)^2
  return(z)
}


slower <- function(X, fun = myfunc){
  fun <- match.fun(fun)
  res <- sapply(X, function(x) {
    o <- outer(x, x, fun)
    o[row(o) != col(o)]
  })
  as.data.frame(res)
}

faster <- function(X, fun){
  f <- function(x, fun = myfunc){
    y <- lapply(seq_along(x), function(i){
      fun(x[i], x[-i])
    })
    unlist(y)
  }
  fun <- match.fun(fun)
  res <- sapply(X, f, fun = fun)
  as.data.frame(res)
}

Test both, the results are identical.

res1 <- slower(quakes, myfunc)
res2 <- faster(quakes, myfunc)
identical(res1, res2)
#[1] TRUE

Now for the timings with package microbenchmark .

library(microbenchmark)

mb <- microbenchmark(
  outer = slower(quakes, myfunc),
  fastr = faster(quakes, myfunc),
  times = 10
)
print(mb, unit = "relative", order = "median")
#Unit: relative
#  expr      min       lq     mean   median       uq      max neval cld
# fastr 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    10  a 
# outer 1.545283 1.650968 1.970562 2.159856 2.762724 1.332896    10   b


ggplot2::autoplot(mb)