Применение функции к матрице расстояния в R
Кроме увеличения пропускной способности, нет.
Только потому, что они делают это, ты не должен.
3 ответа
Мое решение - получить индексы вектора расстояний, учитывая строку и размер матрицы. Я получил это от codeguru
int Trag_noeq(int row, int col, int N)
{
//assert(row != col); //You can add this in if you like
if (row<col)
return row*(N-1) - (row-1)*((row-1) + 1)/2 + col - row - 1;
else if (col<row)
return col*(N-1) - (col-1)*((col-1) + 1)/2 + row - col - 1;
else
return -1;
}
После преобразования в R, предполагая, что индексы начинаются с 1, и предполагая, что матрица нижнего триа вместо верхней триады, которую я получил.
РЕДАКТИРОВАТЬ: Использование векторизованной версии, предоставленной rcs
noeq.1 <- function(i, j, N) {
i <- i-1
j <- j-1
ix <- ifelse(i < j,
i*(N-1) - (i-1)*((i-1) + 1)/2 + j - i,
j*(N-1) - (j-1)*((j-1) + 1)/2 + i - j) * ifelse(i == j, 0, 1)
ix
}
## To get the indexes of the row, the following one liner works:
getrow <- function(z, N) noeq.1(z, 1:N, N)
## to get the row sums
getsum <- function(d, f=sum) {
N <- attr(d, "Size")
sapply(1:N, function(i) {
if (i%%100==0) print(i)
f(d[getrow(i,N)])
})
}
Итак, с примером:
sumd2 <- getsum(d)
Это было намного медленнее, чем as.matrix для небольших матриц до векторизации. Но примерно в 3 раза медленнее после векторизации. В Intel Core2Duo 2ghz применение суммы по строкам матрицы размера 10000 заняло чуть более 100 секунд. Метод as.matrix не работает. Спасибо, rcs!
Это векторизованная версия функции noeq (либо аргумент i , либо j ):
noeq.1 <- function(i, j, N) {
i <- i-1
j <- j-1
ifelse(i < j,
i*(N-1) - ((i-1)*i)/2 + j - i,
j*(N-1) - ((j-1)*j)/2 + i - j) * ifelse(i == j, 0, 1)
}
> N <- 4
> sapply(1:N, function(i) sapply(1:N, function(j) noeq(i, j, N)))
[,1] [,2] [,3] [,4]
[1,] 0 1 2 3
[2,] 1 0 4 5
[3,] 2 4 0 6
[4,] 3 5 6 0
> sapply(1:N, function(i) noeq.1(i, 1:N, N))
[,1] [,2] [,3] [,4]
[1,] 0 1 2 3
[2,] 1 0 4 5
[3,] 2 4 0 6
[4,] 3 5 6 0
Время сделано на Intel Core 2 Duo с тактовой частотой 2,4 ГГц (Mac OS 10.6.1):
> N <- 1000
> system.time(sapply(1:N, function(j) noeq.1(1:N, j, N)))
user system elapsed
0.676 0.061 0.738
> system.time(sapply(1:N, function(i) sapply(1:N, function(j) noeq(i, j, N))))
user system elapsed
14.359 0.032 14.410
Прежде всего, всем, кто этого еще не видел, я настоятельно рекомендую прочитать эту статью о r- wiki об оптимизации кода.
Вот еще одна версия без использования ifelse (это относительно медленная функция):
noeq.2 <- function(i, j, N) {
i <- i-1
j <- j-1
x <- i*(N-1) - (i-1)*((i-1) + 1)/2 + j - i
x2 <- j*(N-1) - (j-1)*((j-1) + 1)/2 + i - j
idx <- i < j
x[!idx] <- x2[!idx]
x[i==j] <- 0
x
}
И тайминги на моем ноутбуке:
> N <- 1000
> system.time(sapply(1:N, function(i) sapply(1:N, function(j) noeq(i, j, N))))
user system elapsed
51.31 0.10 52.06
> system.time(sapply(1:N, function(j) noeq.1(1:N, j, N)))
user system elapsed
2.47 0.02 2.67
> system.time(sapply(1:N, function(j) noeq.2(1:N, j, N)))
user system elapsed
0.88 0.01 1.12
И lapply быстрее, чем sapply:
> system.time(do.call("rbind",lapply(1:N, function(j) noeq.2(1:N, j, N))))
user system elapsed
0.67 0.00 0.67