Как ускорить вложение для l oop в R для больших данных, которые в настоящее время используют append в нем и выводят большие списки? Как векторизовать?

Question

Надеюсь, на этот раз я понял это правильно, ранее я писал (хотя это были годы go), и я помню, что у меня не было хорошего примера / детали в моем вопросе.

Итак, я использую набор данных о землетрясениях в R для этого примера, чтобы, надеюсь, было легче следовать.

Надеюсь, этот пример понятен.

У меня есть function myfun c:

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

Итак, я пытаюсь использовать эту функцию для каждой строки в наборе данных Quakes. Так, например, используя заголовок набора данных:

> 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
> 

, эта первая строка будет использовать функцию myfunc с каждой второй строкой в ​​наборе данных, а затем то же самое произойдет со второй строкой для каждой другой строки. в наборе данных et c.

В настоящее время я использую следующее, вложенное для l oop и добавление к вектору. Я тогда cbind их всех вместе.

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))

Фактические данные, с которыми я делаю это, имеют 1244 строки и 13 столбцов и, похоже, не запускают полный код (или занимают слишком много времени, поскольку я обычно просто останавливаюсь, когда они приближаются 1 час). Я попробовал свой обычный код на 191 строке, и он, кажется, работает нормально, обычно в течение 1 минуты.

Я прочитал об этом в Интернете, и ясно, что добавление не подходит для циклов. Я встречал sapply, векторизацию и некоторые примеры. Однако я действительно изо всех сил пытаюсь заставить это работать и выводить точно так же, как это делает в настоящее время.

Мне было интересно, может ли кто-нибудь помочь мне с этим / есть полезный совет?

Спасибо.

Обновление: просто добавлю, что я собираюсь использовать функцию cbind для привязки двух столбцов к результатам. Например, если для данных о землетрясениях каждой строке назначена буква, т. Е. A, B, C, я бы хотел, чтобы итоговый вывод после cbind отображался с этого

 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

до

 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)

др c.

В настоящее время я использую что-то похожее на это:

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])
  }
}

В настоящее время он возвращает большие списки символов. У вас есть предложение о том, как это можно улучшить?

Извините, что не упомянул об этом в моем оригинальном посте.

Answer 1

Вот две функции.
Первый - мой оригинальный ответ, сделанный функцией. Согласно комментарию, он уже быстрее, чем оригинал в вопросе, но вторая функция примерно вдвое быстрее. Это также более эффективно использует память.

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)
}

Проверьте оба, результаты идентичны.

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

Теперь о времени с пакетом 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)