Каков самый быстрый способ вычисления первых двух основных компонентов в R?
Я использую princomp в R для выполнения PCA. Моя матрица данных огромна (10K x 10K с каждым значением до 4 десятичных точек). Требуется ~ 3,5 часа и ~ 6,5 ГБ физической памяти на процессоре Xeon 2,27 ГГц.
Поскольку мне нужны только первые два компонента, есть ли более быстрый способ сделать это?
Обновление:
В дополнение к скорости, есть ли эффективный способ памяти для этого?
Для вычисления первых двух компонентов с помощью svd(,2,) требуется ~ 2 часа и ~ 6,3 ГБ физической памяти.
Ответы
Ответ 1
Иногда вы получаете доступ к так называемым "экономичным" разложениям, которые позволяют вам ограничить количество собственных значений/собственных векторов. Похоже, что eigen() и prcomp() не предлагают этого, но svd() позволяет указать максимальное число для вычисления.
На маленьких матрицах выигрыши кажутся скромными:
R> set.seed(42); N <- 10; M <- matrix(rnorm(N*N), N, N)
R> library(rbenchmark)
R> benchmark(eigen(M), svd(M,2,0), prcomp(M), princomp(M), order="relative")
test replications elapsed relative user.self sys.self user.child
2 svd(M, 2, 0) 100 0.021 1.00000 0.02 0 0
3 prcomp(M) 100 0.043 2.04762 0.04 0 0
1 eigen(M) 100 0.050 2.38095 0.05 0 0
4 princomp(M) 100 0.065 3.09524 0.06 0 0
R>
но коэффициент в три относительно princomp() может стоить вам при восстановлении princomp() от svd(), поскольку svd() позволяет вам остановиться после двух значений.
Ответ 2
Пакет 'svd' предоставляет процедуры для усеченного SVD/eigendecomposition с помощью алгоритма Ланцоша. Вы можете использовать его для вычисления только первых двух основных компонентов.
Здесь у меня есть:
> library(svd)
> set.seed(42); N <- 1000; M <- matrix(rnorm(N*N), N, N)
> system.time(svd(M, 2, 0))
user system elapsed
7.355 0.069 7.501
> system.time(princomp(M))
user system elapsed
5.985 0.055 6.085
> system.time(prcomp(M))
user system elapsed
9.267 0.060 9.368
> system.time(trlan.svd(M, neig = 2))
user system elapsed
0.606 0.004 0.614
> system.time(trlan.svd(M, neig = 20))
user system elapsed
1.894 0.009 1.910
> system.time(propack.svd(M, neig = 20))
user system elapsed
1.072 0.011 1.087
Ответ 3
Я попробовал реализацию пакета pcaMethods алгоритма nipals. По умолчанию он вычисляет первые 2 основных компонента. Оказывается медленнее, чем другие предлагаемые методы.
set.seed(42); N <- 10; M <- matrix(rnorm(N*N), N, N)
library(pcaMethods)
library(rbenchmark)
m1 <- pca(M, method="nipals", nPcs=2)
benchmark(pca(M, method="nipals"),
eigen(M), svd(M,2,0), prcomp(M), princomp(M), order="relative")
test replications elapsed relative user.self sys.self
3 svd(M, 2, 0) 100 0.02 1.0 0.02 0
2 eigen(M) 100 0.03 1.5 0.03 0
4 prcomp(M) 100 0.03 1.5 0.03 0
5 princomp(M) 100 0.05 2.5 0.05 0
1 pca(M, method = "nipals") 100 0.23 11.5 0.24 0
Ответ 4
метод мощности может быть тем, что вы хотите. Если вы закодируете его в R, что совсем не сложно, я думаю, вы можете обнаружить, что он не быстрее, чем предложенный в другом ответе подход SVD, в котором используются скомпилированные подпрограммы LAPACK.
Ответ 5
Вы можете написать функцию самостоятельно и остановиться на 2 компонентах. Это не слишком сложно. Я его где-то кладу, если я найду его, я отправлю его.
Ответ 6
вы можете использовать подход нейронной сети для поиска основного компонента.
Основное описание приводится здесь.
http://www.heikohoffmann.de/htmlthesis/node26.html
Первый главный компонент, y = w1 * x1 + w2 * x2
и Второй ортогональный компонент можно вычислить как q = w2 * x1-w1 * x2.
Ответ 7
Пакеты "gmodels" и "corpcor" R поставляются с более быстрыми реализациями SVD и PCA. Они работают аналогично основным версиям для небольших матриц:
> set.seed(42); N <- 10; M <- matrix(rnorm(N*N), N*N, N)
> library("rbenchmark")
> library("gmodels")
> benchmark(svd(M,2,0), svd(M), gmodels::fast.svd(M), corpcor::fast.svd(M), prcomp(M), gmodels::fast.prcomp(M), princomp(M), order="relative")
test replications elapsed relative user.self sys.self user.child sys.child
1 svd(M, 2, 0) 100 0.005 1.0 0.005 0.000 0 0
2 svd(M) 100 0.006 1.2 0.005 0.000 0 0
3 gmodels::fast.svd(M) 100 0.007 1.4 0.006 0.000 0 0
4 corpcor::fast.svd(M) 100 0.007 1.4 0.007 0.000 0 0
6 gmodels::fast.prcomp(M) 100 0.014 2.8 0.014 0.000 0 0
5 prcomp(M) 100 0.015 3.0 0.014 0.001 0 0
7 princomp(M) 100 0.030 6.0 0.029 0.001 0 0
>
Тем не менее, они обеспечивают более быстрый результат для больших матриц (особенно с множеством строк).
> set.seed(42); N <- 10; M <- matrix(rnorm(N*N), N*N*N, N)
> library("rbenchmark")
> library("gmodels")
> benchmark(svd(M,2,0), svd(M), gmodels::fast.svd(M), corpcor::fast.svd(M), prcomp(M), gmodels::fast.prcomp(M), order="relative")
test replications elapsed relative user.self sys.self user.child sys.child
4 corpcor::fast.svd(M) 100 0.029 1.000 0.028 0.001 0 0
3 gmodels::fast.svd(M) 100 0.035 1.207 0.033 0.001 0 0
2 svd(M) 100 0.037 1.276 0.035 0.002 0 0
1 svd(M, 2, 0) 100 0.039 1.345 0.037 0.001 0 0
5 prcomp(M) 100 0.068 2.345 0.061 0.006 0 0
6 gmodels::fast.prcomp(M) 100 0.068 2.345 0.060 0.007 0 0
Ответ 8
Я удивлен, что никто еще не упомянул пакет irlba:
Он даже немного быстрее, чем svd propack.svd, предоставляет для удобства интерфейс irlba::prcomp_irlba(X, n=2) stats::prcomp -like и не требует настройки параметров в следующем тесте для прямоугольных матриц ( 2: 1) разного размера. Для матриц размером 6000x3000 это в 50 раз быстрее, чем stats::prcomp. Для матриц меньше 100x50 stats::svd все еще быстрее.
![benchmark results]()
library(microbenchmark)
library(tidyverse)
#install.packages("svd","corpcor","irlba","rsvd")
exprs <- rlang::exprs(
svd(M, 2, 2)$v,
prcomp(M)$rotation[,1:2],
irlba::prcomp_irlba(M, n=2)$rotation,
irlba::svdr(M, k=2)$v,
rsvd::rsvd(M, 2)$v,
svd::propack.svd(M, neig=2, opts=list(maxiter=100))$v,
corpcor::fast.svd(M)$v[,1:2]
)
set.seed(42)
tibble(N=c(10,30,100,300,1000,3000)) %>%
group_by(N) %>%
do({
M <- scale(matrix(rnorm(.$N*.$N*2), .$N*2, .$N))
microbenchmark(!!!exprs,
times=min(100, ceiling(3000/.$N)))%>%
as_tibble
}) %>%
ggplot(aes(x=N, y=time/1E9,color=expr)) +
geom_jitter(width=0.05) +
scale_x_log10("matrix size (2N x N)") +
scale_y_log10("time [s]") +
stat_summary(fun.y = median, geom="smooth") +
scale_color_discrete(labels = partial(str_wrap, width=30))
Рандомизированный svd, предоставляемый rsvd, еще быстрее, но, к сожалению, совсем не работает:
set.seed(42)
N <- 1000
M <- scale(matrix(rnorm(N^2*2), N*2, N))
cor(set_colnames(sapply(exprs, function(x) eval(x)[,1]), sapply(exprs, deparse)))
svd(M, 2, 2)$v prcomp(M)$rotation[, 1:2] irlba::prcomp_irlba(M, n = 2)$rotation irlba::svdr(M, k = 2)$v rsvd::rsvd(M, 2)$v svd::propack.svd(M, neig = 2, opts = list(maxiter = 100))$v corpcor::fast.svd(M)$v[, 1:2]
svd(M, 2, 2)$v 1.0000000 1.0000000 -1.0000000 0.9998748 0.286184 1.0000000 1.0000000
prcomp(M)$rotation[, 1:2] 1.0000000 1.0000000 -1.0000000 0.9998748 0.286184 1.0000000 1.0000000
irlba::prcomp_irlba(M, n = 2)$rotation -1.0000000 -1.0000000 1.0000000 -0.9998748 -0.286184 -1.0000000 -1.0000000
irlba::svdr(M, k = 2)$v 0.9998748 0.9998748 -0.9998748 1.0000000 0.290397 0.9998748 0.9998748
rsvd::rsvd(M, 2)$v 0.2861840 0.2861840 -0.2861840 0.2903970 1.000000 0.2861840 0.2861840
svd::propack.svd(M, neig = 2, opts = list(maxiter = 100))$v 1.0000000 1.0000000 -1.0000000 0.9998748 0.286184 1.0000000 1.0000000
corpcor::fast.svd(M)$v[, 1:2] 1.0000000 1.0000000 -1.0000000 0.9998748 0.286184 1.0000000 1.0000000
Это может быть лучше, если данные действительно имеют структуру.
