R_Extract строки и столбца элемента, используемого при использовании функции apply

Question

Как извлечь строку и столбец используемого элемента при использовании функции apply?Например, я хочу применить функцию для каждого элемента матрицы, где номер строки и столбца выбранного элемента также являются переменными в функции.Простой воспроизводимый пример приведен ниже

mymatrix <- matrix(1:12, nrow=3, ncol=4)

Мне нужна функция, которая выполняет следующие действия:

apply(mymatrix, c(1,2), function (x) sum(x, row_number, col_number))

, где row_number и col_number - номера строк и столбцов выбранногоэлемент в mymatrix.Обратите внимание, что моя функция более сложная, чем sum, поэтому желательно надежное решение.

Answer 1

Я не совсем уверен, что вы пытаетесь сделать, но я бы использовал цикл for.

Предварительно распределите возвращаемую matrix, и это будет очень быстро

ret <- mymatrix
for (i in 1:nrow(mymatrix))
    for (j in 1:ncol(mymatrix))
        ret[i, j] <- sum(mymatrix[i, j], i, j)
#     [,1] [,2] [,3] [,4]
#[1,]    3    7   11   15
#[2,]    5    9   13   17
#[3,]    7   11   15   19

---

Сравнительный анализ 1

Мне было любопытно, поэтому я провел анализ microbenchmark для сравнения методов;Я использовал матрицу большего размера 200x300.

mymatrix <- matrix(1:600, nrow = 200, ncol = 300)
library(microbenchmark)
res <- microbenchmark(
    for_loop = {
        ret <- mymatrix
        for (i in 1:nrow(mymatrix))
            for (j in 1:ncol(mymatrix))
                ret[i, j] <- sum(mymatrix[i, j], i, j)
    },
    expand_grid_mapply = {
        newResult<- mymatrix
        grid1 <- expand.grid(1:nrow(mymatrix),1:ncol(mymatrix))
        newResult[]<-
        mapply(function(row_number, col_number){ sum(mymatrix[row_number, col_number], row_number, col_number) },row_number = grid1$Var1, col_number = grid1$Var2 )
    },
    expand_grid_apply = {
        newResult<- mymatrix
        grid1 <- expand.grid(1:nrow(mymatrix),1:ncol(mymatrix))
        newResult[]<-
        apply(grid1, 1, function(x){ sum(mymatrix[x[1], x[2]], x[1], x[2]) })
    },
    double_sapply = {
        sapply(1:ncol(mymatrix), function (x) sapply(1:nrow(mymatrix), function (y) sum(mymatrix[y,x],x,y)))
    }
)

res
#Unit: milliseconds
#               expr       min        lq      mean    median       uq       max
#           for_loop  41.42098  52.72281  56.86675  56.38992  59.1444  82.89455
# expand_grid_mapply 126.98982 161.79123 183.04251 182.80331 196.1476 332.94854
#  expand_grid_apply 295.73234 354.11661 375.39308 375.39932 391.6888 562.59317
#      double_sapply  91.80607 111.29787 120.66075 120.37219 126.0292 230.85411

library(ggplot2)
autoplot(res)

Сравнительный анализ 2 (с expand.grid за пределами microbenchmark)

grid1 <- expand.grid(1:nrow(mymatrix),1:ncol(mymatrix))
res <- microbenchmark(
    for_loop = {
        ret <- mymatrix
        for (i in 1:nrow(mymatrix))
            for (j in 1:ncol(mymatrix))
                ret[i, j] <- sum(mymatrix[i, j], i, j)
    },
    expand_grid_mapply = {
        newResult<- mymatrix
        newResult[]<-
        mapply(function(row_number, col_number){ sum(mymatrix[row_number, col_number], row_number, col_number) },row_number = grid1$Var1, col_number = grid1$Var2 )
    },
    expand_grid_apply = {
        newResult<- mymatrix
        newResult[]<-
        apply(grid1, 1, function(x){ sum(mymatrix[x[1], x[2]], x[1], x[2]) })
    }
)

res
#Unit: milliseconds
#               expr       min        lq      mean    median        uq      max
#           for_loop  39.65599  54.52077  60.87034  59.19354  66.64983  95.7890
# expand_grid_mapply 130.33573 167.68201 194.39764 186.82411 209.33490 400.9273
#  expand_grid_apply 296.51983 373.41923 405.19549 403.36825 427.41728 597.6937

Answer 2

Это моя мысль с функцией outer().

Третий аргумент FUN может быть любой функцией с двумя аргументами.

mymatrix <- matrix(1:12, nrow = 3, ncol = 4)
nr <- nrow(mymatrix)
nc <- ncol(mymatrix)
mymatrix + outer(1:nr, 1:nc, FUN = "+")

     [,1] [,2] [,3] [,4]
[1,]    3    7   11   15
[2,]    5    9   13   17
[3,]    7   11   15   19

С кодом теста @Maurits Evers:

Unit: microseconds
     expr       min         lq      mean    median        uq        max
 for_loop 19963.203 22427.1630 25308.168 23811.855 25017.031 158341.678
    outer   848.247   949.3515  1054.944  1011.457  1059.217   1463.956

---

Кроме того, я пытаюсь завершить вашу оригинальную идею с помощью apply(X, c(1,2), function (x)):

(это немного медленнее, чем другие ответы)

mymatrix <- matrix(1:12, nrow = 3, ncol = 4)
n <- 1                                        # n = index of data
nr <- nrow(mymatrix)
apply(mymatrix, c(1,2), function (x) {
  row_number <- (n-1) %% nr + 1               # convert n to row number
  col_number <- (n-1) %/% nr + 1              # convert n to column number
  res <- sum(x, row_number, col_number)
  n <<- n + 1
  return(res)
})

     [,1] [,2] [,3] [,4]
[1,]    3    7   11   15
[2,]    5    9   13   17
[3,]    7   11   15   19

Answer 3

Это не так, как работает применение: вы не можете получить доступ к текущему индексу (индекс строки, столбца) изнутри [lsvm]?apply -семейства.

Перед применением вы должны будете создать текущий индекс строки и столбца.?expand.grid.

mymatrix <- matrix(1:12, nrow=3, ncol=4)
newResult<- mymatrix

grid1 <- expand.grid(1:nrow(mymatrix),1:ncol(mymatrix))

newResult[]<-
mapply(function(row_number, col_number){ sum(mymatrix[row_number, col_number], row_number, col_number) },row_number = grid1$Var1, col_number = grid1$Var2 )

newResult

#     [,1] [,2] [,3] [,4]
#[1,]    3    7   11   15
#[2,]    5    9   13   17
#[3,]    7   11   15   19

---

Если вы хотите использовать apply

newResult[]<-    
apply(grid1, 1, function(x){ sum(mymatrix[x[1], x[2]], x[1], x[2]) })