irlba/ 0000755 0001760 0000144 00000000000 14316626071 011401 5 ustar ripley users irlba/NAMESPACE 0000644 0001760 0000144 00000000564 13452171265 012625 0 ustar ripley users # Generated by roxygen2: do not edit by hand
S3method(summary,irlba_prcomp)
export(irlba)
export(partial_eigen)
export(prcomp_irlba)
export(ssvd)
export(svdr)
import(Matrix)
importFrom(methods,slot)
importFrom(methods,slotNames)
importFrom(stats,prcomp)
importFrom(stats,rnorm)
importFrom(stats,sd)
importFrom(stats,var)
useDynLib(irlba, .registration=TRUE, .fixes="C_")
irlba/README.md 0000644 0001760 0000144 00000012445 14153272154 012664 0 ustar ripley users # irlba
Implicitly-restarted Lanczos methods for fast truncated singular value
decomposition of sparse and dense matrices (also referred to as partial SVD).
IRLBA stands for Augmented, Implicitly Restarted Lanczos
Bidiagonalization Algorithm. The package provides the following
functions (see help on each for details and examples).
* `irlba()` partial SVD function
* `ssvd()` l1-penalized matrix decompoisition for sparse PCA (based on Shen and Huang's algorithm)
* `prcomp_irlba()` principal components function similar to the `prcomp` function in stats package for computing the first few principal components of large matrices
* `svdr()` alternate partial SVD function based on randomized SVD (see also the [rsvd](https://cran.r-project.org/package=rsvd) package by N. Benjamin Erichson for an alternative implementation)
* `partial_eigen()` a very limited partial eigenvalue decomposition for symmetric matrices (see the [RSpectra](https://cran.r-project.org/package=RSpectra) package for more comprehensive truncated eigenvalue decomposition)
Help documentation for each function includes extensive documentation and
examples. Also see the package vignette, `vignette("irlba", package="irlba")`.
An overview web page is here: https://bwlewis.github.io/irlba/.
## New in 2.3.2
- Fixed a regression in `prcomp_irlba()` discovered by Xiaojie Qiu, see https://github.com/bwlewis/irlba/issues/25, and other related problems reported in https://github.com/bwlewis/irlba/issues/32.
- Added rchk testing to pre-CRAN submission tests.
- Fixed a sign bug in `ssvd()` found by Alex Poliakov.
## What's new in Version 2.3.1?
- Fixed an `irlba()` bug associated with centering (PCA), see https://github.com/bwlewis/irlba/issues/21.
- Fixed `irlba()` scaling to conform to `scale`, see https://github.com/bwlewis/irlba/issues/22.
- Improved `prcomp_irlba()` from a suggestion by N. Benjamin Erichson, see https://github.com/bwlewis/irlba/issues/23.
- Significanty changed/improved `svdr()` convergence criterion.
- Added a version of Shen and Huang's Sparse PCA/SVD L1-penalized matrix decomposition (`ssvd()`).
- Fixed valgrind errors.
## Deprecated features
I will remove `partial_eigen()` in a future version. As its documentation
states, users are better off using the RSpectra package for eigenvalue
computations (although not generally for singular value computations).
The `mult` argument is deprecated and will be removed in a future version. We
now recommend simply defining a custom class with a custom multiplcation
operator. The example below illustrates the old and new approaches.
```{r}
library(irlba)
set.seed(1)
A <- matrix(rnorm(100), 10)
# ------------------ old way ----------------------------------------------
# A custom matrix multiplication function that scales the columns of A
# (cf the scale option). This function scales the columns of A to unit norm.
col_scale <- sqrt(apply(A, 2, crossprod))
mult <- function(x, y)
{
# check if x is a vector
if (is.vector(x))
{
return((x %*% y) / col_scale)
}
# else x is the matrix
x %*% (y / col_scale)
}
irlba(A, 3, mult=mult)$d
## [1] 1.820227 1.622988 1.067185
# Compare with:
irlba(A, 3, scale=col_scale)$d
## [1] 1.820227 1.622988 1.067185
# Compare with:
svd(sweep(A, 2, col_scale, FUN=`/`))$d[1:3]
## [1] 1.820227 1.622988 1.067185
# ------------------ new way ----------------------------------------------
setClass("scaled_matrix", contains="matrix", slots=c(scale="numeric"))
setMethod("%*%", signature(x="scaled_matrix", y="numeric"), function(x ,y) x@.Data %*% (y / x@scale))
setMethod("%*%", signature(x="numeric", y="scaled_matrix"), function(x ,y) (x %*% y@.Data) / y@scale)
a <- new("scaled_matrix", A, scale=col_scale)
irlba(a, 3)$d
## [1] 1.820227 1.622988 1.067185
```
We have learned that using R's existing S4 system is simpler, easier, and more
flexible than using custom arguments with idiosyncratic syntax and behavior.
We've even used the new approach to implement distributed parallel matrix
products for very large problems with amazingly little code.
## Wishlist / help wanted...
- More Matrix classes supported in the fast code path
- Help improving the solver for singular values in tricky cases (basically, for ill-conditioned problems and especially for the smallest singular values); in general this may require a combination of more careful convergence criteria and use of harmonic Ritz values; Dmitriy Selivanov has proposed alternative convergence criteria in https://github.com/bwlewis/irlba/issues/29 for example.
## References
* Baglama, James, and Lothar Reichel. "Augmented implicitly restarted Lanczos bidiagonalization methods." SIAM Journal on Scientific Computing 27.1 (2005): 19-42.
* Halko, Nathan, Per-Gunnar Martinsson, and Joel A. Tropp. "Finding structure with randomness: Stochastic algorithms for constructing approximate matrix decompositions." (2009).
* Shen, Haipeng, and Jianhua Z. Huang. "Sparse principal component analysis via regularized low rank matrix approximation." Journal of multivariate analysis 99.6 (2008): 1015-1034.
* Witten, Daniela M., Robert Tibshirani, and Trevor Hastie. "A penalized matrix decomposition, with applications to sparse principal components and canonical correlation analysis." Biostatistics 10.3 (2009): 515-534.
irlba/man/ 0000755 0001760 0000144 00000000000 13430560161 012145 5 ustar ripley users irlba/man/ssvd.Rd 0000644 0001760 0000144 00000021733 13430560161 013421 0 ustar ripley users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/ssvd.R
\name{ssvd}
\alias{ssvd}
\title{Sparse regularized low-rank matrix approximation.}
\usage{
ssvd(x, k = 1, n = 2, maxit = 500, tol = 0.001, center = FALSE,
scale. = FALSE, alpha = 0, tsvd = NULL, ...)
}
\arguments{
\item{x}{A numeric real- or complex-valued matrix or real-valued sparse matrix.}
\item{k}{Matrix rank of the computed decomposition (see the Details section below).}
\item{n}{Number of nonzero components in the right singular vectors. If \code{k > 1},
then a single value of \code{n} specifies the number of nonzero components
in each regularized right singular vector. Or, specify a vector of length
\code{k} indicating the number of desired nonzero components in each
returned vector. See the examples.}
\item{maxit}{Maximum number of soft-thresholding iterations.}
\item{tol}{Convergence is determined when \eqn{\|U_j - U_{j-1}\|_F < tol}{||U_j - U_{j-1}||_F < tol}, where \eqn{U_j} is the matrix of estimated left regularized singular vectors at iteration \eqn{j}.}
\item{center}{a logical value indicating whether the variables should be
shifted to be zero centered. Alternately, a centering vector of length
equal the number of columns of \code{x} can be supplied. Use \code{center=TRUE}
to perform a regularized sparse PCA.}
\item{scale.}{a logical value indicating whether the variables should be
scaled to have unit variance before the analysis takes place.
Alternatively, a vector of length equal the number of columns of \code{x} can be supplied.
The value of \code{scale} determines how column scaling is performed
(after centering). If \code{scale} is a numeric vector with length
equal to the number of columns of \code{x}, then each column of \code{x} is
divided by the corresponding value from \code{scale}. If \code{scale} is
\code{TRUE} then scaling is done by dividing the (centered) columns of
\code{x} by their standard deviations if \code{center=TRUE}, and the
root mean square otherwise. If \code{scale} is \code{FALSE}, no scaling is done.
See \code{\link{scale}} for more details.}
\item{alpha}{Optional scalar regularization parameter between zero and one (see Details below).}
\item{tsvd}{Optional initial rank-k truncated SVD or PCA (skips computation if supplied).}
\item{...}{Additional arguments passed to \code{\link{irlba}}.}
}
\value{
A list containing the following components:
\itemize{
\item{u} {regularized left singular vectors with orthonormal columns}
\item{d} {regularized upper-triangluar projection matrix so that \code{x \%*\% v == u \%*\% d}}
\item{v} {regularized, sparse right singular vectors with columns of unit norm}
\item{center, scale} {the centering and scaling used, if any}
\item{lambda} {the per-column regularization parameter found to obtain the desired sparsity}
\item{iter} {number of soft thresholding iterations}
\item{n} {value of input parameter \code{n}}
\item{alpha} {value of input parameter \code{alpha}}
}
}
\description{
Estimate an \eqn{{\ell}1}{l1}-penalized
singular value or principal components decomposition (SVD or PCA) that introduces sparsity in the
right singular vectors based on the fast and memory-efficient
sPCA-rSVD algorithm of Haipeng Shen and Jianhua Huang.
}
\details{
The \code{ssvd} function implements a version of an algorithm by
Shen and Huang that computes a penalized SVD or PCA that introduces
sparsity in the right singular vectors by solving a penalized least squares problem.
The algorithm in the rank 1 case finds vectors \eqn{u, w}{u, w} that minimize
\deqn{\|x - u w^T\|_F^2 + \lambda \|w\|_1}{||x - u w^T||_F^2 + lambda||w||_1}
such that \eqn{\|u\| = 1}{||u|| = 1},
and then sets \eqn{v = w / \|w\|}{v = w / ||w||} and
\eqn{d = u^T x v}{d = u^T x v};
see the referenced paper for details. The penalty \eqn{\lambda}{lambda} is
implicitly determined from the specified desired number of nonzero values \code{n}.
Higher rank output is determined similarly
but using a sequence of \eqn{\lambda}{lambda} values determined to maintain the desired number
of nonzero elements in each column of \code{v} specified by \code{n}.
Unlike standard SVD or PCA, the columns of the returned \code{v} when \code{k > 1} may not be orthogonal.
}
\note{
Our \code{ssvd} implementation of the Shen-Huang method makes the following choices:
\enumerate{
\item{The l1 penalty is the only available penalty function. Other penalties may appear in the future.}
\item{Given a desired number of nonzero elements in \code{v}, value(s) for the \eqn{\lambda}{lambda}
penalty are determined to achieve the sparsity goal subject to the parameter \code{alpha}.}
\item{An experimental block implementation is used for results with rank greater than 1 (when \code{k > 1})
instead of the deflation method described in the reference.}
\item{The choice of a penalty lambda associated with a given number of desired nonzero
components is not unique. The \code{alpha} parameter, a scalar between zero and one,
selects any possible value of lambda that produces the desired number of
nonzero entries. The default \code{alpha = 0} selects a penalized solution with
largest corresponding value of \code{d} in the 1-d case. Think of \code{alpha} as
fine-tuning of the penalty.}
\item{Our method returns an upper-triangular matrix \code{d} when \code{k > 1} so
that \code{x \%*\% v == u \%*\% d}. Non-zero
elements above the diagonal result from non-orthogonality of the \code{v} matrix,
providing a simple interpretation of cumulative information, or explained variance
in the PCA case, via the singular value decomposition of \code{d \%*\% t(v)}.}
}
What if you have no idea for values of the argument \code{n} (the desired sparsity)?
The reference describes a cross-validation and an ad-hoc approach; neither of which are
in the package yet. Both are prohibitively computationally expensive for matrices with a huge
number of columns. A future version of this package will include a revised approach to
automatically selecting a reasonable sparsity constraint.
Compare with the similar but more general functions \code{SPC} and \code{PMD} in the \code{PMA} package
by Daniela M. Witten, Robert Tibshirani, Sam Gross, and Balasubramanian Narasimhan.
The \code{PMD} function can compute low-rank regularized matrix decompositions with sparsity penalties
on both the \code{u} and \code{v} vectors. The \code{ssvd} function is
similar to the PMD(*, L1) method invocation of \code{PMD} or alternatively the \code{SPC} function.
Although less general than \code{PMD}(*),
the \code{ssvd} function can be faster and more memory efficient for the
basic sparse PCA problem.
See \url{https://bwlewis.github.io/irlba/ssvd.html} for more information.
(* Note that the s4vd package by Martin Sill and Sebastian Kaiser, \url{https://cran.r-project.org/package=s4vd},
includes a fast optimized version of a closely related algorithm by Shen, Huang, and Marron, that penalizes
both \code{u} and \code{v}.)
}
\examples{
set.seed(1)
u <- matrix(rnorm(200), ncol=1)
v <- matrix(c(runif(50, min=0.1), rep(0,250)), ncol=1)
u <- u / drop(sqrt(crossprod(u)))
v <- v / drop(sqrt(crossprod(v)))
x <- u \%*\% t(v) + 0.001 * matrix(rnorm(200*300), ncol=300)
s <- ssvd(x, n=50)
table(actual=v[, 1] != 0, estimated=s$v[, 1] != 0)
oldpar <- par(mfrow=c(2, 1))
plot(u, cex=2, main="u (black circles), Estimated u (blue discs)")
points(s$u, pch=19, col=4)
plot(v, cex=2, main="v (black circles), Estimated v (blue discs)")
points(s$v, pch=19, col=4)
# Let's consider a trivial rank-2 example (k=2) with noise. Like the
# last example, we know the exact number of nonzero elements in each
# solution vector of the noise-free matrix. Note the application of
# different sparsity constraints on each column of the estimated v.
# Also, the decomposition is unique only up to sign, which we adjust
# for below.
set.seed(1)
u <- qr.Q(qr(matrix(rnorm(400), ncol=2)))
v <- matrix(0, ncol=2, nrow=300)
v[sample(300, 15), 1] <- runif(15, min=0.1)
v[sample(300, 50), 2] <- runif(50, min=0.1)
v <- qr.Q(qr(v))
x <- u \%*\% (c(2, 1) * t(v)) + .001 * matrix(rnorm(200 * 300), 200)
s <- ssvd(x, k=2, n=colSums(v != 0))
# Compare actual and estimated vectors (adjusting for sign):
s$u <- sign(u) * abs(s$u)
s$v <- sign(v) * abs(s$v)
table(actual=v[, 1] != 0, estimated=s$v[, 1] != 0)
table(actual=v[, 2] != 0, estimated=s$v[, 2] != 0)
plot(v[, 1], cex=2, main="True v1 (black circles), Estimated v1 (blue discs)")
points(s$v[, 1], pch=19, col=4)
plot(v[, 2], cex=2, main="True v2 (black circles), Estimated v2 (blue discs)")
points(s$v[, 2], pch=19, col=4)
par(oldpar)
}
\references{
\itemize{
\item{Shen, Haipeng, and Jianhua Z. Huang. "Sparse principal component analysis via regularized low rank matrix approximation." Journal of multivariate analysis 99.6 (2008): 1015-1034.}
\item{Witten, Tibshirani and Hastie (2009) A penalized matrix decomposition, with applications to sparse principal components and canonical correlation analysis. _Biostatistics_ 10(3): 515-534.}
}
}
irlba/man/prcomp_irlba.Rd 0000644 0001760 0000144 00000007023 13430560161 015107 0 ustar ripley users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/prcomp.R
\name{prcomp_irlba}
\alias{prcomp_irlba}
\title{Principal Components Analysis}
\usage{
prcomp_irlba(x, n = 3, retx = TRUE, center = TRUE, scale. = FALSE, ...)
}
\arguments{
\item{x}{a numeric or complex matrix (or data frame) which provides
the data for the principal components analysis.}
\item{n}{integer number of principal component vectors to return, must be less than
\code{min(dim(x))}.}
\item{retx}{a logical value indicating whether the rotated variables should be returned.}
\item{center}{a logical value indicating whether the variables should be
shifted to be zero centered. Alternately, a centering vector of length
equal the number of columns of \code{x} can be supplied.}
\item{scale.}{a logical value indicating whether the variables should be
scaled to have unit variance before the analysis takes place.
The default is \code{FALSE} for consistency with S, but scaling is often advisable.
Alternatively, a vector of length equal the number of columns of \code{x} can be supplied.
The value of \code{scale} determines how column scaling is performed
(after centering). If \code{scale} is a numeric vector with length
equal to the number of columns of \code{x}, then each column of \code{x} is
divided by the corresponding value from \code{scale}. If \code{scale} is
\code{TRUE} then scaling is done by dividing the (centered) columns of
\code{x} by their standard deviations if \code{center=TRUE}, and the
root mean square otherwise. If \code{scale} is \code{FALSE}, no scaling is done.
See \code{\link{scale}} for more details.}
\item{...}{additional arguments passed to \code{\link{irlba}}.}
}
\value{
A list with class "prcomp" containing the following components:
\itemize{
\item{sdev} {the standard deviations of the principal components (i.e.,
the square roots of the eigenvalues of the
covariance/correlation matrix, though the calculation is
actually done with the singular values of the data matrix).}
\item{rotation} {the matrix of variable loadings (i.e., a matrix whose columns
contain the eigenvectors).}
\item {x} {if \code{retx} is \code{TRUE} the value of the rotated data (the centred
(and scaled if requested) data multiplied by the \code{rotation}
matrix) is returned. Hence, \code{cov(x)} is the diagonal matrix
\code{diag(sdev^2)}.}
\item{center, scale} {the centering and scaling used, or \code{FALSE}.}
}
}
\description{
Efficient computation of a truncated principal components analysis of a given data matrix
using an implicitly restarted Lanczos method from the \code{\link{irlba}} package.
}
\note{
The signs of the columns of the rotation matrix are arbitrary, and
so may differ between different programs for PCA, and even between
different builds of R.
NOTE DIFFERENCES WITH THE DEFAULT \code{\link{prcomp}} FUNCTION!
The \code{tol} truncation argument found in \code{prcomp} is not supported.
In place of the truncation tolerance in the original function, the
\code{prcomp_irlba} function has the argument \code{n} explicitly giving the
number of principal components to return. A warning is generated if the
argument \code{tol} is used, which is interpreted differently between
the two functions.
}
\examples{
set.seed(1)
x <- matrix(rnorm(200), nrow=20)
p1 <- prcomp_irlba(x, n=3)
summary(p1)
# Compare with
p2 <- prcomp(x, tol=0.7)
summary(p2)
}
\seealso{
\code{\link{prcomp}}
}
irlba/man/svdr.Rd 0000644 0001760 0000144 00000007745 13430560161 013427 0 ustar ripley users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/svdr.R
\name{svdr}
\alias{svdr}
\title{Find a few approximate largest singular values and corresponding
singular vectors of a matrix.}
\usage{
svdr(x, k, tol = 1e-05, it = 100L, extra = min(10L, dim(x) - k),
center = NULL, Q = NULL, return.Q = FALSE)
}
\arguments{
\item{x}{numeric real- or complex-valued matrix or real-valued sparse matrix.}
\item{k}{dimension of subspace to estimate (number of approximate singular values to compute).}
\item{tol}{stop iteration when the largest absolute relative change in estimated singular
values from one iteration to the next falls below this value.}
\item{it}{maximum number of algorithm iterations.}
\item{extra}{number of extra vectors of dimension \code{ncol(x)}, larger values generally improve accuracy (with increased
computational cost).}
\item{center}{optional column centering vector whose values are implicitly subtracted from each
column of \code{A} without explicitly forming the centered matrix (preserving sparsity).
Optionally specify \code{center=TRUE} as shorthand for \code{center=colMeans(x)}.
Use for efficient principal components computation.}
\item{Q}{optional initial random matrix, defaults to a matrix of size \code{ncol(x)} by \code{k + extra} with
entries sampled from a normal random distribution.}
\item{return.Q}{if \code{TRUE} return the \code{Q} matrix for restarting (see examples).}
}
\value{
Returns a list with entries:
\describe{
\item{d:}{ k approximate singular values}
\item{u:}{ k approximate left singular vectors}
\item{v:}{ k approximate right singular vectors}
\item{mprod:}{ total number of matrix products carried out}
\item{Q:}{ optional subspace matrix (when \code{return.Q=TRUE})}
}
}
\description{
The randomized method for truncated SVD by P. G. Martinsson and colleagues
finds a few approximate largest singular values and corresponding
singular vectors of a sparse or dense matrix. It is a fast and
memory-efficient way to compute a partial SVD, similar in performance
for many problems to \code{\link{irlba}}. The \code{svdr} method
is a block method and may produce more accurate estimations with
less work for problems with clustered large singular values (see
the examples). In other problems, \code{irlba} may exhibit faster
convergence.
}
\details{
Also see an alternate implementation (\code{rsvd}) of this method by N. Benjamin Erichson
in the https://cran.r-project.org/package=rsvd package.
}
\examples{
set.seed(1)
A <- matrix(runif(400), nrow=20)
svdr(A, 3)$d
# Compare with svd
svd(A)$d[1:3]
# Compare with irlba
irlba(A, 3)$d
\dontrun{
# A problem with clustered large singular values where svdr out-performs irlba.
tprolate <- function(n, w=0.25)
{
a <- rep(0, n)
a[1] <- 2 * w
a[2:n] <- sin( 2 * pi * w * (1:(n-1)) ) / ( pi * (1:(n-1)) )
toeplitz(a)
}
x <- tprolate(512)
set.seed(1)
tL <- system.time(L <- irlba(x, 20))
tR <- system.time(R <- svdr(x, 20))
S <- svd(x)
plot(S$d)
data.frame(time=c(tL[3], tR[3]),
error=sqrt(c(crossprod(L$d - S$d[1:20]), crossprod(R$d - S$d[1:20]))),
row.names=c("IRLBA", "Randomized SVD"))
# But, here is a similar problem with clustered singular values where svdr
# doesn't out-perform irlba as easily...clusters of singular values are,
# in general, very hard to deal with!
# (This example based on https://github.com/bwlewis/irlba/issues/16.)
set.seed(1)
s <- svd(matrix(rnorm(200 * 200), 200))
x <- s$u \%*\% (c(exp(-(1:100)^0.3) * 1e-12 + 1, rep(0.5, 100)) * t(s$v))
tL <- system.time(L <- irlba(x, 5))
tR <- system.time(R <- svdr(x, 5))
S <- svd(x)
plot(S$d)
data.frame(time=c(tL[3], tR[3]),
error=sqrt(c(crossprod(L$d - S$d[1:5]), crossprod(R$d - S$d[1:5]))),
row.names=c("IRLBA", "Randomized SVD"))
}
}
\references{
Finding structure with randomness: Stochastic algorithms for constructing
approximate matrix decompositions N. Halko, P. G. Martinsson, J. Tropp. Sep. 2009.
}
\seealso{
\code{\link{irlba}}, \code{\link{svd}}, \code{rsvd} in the rsvd package
}
irlba/man/irlba.Rd 0000644 0001760 0000144 00000023733 13430560161 013535 0 ustar ripley users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/irlba.R
\name{irlba}
\alias{irlba}
\title{Find a few approximate singular values and corresponding
singular vectors of a matrix.}
\usage{
irlba(A, nv = 5, nu = nv, maxit = 1000, work = nv + 7, reorth = TRUE,
tol = 1e-05, v = NULL, right_only = FALSE, verbose = FALSE,
scale = NULL, center = NULL, shift = NULL, mult = NULL,
fastpath = TRUE, svtol = tol, smallest = FALSE, ...)
}
\arguments{
\item{A}{numeric real- or complex-valued matrix or real-valued sparse matrix.}
\item{nv}{number of right singular vectors to estimate.}
\item{nu}{number of left singular vectors to estimate (defaults to \code{nv}).}
\item{maxit}{maximum number of iterations.}
\item{work}{working subspace dimension, larger values can speed convergence at the cost of more memory use.}
\item{reorth}{if \code{TRUE}, apply full reorthogonalization to both SVD bases, otherwise
only apply reorthogonalization to the right SVD basis vectors; the latter case is cheaper per
iteration but, overall, may require more iterations for convergence. Automatically \code{TRUE}
when \code{fastpath=TRUE} (see below).}
\item{tol}{convergence is determined when \eqn{\|A^TU - VS\| < tol\|A\|}{||A^T U - VS|| < tol*||A||},
and when the maximum relative change in estimated singular values from one iteration to the
next is less than \code{svtol = tol} (see \code{svtol} below),
where the spectral norm ||A|| is approximated by the
largest estimated singular value, and U, V, S are the matrices corresponding
to the estimated left and right singular vectors, and diagonal matrix of
estimated singular values, respectively.}
\item{v}{optional starting vector or output from a previous run of \code{irlba} used
to restart the algorithm from where it left off (see the notes).}
\item{right_only}{logical value indicating return only the right singular vectors
(\code{TRUE}) or both sets of vectors (\code{FALSE}). The right_only option can be
cheaper to compute and use much less memory when \code{nrow(A) >> ncol(A)} but note
that obtained solutions typically lose accuracy due to lack of re-orthogonalization in the
algorithm and that \code{right_only = TRUE} sets \code{fastpath = FALSE} (only use this option
for really large problems that run out of memory and when \code{nrow(A) >> ncol(A)}).
Consider increasing the \code{work} option to improve accuracy with \code{right_only=TRUE}.}
\item{verbose}{logical value that when \code{TRUE} prints status messages during the computation.}
\item{scale}{optional column scaling vector whose values divide each column of \code{A};
must be as long as the number of columns of \code{A} (see notes).}
\item{center}{optional column centering vector whose values are subtracted from each
column of \code{A}; must be as long as the number of columns of \code{A} and may
not be used together with the deflation options below (see notes).}
\item{shift}{optional shift value (square matrices only, see notes).}
\item{mult}{DEPRECATED optional custom matrix multiplication function (default is \code{\%*\%}, see notes).}
\item{fastpath}{try a fast C algorithm implementation if possible; set \code{fastpath=FALSE} to use the
reference R implementation. See the notes for more details.}
\item{svtol}{additional stopping tolerance on maximum allowed absolute relative change across each
estimated singular value between iterations.
The default value of this parameter is to set it to \code{tol}. You can set \code{svtol=Inf} to
effectively disable this stopping criterion. Setting \code{svtol=Inf} allows the method to
terminate on the first Lanczos iteration if it finds an invariant subspace, but with less certainty
that the converged subspace is the desired one. (It may, for instance, miss some of the largest
singular values in difficult problems.)}
\item{smallest}{set \code{smallest=TRUE} to estimate the smallest singular values and associated
singular vectors. WARNING: this option is somewhat experimental, and may produce poor
estimates for ill-conditioned matrices.}
\item{...}{optional additional arguments used to support experimental and deprecated features.}
}
\value{
Returns a list with entries:
\describe{
\item{d:}{ max(nu, nv) approximate singular values}
\item{u:}{ nu approximate left singular vectors (only when right_only=FALSE)}
\item{v:}{ nv approximate right singular vectors}
\item{iter:}{ The number of Lanczos iterations carried out}
\item{mprod:}{ The total number of matrix vector products carried out}
}
}
\description{
The augmented implicitly restarted Lanczos bidiagonalization algorithm
(IRLBA) finds a few approximate largest (or, optionally, smallest) singular
values and corresponding
singular vectors of a sparse or dense matrix using a method of Baglama and
Reichel. It is a fast and memory-efficient way to compute a partial SVD.
}
\note{
The syntax of \code{irlba} partially follows \code{svd}, with an important
exception. The usual R \code{svd} function always returns a complete set of
singular values, even if the number of singular vectors \code{nu} or \code{nv}
is set less than the maximum. The \code{irlba} function returns a number of
estimated singular values equal to the maximum of the number of specified
singular vectors \code{nu} and \code{nv}.
Use the optional \code{scale} parameter to implicitly scale each column of
the matrix \code{A} by the values in the \code{scale} vector, computing the
truncated SVD of the column-scaled \code{sweep(A, 2, scale, FUN=`/`)}, or
equivalently, \code{A \%*\% diag(1 / scale)}, without explicitly forming the
scaled matrix. \code{scale} must be a non-zero vector of length equal
to the number of columns of \code{A}.
Use the optional \code{center} parameter to implicitly subtract the values
in the \code{center} vector from each column of \code{A}, computing the
truncated SVD of \code{sweep(A, 2, center, FUN=`-`)},
without explicitly forming the centered matrix. \code{center}
must be a vector of length equal to the number of columns of \code{A}.
This option may be used to efficiently compute principal components without
explicitly forming the centered matrix (which can, importantly, preserve
sparsity in the matrix). See the examples.
The optional \code{shift} scalar valued argument applies only to square matrices; use it
to estimate the partial svd of \code{A + diag(shift, nrow(A), nrow(A))}
(without explicitly forming the shifted matrix).
(Deprecated) Specify an optional alternative matrix multiplication operator in the
\code{mult} parameter. \code{mult} must be a function of two arguments,
and must handle both cases where one argument is a vector and the other
a matrix. This option is deprecated and will be removed in a future version.
The new preferred method simply uses R itself to define a custom matrix class
with your user-defined matrix multiplication operator. See the examples.
Use the \code{v} option to supply a starting vector for the iterative
method. A random vector is used by default (precede with \code{set.seed()}
for reproducibility). Optionally set \code{v} to
the output of a previous run of \code{irlba} to restart the method, adding
additional singular values/vectors without recomputing the solution
subspace. See the examples.
The function may generate the following warnings:
\itemize{
\item{"did not converge--results might be invalid!; try increasing work or maxit"
means that the algorithm didn't
converge -- this is potentially a serious problem and the returned results may not be valid. \code{irlba}
reports a warning here instead of an error so that you can inspect whatever is returned. If this
happens, carefully heed the warning and inspect the result. You may also try setting \code{fastpath=FALSE}.}
\item{"You're computing a large percentage of total singular values, standard svd might work better!"
\code{irlba} is designed to efficiently compute a few of the largest singular values and associated
singular vectors of a matrix. The standard \code{svd} function will be more efficient for computing
large numbers of singular values than \code{irlba}.}
\item{"convergence criterion below machine epsilon" means that the product of \code{tol} and the
largest estimated singular value is really small and the normal convergence criterion is only
met up to round off error.}
}
The function might return an error for several reasons including a situation when the starting
vector \code{v} is near the null space of the matrix. In that case, try a different \code{v}.
The \code{fastpath=TRUE} option only supports real-valued matrices and sparse matrices
of type \code{dgCMatrix} (for now). Other problems fall back to the reference
R implementation.
}
\examples{
set.seed(1)
A <- matrix(runif(400), nrow=20)
S <- irlba(A, 3)
S$d
# Compare with svd
svd(A)$d[1:3]
# Restart the algorithm to compute more singular values
# (starting with an existing solution S)
S1 <- irlba(A, 5, v=S)
# Estimate smallest singular values
irlba(A, 3, smallest=TRUE)$d
#Compare with
tail(svd(A)$d, 3)
# Principal components (see also prcomp_irlba)
P <- irlba(A, nv=1, center=colMeans(A))
# Compare with prcomp and prcomp_irlba (might vary up to sign)
cbind(P$v,
prcomp(A)$rotation[, 1],
prcomp_irlba(A)$rotation[, 1])
# A custom matrix multiplication function that scales the columns of A
# (cf the scale option). This function scales the columns of A to unit norm.
col_scale <- sqrt(apply(A, 2, crossprod))
setClass("scaled_matrix", contains="matrix", slots=c(scale="numeric"))
setMethod("\%*\%", signature(x="scaled_matrix", y="numeric"),
function(x ,y) x@.Data \%*\% (y / x@scale))
setMethod("\%*\%", signature(x="numeric", y="scaled_matrix"),
function(x ,y) (x \%*\% y@.Data) / y@scale)
a <- new("scaled_matrix", A, scale=col_scale)
irlba(a, 3)$d
# Compare with:
svd(sweep(A, 2, col_scale, FUN=`/`))$d[1:3]
}
\references{
Baglama, James, and Lothar Reichel. "Augmented implicitly restarted Lanczos bidiagonalization methods." SIAM Journal on Scientific Computing 27.1 (2005): 19-42.
}
\seealso{
\code{\link{svd}}, \code{\link{prcomp}}, \code{\link{partial_eigen}}, \code{\link{svdr}}
}
irlba/man/partial_eigen.Rd 0000644 0001760 0000144 00000004242 13430560161 015241 0 ustar ripley users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/eigen.R
\name{partial_eigen}
\alias{partial_eigen}
\title{Find a few approximate largest eigenvalues and corresponding eigenvectors of a symmetric matrix.}
\usage{
partial_eigen(x, n = 5, symmetric = TRUE, ...)
}
\arguments{
\item{x}{numeric real-valued dense or sparse matrix.}
\item{n}{number of largest eigenvalues and corresponding eigenvectors to compute.}
\item{symmetric}{\code{TRUE} indicates \code{x} is a symmetric matrix (the default);
specify \code{symmetric=FALSE} to compute the largest eigenvalues and corresponding
eigenvectors of \code{t(x) \%*\% x} instead.}
\item{...}{optional additional parameters passed to the \code{irlba} function.}
}
\value{
Returns a list with entries:
\itemize{
\item{values}{ n approximate largest eigenvalues}
\item{vectors}{ n approximate corresponding eigenvectors}
}
}
\description{
Use \code{partial_eigen} to estimate a subset of the largest (most positive)
eigenvalues and corresponding eigenvectors of a symmetric dense or sparse
real-valued matrix.
}
\note{
Specify \code{symmetric=FALSE} to compute the largest \code{n} eigenvalues
and corresponding eigenvectors of the symmetric matrix cross-product
\code{t(x) \%*\% x}.
This function uses the \code{irlba} function under the hood. See \code{?irlba}
for description of additional options, especially the \code{tol} parameter.
See the RSpectra package https://cran.r-project.org/package=RSpectra for more comprehensive
partial eigenvalue decomposition.
}
\examples{
set.seed(1)
# Construct a symmetric matrix with some positive and negative eigenvalues:
V <- qr.Q(qr(matrix(runif(100), nrow=10)))
x <- V \%*\% diag(c(10, -9, 8, -7, 6, -5, 4, -3, 2, -1)) \%*\% t(V)
partial_eigen(x, 3)$values
# Compare with eigen
eigen(x)$values[1:3]
# Use symmetric=FALSE to compute the eigenvalues of t(x) \%*\% x for general
# matrices x:
x <- matrix(rnorm(100), 10)
partial_eigen(x, 3, symmetric=FALSE)$values
eigen(crossprod(x))$values
}
\references{
Augmented Implicitly Restarted Lanczos Bidiagonalization Methods, J. Baglama and L. Reichel, SIAM J. Sci. Comput. 2005.
}
\seealso{
\code{\link{eigen}}, \code{\link{irlba}}
}
irlba/man/summary.irlba_prcomp.Rd 0000644 0001760 0000144 00000000765 13430560161 016611 0 ustar ripley users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/prcomp.R
\name{summary.irlba_prcomp}
\alias{summary.irlba_prcomp}
\title{Summary method for truncated pca objects computed by \code{prcomp_irlba}.}
\usage{
\method{summary}{irlba_prcomp}(object, ...)
}
\arguments{
\item{object}{An object returned by \code{prcomp_irlba}.}
\item{...}{Optional arguments passed to \code{summary}.}
}
\description{
Summary method for truncated pca objects computed by \code{prcomp_irlba}.
}
irlba/DESCRIPTION 0000644 0001760 0000144 00000002022 14316626071 013103 0 ustar ripley users Package: irlba
Type: Package
Title: Fast Truncated Singular Value Decomposition and Principal
Components Analysis for Large Dense and Sparse Matrices
Version: 2.3.5.1
Date: 2021-12-05
Authors@R: c(
person("Jim", "Baglama", role=c("aut", "cph"), email="jbaglama@uri.edu"),
person("Lothar", "Reichel", role=c("aut", "cph"), email="reichel@math.kent.edu"),
person("B. W.", "Lewis", role=c("aut","cre","cph"), email="blewis@illposed.net"))
Description: Fast and memory efficient methods for truncated singular value
decomposition and principal components analysis of large sparse and dense
matrices.
Depends: R (>= 3.6.2), Matrix
LinkingTo: Matrix
Imports: stats, methods
License: GPL-3
BugReports: https://github.com/bwlewis/irlba/issues
RoxygenNote: 5.0.1
NeedsCompilation: yes
Packaged: 2022-10-03 15:17:05 UTC; ripley
Author: Jim Baglama [aut, cph],
Lothar Reichel [aut, cph],
B. W. Lewis [aut, cre, cph]
Maintainer: B. W. Lewis
Repository: CRAN
Date/Publication: 2022-10-03 18:38:49 UTC
irlba/build/ 0000755 0001760 0000144 00000000000 14153273722 012500 5 ustar ripley users irlba/build/vignette.rds 0000644 0001760 0000144 00000000305 14153273722 015035 0 ustar ripley users b```b`a@&0`b fd`aҜE9IzAyh<` ļ
R$@
`
` sST楀 Mwjey~L6̜T!%psQY_/
@?{49'ݣ\)%ziE@ w
irlba/tests/ 0000755 0001760 0000144 00000000000 13430560161 012534 5 ustar ripley users irlba/tests/ssvd.R 0000644 0001760 0000144 00000001734 13430560161 013643 0 ustar ripley users # Tests for sparse SVD/PCA
require("irlba")
loc <- ""
test <- function()
{
on.exit(message("Error occured in: ", loc))
loc <<- "sparse SVD"
set.seed(1)
x <- matrix(rnorm(100), 10)
s <- ssvd(x, 1, n=5)
stopifnot(isTRUE(all.equal(sqrt(drop(crossprod(x %*% s$v - s$u %*% s$d))), 0)))
loc <<- "sparse PCA"
set.seed(1)
x <- matrix(rnorm(100), 10)
s <- ssvd(x, 1, n=5, center=TRUE)
stopifnot(isTRUE(all.equal(sqrt(drop(crossprod(scale(x, center=TRUE, scale=FALSE) %*% s$v - s$u %*% s$d))), 0)))
loc <<- "sparse PCA + scale"
set.seed(1)
x <- matrix(rnorm(100), 10)
s <- ssvd(x, 1, n=5, center=TRUE, scale.=TRUE)
isTRUE(all.equal(sqrt(drop(crossprod(scale(x, center=TRUE, scale=TRUE) %*% s$v - s$u %*% s$d))), 0))
loc <<- "sparse scaled"
set.seed(1)
x <- matrix(rnorm(100), 10)
s <- ssvd(x, 1, n=5, center=FALSE, scale.=TRUE)
isTRUE(all.equal(sqrt(drop(crossprod(scale(x, center=FALSE, scale=TRUE) %*% s$v - s$u %*% s$d))), 0))
on.exit()
}
test()
irlba/tests/edge.R 0000644 0001760 0000144 00000005045 13430560161 013567 0 ustar ripley users # Tests for a few edge cases
require("irlba")
loc <- ""
test <- function()
{
on.exit(message("Error occured in: ", loc))
# Dense matrix
loc <<- "dense"
set.seed(1)
A <- matrix(rnorm(16), 4)
L <- irlba(A, nu=1, nv=1, tol=1e-9, fastpath=FALSE)
L1 <- irlba(A, nu=1, nv=1, tol=1e-9, fastpath=TRUE)
S <- svd(A, nu=1, nv=1)
if (!isTRUE(all.equal(L$d, S$d[1])))
{
stop("Failed tiny reference example ")
}
if (!isTRUE(all.equal(L1$d, S$d[1])))
{
stop("Failed tiny fastpath example")
}
# Tickle misc. checks
loc <<- "misc"
set.seed(1)
A <- matrix(rnorm(100), 10)
L <- tryCatch(irlba(A, nv=3, tol=1e-9, fastpath=FALSE, work=2, v=rep(0, nrow(A))), error=function(e) "NULLSPACE")
S <- svd(A)
L <- irlba(A, nv=3, tol=1e-9, fastpath=FALSE, work=2, v=S$v[, 1])
A <- S$u %*% diag(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1e-12)) %*% t(S$v)
L <- irlba(A, nv=3, tol=1e-9, fastpath=FALSE, work=2, reorth=FALSE)
# Convergence
loc <<- "convergence"
A <- S$u %*% (c(1e-5, rep(1e-9, 9)) * t(S$v))
for (tol in 10 ^ - (7:11))
{
L <- irlba(A, 3, tol=tol, svtol=Inf)
converged <- svd(A %*% L$v - L$u %*% diag(L$d))$d[1] < tol * L$d[1]
stopifnot(converged)
}
# Sparse but not dgCMatrix (issue #6)
loc <<- "misc sparse"
A <- Matrix(matrix(rnorm(100), 10))
L <- irlba(A, nv=1)
S <- svd(A, nu=1, nv=1)
if (!isTRUE(all.equal(L$d, S$d[1])))
{
stop("Failed general sparse matrix example ")
}
A <- Matrix(sample(c(FALSE, TRUE), 100, replace=TRUE), 10, 10)
L <- irlba(A, nv=1)
S <- svd(A, nu=1, nv=1)
if (!isTRUE(all.equal(L$d, S$d[1])))
{
stop("Failed logical sparse matrix example ")
}
# Test for issue #7, a really dumb bug.
loc <<- "issue 7"
mx <- matrix(sample(1:10, 10 * 100, replace=TRUE), nrow=10)
S <- irlba(mx, nv=2, verbose=TRUE, center=colMeans(mx), right_only=TRUE)
# test for issue #9
loc <<- "issue 9"
set.seed(2)
s1 <- irlba(diag(c(1, 2, 3, 4, 5, 0, 0, 0, 0)), 4, fastpath=FALSE)
set.seed(2)
s2 <- irlba(diag(c(1, 2, 3, 4, 5, 0, 0, 0, 0)), 4, fastpath=TRUE)
stopifnot(all.equal(s1$d, s2$d))
# Repeat this test with different seed
set.seed(3)
s2 <- irlba(diag(c(1, 2, 3, 4, 5, 0, 0, 0, 0)), 4, fastpath=TRUE)
stopifnot(all.equal(s1$d, s2$d))
loc <<- "issue 26"
set.seed(1)
r <- 10
n <- 1000
X1 <- matrix(rnorm(n * r), n)
X2 <- matrix(rnorm(n * r), n)
X <- X1 %*% t(X2)
l <- irlba(X, 20, fastpath=TRUE)$d
stopifnot(all.equal(tail(l, 10), rep(0, 10)))
l <- irlba(X, 20, fastpath=FALSE)$d
stopifnot(all.equal(tail(l, 10), rep(0, 10)))
on.exit()
}
test()
irlba/tests/prcomp.r 0000644 0001760 0000144 00000007701 13430560161 014224 0 ustar ripley users require("irlba")
# prcomp convenience function
x <- matrix(rnorm(200), nrow=20)
p1 <- prcomp_irlba(x, n=3)
p2 <- prcomp(x, tol=0.7)
if (!isTRUE(all.equal(p1$sdev[1:2], p2$sdev[1:2])))
{
stop("Failed basic prcomp test")
}
s <- summary(p1)
# scaling bug identified in issue #21
normalize_signs <- function(X, Y) {
for (i in 1:ncol(X)) {
if (sign(X[1, i]) != sign(Y[1, i])) {
Y[, i] <- -Y[, i]
}
}
return(Y)
}
all.equal_pca <- function(X, Y) {
Y <- normalize_signs(X, Y)
return(all.equal(X, Y, check.attributes=F, tolerance=1e-4))
}
set.seed(1)
X <- matrix(rnorm(2000), ncol=40)
M <- 5 # number of PCA components
centers <- colMeans(X)
sds <- apply(X, 2, sd)
rms <- apply(X, 2, function(x) sqrt(sum(x^2) / (length(x) - 1)))
Xc <- sweep(X, 2, centers, `-`)
Xs <- sweep(X, 2, sds, `/`)
Xcs <- sweep(Xc, 2, sds, `/`)
Xrms <- sweep(X, 2, rms, `/`)
# unscaled
scaled <- FALSE
centered <- FALSE
pca <- prcomp(X, center=centered, scale.=scaled)
sv <- svd(X)
svir <- irlba(X, nv=M, nu=M)
pcair <- prcomp_irlba(X, n=M, center=centered, scale.=scaled)
Xpca <- predict(pca)[, 1:M]
Xsvl <- sv$u[, 1:M] %*% diag(sv$d[1:M])
Xsvr <- X %*% sv$v[, 1:M]
Xsvirl <- svir$u %*% diag(svir$d)
Xsvirr <- X %*% svir$v
Xpcair <- predict(pcair)
Xpcair2 <- X %*% pcair$rotation
if (! isTRUE(all.equal_pca(Xsvl, Xsvr)) &&
isTRUE(all.equal_pca(Xpca, Xsvl)) &&
isTRUE(all.equal_pca(Xsvirl, Xsvirr)) &&
isTRUE(all.equal_pca(Xpca, Xsvirl)) &&
isTRUE(all.equal_pca(Xpcair, Xpcair2)) &&
isTRUE(all.equal_pca(Xpca, Xpcair)) &&
isTRUE(all.equal_pca(Xpcair, Xsvirl)))
{
stop("failed unscaled, uncentered prcomp")
}
# scaled, uncentered
scaled <- TRUE
centered <- FALSE
pca <- prcomp(X, center=centered, scale.=scaled)
sv <- svd(Xrms)
svir <- irlba(X, nv=M, nu=M, scale=rms)
pcair <- prcomp_irlba(X, n=M, center=centered, scale.=scaled)
Xpca <- predict(pca)[, 1:M]
Xsvl <- sv$u[, 1:M] %*% diag(sv$d[1:M])
Xsvr <- Xrms %*% sv$v[, 1:M]
Xsvirl <- svir$u %*% diag(svir$d)
Xsvirr <- Xrms %*% svir$v
Xpcair <- predict(pcair)
Xpcair2 <- Xrms %*% pcair$rotation
if (! isTRUE(all.equal_pca(Xsvl, Xsvr)) &&
isTRUE(all.equal_pca(Xpca, Xsvl)) &&
isTRUE(all.equal_pca(Xsvirl, Xsvirr)) &&
isTRUE(all.equal_pca(Xpca, Xsvirl)) &&
isTRUE(all.equal_pca(Xpcair, Xpcair2)) &&
isTRUE(all.equal_pca(Xpca, Xpcair)) &&
isTRUE(all.equal_pca(Xpcair, Xsvirl)))
{
stop("failed scaled, uncentered prcomp")
}
# issue #25 prcomp_irlba regression (error in scale. handling)
set.seed(1)
x <- matrix(rnorm(100), 10)
p <- prcomp_irlba(x, 3, scale.=TRUE, fastpath=FALSE)
p <- prcomp_irlba(x, 3, scale.=TRUE, fastpath=TRUE)
# issue #32 (and also issue #25 redux) more checks for proper
# variance proportion computation
library(irlba)
set.seed(1)
x <- matrix(rnorm(200), nrow=20)
n <- 3
s1 <- summary(prcomp_irlba(x, n=n, center=TRUE, scale.=FALSE))
s2 <- summary(prcomp(x, tol=0.7, center=TRUE, scale.=FALSE))
if (! isTRUE(all.equal(s1$sdev, s2$sdev[1:n]) &&
all.equal(s1$importance, s2$importance[, 1:n])))
{
stop("center=TRUE scale.=FALSE prcomp variance computation")
}
s1 <- summary(prcomp_irlba(x, n=3, center=TRUE, scale.=TRUE))
s2 <- summary(prcomp(x, tol=0.8, center=TRUE, scale.=TRUE))
if (! isTRUE(all.equal(s1$sdev, s2$sdev[1:n]) &&
all.equal(s1$importance, s2$importance[, 1:n])))
{
stop("center=TRUE scale.=TRUE prcomp variance computation")
}
s1 <- summary(prcomp_irlba(x, n=3, center=FALSE, scale.=TRUE))
s2 <- summary(prcomp(x, tol=0.8, center=FALSE, scale.=TRUE))
if (! isTRUE(all.equal(s1$sdev, s2$sdev[1:n]) &&
all.equal(s1$importance, s2$importance[, 1:n])))
{
stop("center=FALSE scale.=TRUE prcomp variance computation")
}
s1 <- summary(prcomp_irlba(x, n=3, center=FALSE, scale.=FALSE))
s2 <- summary(prcomp(x, tol=0.7, center=FALSE, scale.=FALSE))
if (! isTRUE(all.equal(s1$sdev, s2$sdev[1:n]) &&
all.equal(s1$importance, s2$importance[, 1:n])))
{
stop("center=FALSE, scale.=FALSE prcomp variance computation")
}
irlba/tests/svdr.R 0000644 0001760 0000144 00000002316 13430560161 013637 0 ustar ripley users # Tests for svdr
require("irlba")
loc <- ""
test <- function()
{
on.exit(message("Error occured in: ", loc))
# Dense matrix
loc <<- "svdr dense"
set.seed(1)
A <- matrix(rnorm(16), 4)
L <- svdr(A, 1)
S <- svd(A, nu=1, nv=1)
stopifnot(isTRUE(all.equal(L$d, S$d[1])))
loc <<- "svdr dense m > n"
A <- matrix(rnorm(50 * 40), 50)
L <- svdr(A, 5, extra=15)
S <- svd(A, nu=5, nv=5)
stopifnot(isTRUE(all.equal(L$d, S$d[1:5])))
loc <<- "svdr dense m < n"
A <- matrix(rnorm(50 * 40), 40)
L <- svdr(A, 5, extra=15)
S <- svd(A, nu=5, nv=5)
stopifnot(isTRUE(all.equal(L$d, S$d[1:5])))
# Sparse but not dgCMatrix (issue #6)
loc <<- "svdr misc sparse"
A <- Matrix(matrix(rnorm(100), 10))
L <- svdr(A, 1)
S <- svd(A, nu=1, nv=1)
stopifnot(isTRUE(all.equal(L$d, S$d[1])))
loc <<- "svdr logical sparse"
A <- Matrix(sample(c(FALSE, TRUE), 100, replace=TRUE), 10, 10)
L <- svdr(A, 1)
S <- svd(A, nu=1, nv=1)
stopifnot(isTRUE(all.equal(L$d, S$d[1])))
loc <<- "svdr center only, sparse"
A <- Matrix(matrix(rnorm(100), 10))
m <- colMeans(A)
L <- svdr(A, 3, center=m)
S <- svd(scale(A, center=TRUE, scale=FALSE))
stopifnot(isTRUE(all.equal(L$d, S$d[1:3])))
on.exit()
}
test()
irlba/tests/test.R 0000644 0001760 0000144 00000015110 13430560161 013634 0 ustar ripley users require("irlba")
for (FAST in c(FALSE, TRUE))
{
# Dense matrix
set.seed(1)
A <- matrix(rnorm(400), 20)
L <- irlba(A, nu=2, nv=2, tol=1e-9, fastpath=FAST)
S <- svd(A, nu=2, nv=2)
if (!isTRUE(all.equal(L$d, S$d[1:2])))
{
stop("Failed simple dense singular value test", " fastpath=", FAST)
}
# restart
L1 <- irlba(A, nv=3, v=L, fastpath=FAST)
if (!isTRUE(all.equal(L1$d, S$d[1:3])))
{
stop("Failed restart", " fastpath=", FAST)
}
# unequal nu, nv
L <- irlba(A, nv=2, nu=3, fastpath=FAST)
if (!isTRUE(ncol(L$v) == 2 && ncol(L$u) == 3))
{
stop("Failed unequal nu,nv", " fastpath=", FAST)
}
# Scaling and centering, dense
s <- sqrt(apply(A, 2, crossprod))
m <- colMeans(A)
L <- irlba(A, 3, tol=1e-9, center=m, scale=s, fastpath=FAST)
S <- svd(scale(A, center=TRUE, scale=s))
if (!isTRUE(all.equal(L$d, S$d[1:3])))
{
stop("Failed scaling/centering test", " fastpath=", FAST)
}
# Scale only, non-square, dense
A <- matrix(rnorm(200), 10)
s <- seq(1, ncol(A))
m <- colMeans(A)
L <- irlba(A, 3, tol=1e-9, scale=s, fastpath=FAST)
S <- svd(scale(A, center=FALSE, scale=s))
if (!isTRUE(all.equal(L$d, S$d[1:3])))
{
stop("Failed dense scaling test", " fastpath=", FAST)
}
# Center only, non-square, dense
L <- irlba(A, 3, tol=1e-9, center=m, fastpath=FAST)
S <- svd(scale(A, center=TRUE, scale=FALSE))
if (!isTRUE(all.equal(L$d, S$d[1:3])))
{
stop("Failed dense centering test", " fastpath=", FAST)
}
# Sparse matrix
require("Matrix")
K <- 400
N <- 2000
i <- sample(K, size=N, replace=TRUE)
j <- sample(K, size=N, replace=TRUE)
A <- sparseMatrix(i, j, x=rnorm(N))
L <- irlba(A, nu=2, nv=2, tol=1e-9, fastpath=FAST)
S <- svd(A, nu=2, nv=2)
if (!isTRUE(all.equal(L$d, S$d[1:2])))
{
stop("Failed simple sparse singular value test", " fastpath=", FAST)
}
# Center only, sparse
m <- colMeans(A)
L <- irlba(A, 3, tol=1e-9, center=m, fastpath=FAST)
S <- svd(scale(A, center=TRUE, scale=FALSE))
if (!isTRUE(all.equal(L$d, S$d[1:3])))
{
stop("Failed sparse centering test", " fastpath=", FAST)
}
# scale only, spase
s <- seq(1, ncol(A))
L <- irlba(A, 3, tol=1e-9, scale=s, fastpath=FAST)
S <- svd(scale(A, center=FALSE, scale=s))
if (!isTRUE(all.equal(L$d, S$d[1:3])))
{
stop("Failed sparse scaling test", " fastpath=", FAST)
}
# Symmetric partial eigendecomposition
set.seed(1)
V <- qr.Q(qr(matrix(runif(100), nrow=10)))
x <- V %*% diag(c(10, -9, 8, -7, 6, -5, 4, -3, 2, -1)) %*% t(V)
if (!isTRUE(all.equal(partial_eigen(x, 3, fastpath=FAST)$values, c(10, 8, 6))))
{
stop("Failed partial_eigen test", " fastpath=", FAST)
}
# Test right-only option
L <- irlba(A, 2, tol=1e-3, right_only=TRUE, fastpath=FAST, work=20)
S <- svd(A, nu=2, nv=2)
if (isTRUE(max(L$d - S$d[1:2]) > 1e-3))
{
stop("Failed right_only test", " fastpath=", FAST)
}
# Dense complex-valued matrix
A <- matrix(rnorm(400), 20) + 1i * matrix(rnorm(400), 20)
L <- irlba(A, nu=2, nv=2, tol=1e-9, fastpath=FAST)
S <- svd(A, nu=2, nv=2)
if (!isTRUE(all.equal(L$d, S$d[1:2])))
{
stop("Failed complex-valued dense singular value test", " fastpath=", FAST)
}
# test extra reorthogonalization
L <- irlba(A, nu=2, nv=2, tol=1e-9, reorth=TRUE, fastpath=FAST)
if (!isTRUE(all.equal(L$d, S$d[1:2])))
{
stop("Failed reorthogonalization test", " fastpath=", FAST)
}
# very non-square dense matrices
set.seed(1)
A <- matrix(rnorm(2000), 20)
L1 <- irlba(A, nu=2, nv=2, tol=1e-9, fastpath=FAST)
L2 <- irlba(t(A), nu=2, nv=2, tol=1e-9, fastpath=FAST)
if (!isTRUE(all.equal(L1$d, L2$d)))
{
stop("Failed nonsquare test", " fastpath=", FAST)
}
# This pathological example was provided by Giuseppe Rodriguez, http://bugs.unica.it/~gppe/
# The singular values cluster at 1 and 0, making it hard to converge to a truncated
# subspace containing the largest few singular values (they are all very close).
# Or, for that matter, the smallest.
#
# Reference:
# J. M. Varah. The Prolate matrix. Linear Algebra and Appl.,
# 187:269-278, 1993.
# Michela Redivo-Zaglia, University of Padova, Italy
# Email: Michela.RedivoZaglia@unipd.it
# Giuseppe Rodriguez, University of Cagliari, Italy
# Email: rodriguez@unica.it
tprolate <- function(n, w=0.25)
{
a <- rep(0, n)
a[1] <- 2 * w
a[2:n] <- sin(2 * pi * w * (1:(n-1))) / (pi * (1:(n-1)))
toeplitz(a)
}
x <- tprolate(512)
set.seed(1)
l <- irlba(x, nv=20, fastpath=FAST)
if (isTRUE(max(abs(l$d - 1)) > 1e-3))
{
stop("Failed tprolate test fastpath=", FAST)
}
# test for issue #7 and issue #14
mx <- matrix(sample(1:100, 100 * 100, replace=TRUE), nrow=100)
set.seed(1)
l <- irlba(mx, nv=30, center=colMeans(mx), fastpath=FAST)
s <- svd(scale(mx, center=TRUE, scale=FALSE))
if (isTRUE(max(abs(l$d - s$d[1:30])) > 1e-3))
{
stop("Failed integer matrix test fastpath=", FAST)
}
# test for https://github.com/bwlewis/irlba/issues/22
set.seed(1000)
ncells <- 50
ngenes <- 1000
counts <- matrix(as.double(rpois(ncells*ngenes, lambda=100)), nrow=ncells)
centers <- colMeans(counts)
set.seed(1)
out <- irlba(scale(counts, scale=FALSE, center=centers), nu=10, nv=10)
set.seed(1)
l <- irlba(counts, center=centers, nu=10, nv=10, fastpath=FAST)
if (isTRUE(max(abs(out$d - l$d)) > 1e-3))
{
stop("Failed centering test (n > m) fastpath=", FAST)
}
# test for https://github.com/bwlewis/irlba/issues/42
set.seed(1234)
a <- matrix(rnorm(10000), ncol=20)
center <- runif(ncol(a))
scale <- runif(ncol(a))
L <- irlba(a, 5, scale=scale, center=center, fastpath=FAST)
S <- svd(scale(a, center=center, scale=scale))
if (isTRUE(max(abs(S$d[1:5] - L$d)) > 1e-3))
{
stop("Failed scale + center test fastpath=", FAST)
}
}
# smallest=TRUE, m > n (fastpath always FALSE in this case)
x <- matrix(rnorm(5000), 100)
set.seed(1)
L <- irlba(x, nv=5, smallest=TRUE)
if (!isTRUE(all.equal(L$d, tail(svd(x)$d, 5))))
{
stop("Failed smallest svd test")
}
# smallest=TRUE, n > m
x <- matrix(rnorm(5000), 50)
set.seed(1)
L <- irlba(x, nv=5, smallest=TRUE)
if (!isTRUE(all.equal(L$d, tail(svd(x)$d, 5))))
{
stop("Failed smallest svd test")
}
# test for https://github.com/bwlewis/irlba/issues/47 (again, fastpath always FALSE)
set.seed(2345)
a <- spMatrix(50, 40, x=runif(200), i=sample(50, 200, replace=TRUE), j=sample(40, 200, replace=TRUE))
center <- runif(ncol(a))
scale <- runif(ncol(a))
L <- irlba(a, 5, scale=scale, center=center)
S <- svd(scale(a, center=center, scale=scale))
if (isTRUE(max(abs(S$d[1:5] - L$d)) > 1e-3))
{
stop("Failed scale + center test for non-fastpath'able matrices")
}
irlba/src/ 0000755 0001760 0000144 00000000000 14316576142 012173 5 ustar ripley users irlba/src/irlb.h 0000644 0001760 0000144 00000007135 13430560161 013270 0 ustar ripley users /* Compute Y = Y - X * t(X) * Y */
void
orthog( double *X, // Input data matrix
double *Y, // Input data matrix
double *T, // work matrix size xn * yn
int xm, // number of columns of X
int xn, // number of columns of X
int yn); // number of columns of Y
void
convtests (int Bsz, // Number of rows of bidiagonal matrix B
int n, // requested number of singular values
double tol, // convergence tolerance
double svtol, // max change each singular value tolerane
double Smax, // largest singular value of B
double *svratio, // vector of relative singular value ratio compared to last iteration
double *residuals, // vector of residual values
int *k, // number of estimated singular values (INPUT)
// adjusted subspace size (OUTPUT)
int *converged, // 0 = FALSE, 1 = TRUE
double S); // If S == 0 then invariant subspace found.
/*
* Simple cholmod double-precision sparse matrix times dense vector multiplication interface
* Compute c = op(a) %*% b, c changed on output a and b unchanged.
* where, if transpose = 't' then op(a) = t(a) and length(b) = m, length(c) = n
* else, then op(a) = a and length(b) = n, length(c) = m
*/
void
dsdmult(char transpose, // 't' -> op(a) = t(a), non-transposed a otherwise
int m, // number of rows of a
int n, // number of columns of a
void *a, // double precision valued sparse matrix
double *b, // double precision dense vector
double *c); // output
/* IRLB function for sparse or dense double-precision valued matrices */
int
irlb(double *A, // input data matrix (dense case)
void *AS, // input data matrix (sparse case)
int mult, // 0 -> A is double *, 1-> A is sparse double *
int m, // data matrix number of rows
int n, // data matrix number of columns
int nu, // dimension of solution
int m_b, // working dimension
int maxit, // maximum number of Lanzcos iterations
int restart, // 0 -> no restart, 1 -> restarted form
double tol, // convergence tolerance
double *scale, // optional scale (NULL for no scale) length n * 2 (1st n scale values 2nd n work)
double *shift, // optional shift (NULL for no shift) length 1
double *center,// optional center (NULL for no center) length n
double *s, // output singular vectors at least length nu
double *U, // output left singular vectors length >= m x m_b
double *V, // output right singular vectors length >= n x m_b
int *ITER, // output number of iterations performed
int *MPROD, // output number of matrix vector products
double eps, // machine epsilon
int lwork, // length for some intermediate values below
double *V1, // working storage n * work
double *U1, // working storage m * work
double *W, // working storage m * work
double *F, // working storage n
double *B, // working storage work * work
double *BU, // working storage work * work
double *BV, // working storage work * work
double *BS, // working storage work
double *BW, // working storage lwork * lwork
double *res, // working storage work
double *T, // working storage lwork
double svtol, // svtol tolerance on maximum ratio change per singular value per iteration
double *SVRATIO); // working storage nu
irlba/src/Makevars 0000644 0001760 0000144 00000000061 13430560161 013652 0 ustar ripley users PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)
irlba/src/utility.c 0000644 0001760 0000144 00000005442 14153271424 014041 0 ustar ripley users /*
* irlb: Implicitly restarted Lanczos bidiagonalization partial SVD.
* Copyright (c) 2016 by Bryan W. Lewis
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
* You should have received a copy of the GNU General Public License
* along with this program. If not, see .
*/
#include
#include
#include
#include
#include
#define USE_FC_LEN_T
#include
#include
#ifndef FCONE
# define FCONE
#endif
#include "Rinternals.h"
#include "irlb.h"
/* orthog(X,Y,...)
* compute Y = Y - X * t(X) * Y
* xm,xn: nrow, ncol X
* yn: ncol Y (ASSUMED TO BE 1)
* On entry, number of rows of Y must be xm to compute t(X) * Y and
* T must be allocated of at least size xn * yn.
* Modifies contents of Y.
*/
void
orthog (double *X, double *Y, double *T, int xm, int xn, int yn)
{
double a = 1, b = 1;
int inc = 1;
memset (T, 0, xn * yn * sizeof (double));
// T = t(X) * Y
F77_CALL (dgemv) ("t", &xm, &xn, &a, X, &xm, Y, &inc, &b, T, &inc FCONE);
// Y = Y - X * T
a = -1.0;
b = 1.0;
F77_CALL (dgemv) ("n", &xm, &xn, &a, X, &xm, T, &inc, &b, Y, &inc FCONE);
}
/*
* Convergence tests
* Input parameters
* Bsz number of rows of the bidiagonal matrix B (scalar)
* tol convergence tolerance (scalar)
* svtol max change in each singular value tolerance (scalar)
* n requested number of singular values
* Smax largest singular value of B
* svratio vector of abs(current - previous) / current singular value ratios
* residuals vector of residual values
* k number of estimated signular values (scalar)
* S check for invariant subspace when S == 0
*
* Output
* converged 0 = FALSE, 1 = TRUE (all converged)
* k adjusted subspace size.
*/
void
convtests (int Bsz, int n, double tol, double svtol, double Smax,
double *svratio, double *residuals, int *k, int *converged, double S)
{
int j, Len_res = 0;
for (j = 0; j < Bsz; j++)
{
if ((fabs (residuals[j]) < tol * Smax) && (svratio[j] < svtol))
Len_res++;
}
if (Len_res >= n || S == 0)
{
*converged = 1;
return;
}
if (*k < n + Len_res)
*k = n + Len_res;
if (*k > Bsz - 3)
*k = Bsz - 3;
if (*k < 1)
*k = 1;
*converged = 0;
return;
}
irlba/src/irlb.c 0000644 0001760 0000144 00000046176 14316576142 013305 0 ustar ripley users /*
* irlb: Implicitly restarted Lanczos bidiagonalization partial SVD.
* Copyright (c) 2016 by Bryan W. Lewis
*
* This program is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
* You should have received a copy of the GNU General Public License
* along with this program. If not, see .
*/
#include
#include
#include
#include
#include
#define USE_FC_LEN_T
#include
#include "R_ext/BLAS.h"
#ifndef FCONE
# define FCONE
#endif
#include
#define USE_RINTERNALS
#include
#include
#include "R_ext/Lapack.h"
#include "R_ext/Rdynload.h"
#include "R_ext/Utils.h"
#include "R_ext/Parse.h"
#include "Matrix.h"
#include "Matrix_stubs.c"
#include "irlb.h"
/* helper function for calling rnorm below */
SEXP
RNORM (int n)
{
char buf[4096];
SEXP cmdSexp, cmdexpr, ans = R_NilValue;
ParseStatus status;
cmdSexp = PROTECT (allocVector (STRSXP, 1));
snprintf (buf, 4095, "rnorm(%d)", n);
SET_STRING_ELT (cmdSexp, 0, mkChar (buf));
cmdexpr = PROTECT (R_ParseVector (cmdSexp, -1, &status, R_NilValue));
if (status != PARSE_OK)
{
UNPROTECT (2);
error ("invalid call");
}
for (int i = 0; i < length (cmdexpr); i++)
{
ans = PROTECT (eval (VECTOR_ELT (cmdexpr, i), R_GlobalEnv));
UNPROTECT (1);
}
UNPROTECT (2);
return ans;
}
/* irlb C implementation wrapper for R
*
* X double precision input matrix
* NU integer number of singular values/vectors to compute must be > 3
* INIT double precision starting vector length(INIT) must equal ncol(X)
* WORK integer working subspace dimension must be > NU
* MAXIT integer maximum number of iterations
* TOL double tolerance
* EPS double invariant subspace detection tolerance
* MULT integer 0 X is a dense matrix (dgemm), 1 sparse (cholmod)
* RESTART integer 0 no or > 0 indicates restart of dimension n
* RV, RW, RS optional restart V W and S values of dimension RESTART
* (only used when RESTART > 0)
* SCALE either NULL (no scaling) or a vector of length ncol(X)
* SHIFT either NULL (no shift) or a single double-precision number
* CENTER either NULL (no centering) or a vector of length ncol(X)
* SVTOL double tolerance max allowed per cent change in each estimated singular value
*
* Returns a list with 6 elements:
* 1. vector of estimated singular values
* 2. matrix of estimated left singular vectors
* 3. matrix of estimated right singular vectors
* 4. number of algorithm iterations
* 5. number of matrix vector products
* 6. irlb C algorithm return error code (see irlb below)
*/
SEXP
IRLB (SEXP X, SEXP NU, SEXP INIT, SEXP WORK, SEXP MAXIT, SEXP TOL, SEXP EPS,
SEXP MULT, SEXP RESTART, SEXP RV, SEXP RW, SEXP RS, SEXP SCALE,
SEXP SHIFT, SEXP CENTER, SEXP SVTOL)
{
SEXP ANS, S, U, V;
double *V1, *U1, *W, *F, *B, *BU, *BV, *BS, *BW, *res, *T, *scale, *shift,
*center, *SVRATIO;
int i, iter, mprod, ret;
int m, n;
int mult = INTEGER (MULT)[0];
void *AS = NULL;
double *A = NULL;
switch (mult)
{
case 1:
AS = (void *) AS_CHM_SP (X);
int *dims = INTEGER (GET_SLOT (X, install ("Dim")));
m = dims[0];
n = dims[1];
break;
default:
A = REAL (X);
m = nrows (X);
n = ncols (X);
}
int nu = INTEGER (NU)[0];
int work = INTEGER (WORK)[0];
int maxit = INTEGER (MAXIT)[0];
double tol = REAL (TOL)[0];
double svtol = REAL (SVTOL)[0];
int lwork = 7 * work * (1 + work);
int restart = INTEGER (RESTART)[0];
double eps = REAL (EPS)[0];
PROTECT (ANS = NEW_LIST (6));
PROTECT (S = allocVector (REALSXP, nu));
PROTECT (U = allocVector (REALSXP, m * work));
PROTECT (V = allocVector (REALSXP, n * work));
if (restart == 0)
for (i = 0; i < n; ++i)
(REAL (V))[i] = (REAL (INIT))[i];
/* set up intermediate working storage */
scale = NULL;
shift = NULL;
center = NULL;
if (TYPEOF (SCALE) == REALSXP)
{
scale = (double *) R_alloc (n * 2, sizeof (double));
memcpy (scale, REAL (SCALE), n * sizeof (double));
}
if (TYPEOF (SHIFT) == REALSXP)
{
shift = REAL (SHIFT);
}
if (TYPEOF (CENTER) == REALSXP)
{
center = REAL (CENTER);
}
SVRATIO = (double *) R_alloc (work, sizeof (double));
V1 = (double *) R_alloc (n * work, sizeof (double));
U1 = (double *) R_alloc (m * work, sizeof (double));
W = (double *) R_alloc (m * work, sizeof (double));
F = (double *) R_alloc (n, sizeof (double));
B = (double *) R_alloc (work * work, sizeof (double));
BU = (double *) R_alloc (work * work, sizeof (double));
BV = (double *) R_alloc (work * work, sizeof (double));
BS = (double *) R_alloc (work, sizeof (double));
BW = (double *) R_alloc (lwork, sizeof (double));
res = (double *) R_alloc (work, sizeof (double));
T = (double *) R_alloc (lwork, sizeof (double));
if (restart > 0)
{
memcpy (REAL (V), REAL (RV), n * (restart + 1) * sizeof (double));
memcpy (W, REAL (RW), m * restart * sizeof (double));
memset (B, 0, work * work * sizeof (double));
for (i = 0; i < restart; ++i)
B[i + work * i] = REAL (RS)[i];
}
ret =
irlb (A, AS, mult, m, n, nu, work, maxit, restart, tol, scale, shift, center,
REAL (S), REAL (U), REAL (V), &iter, &mprod, eps, lwork, V1, U1, W,
F, B, BU, BV, BS, BW, res, T, svtol, SVRATIO);
SET_VECTOR_ELT (ANS, 0, S);
SET_VECTOR_ELT (ANS, 1, U);
SET_VECTOR_ELT (ANS, 2, V);
SET_VECTOR_ELT (ANS, 3, ScalarInteger (iter));
SET_VECTOR_ELT (ANS, 4, ScalarInteger (mprod));
SET_VECTOR_ELT (ANS, 5, ScalarInteger (ret));
UNPROTECT (4);
return ANS;
}
/* irlb: main computation function.
* returns:
* 0 on success,
* -1 invalid dimensions,
* -2 not converged
* -3 out of memory
* -4 starting vector near the null space of A
*
* all data must be allocated by caller, required sizes listed below
*/
int
irlb (double *A, // Input data matrix (double case)
void *AS, // input data matrix (sparse case)
int mult, // 0 -> use double *A, 1 -> use AS
int m, // data matrix number of rows, must be > 3.
int n, // data matrix number of columns, must be > 3.
int nu, // dimension of solution
int work, // working dimension, must be > 3.
int maxit, // maximum number of main iterations
int restart, // 0->no, n>0 -> restarted algorithm of dimension n
double tol, // convergence tolerance
double *scale, // optional scale (NULL for no scale) size n * 2
double *shift, // optional shift (NULL for no shift)
double *center, // optional center (NULL for no center)
// output values
double *s, // output singular values at least length nu
double *U, // output left singular vectors m x work
double *V, // output right singular vectors n x work
int *ITER, // ouput number of Lanczos iterations
int *MPROD, // output number of matrix vector products
double eps, // tolerance for invariant subspace detection
// working intermediate storage, sizes shown
int lwork, double *V1, // n x work
double *U1, // m x work
double *W, // m x work input when restart > 0
double *F, // n
double *B, // work x work input when restart > 0
double *BU, // work x work
double *BV, // work x work
double *BS, // work
double *BW, // lwork
double *res, // work
double *T, // lwork
double svtol, // svtol limit
double *svratio) // convtest extra storage vector of length work
{
double d, S, R, alpha, beta, R_F, SS;
double *x;
int jj, kk;
int converged;
int info, j, k = restart;
int inc = 1;
int mprod = 0;
int iter = 0;
double Smax = 0;
SEXP FOO;
/* Check for valid input dimensions */
if (work < 4 || n < 4 || m < 4)
return -1;
if (restart == 0)
memset (B, 0, work * work * sizeof (double));
memset(svratio, 0, work * sizeof(double));
/* Main iteration */
while (iter < maxit)
{
j = 0;
/* Normalize starting vector */
if (iter == 0 && restart == 0)
{
d = F77_CALL (dnrm2) (&n, V, &inc);
if (d < eps)
return -1;
d = 1 / d;
F77_CALL (dscal) (&n, &d, V, &inc);
}
else
j = k;
/* optionally apply scale */
x = V + j * n;
if (scale)
{
x = scale + n;
memcpy (scale + n, V + j * n, n * sizeof (double));
for (kk = 0; kk < n; ++kk)
x[kk] = x[kk] / scale[kk];
}
switch (mult)
{
case 1:
dsdmult ('n', m, n, AS, x, W + j * m);
break;
default:
alpha = 1;
beta = 0;
F77_CALL (dgemv) ("n", &m, &n, &alpha, (double *) A, &m, x,
&inc, &beta, W + j * m, &inc FCONE);
}
mprod++;
R_CheckUserInterrupt ();
/* optionally apply shift in square cases m = n */
if (shift)
{
jj = j * m;
for (kk = 0; kk < m; ++kk)
W[jj + kk] = W[jj + kk] + shift[0] * x[kk];
}
/* optionally apply centering */
if (center)
{
jj = j * m;
beta = F77_CALL (ddot) (&n, x, &inc, center, &inc);
for (kk = 0; kk < m; ++kk)
W[jj + kk] = W[jj + kk] - beta;
}
if (iter > 0)
orthog (W, W + j * m, T, m, j, 1);
S = F77_CALL (dnrm2) (&m, W + j * m, &inc);
if (S < eps && j == 0)
return -4;
SS = 1.0 / S;
F77_CALL (dscal) (&m, &SS, W + j * m, &inc);
/* The Lanczos process */
while (j < work)
{
switch (mult)
{
case 1:
dsdmult ('t', m, n, AS, W + j * m, F);
break;
default:
alpha = 1.0;
beta = 0.0;
F77_CALL (dgemv) ("t", &m, &n, &alpha, (double *) A, &m,
W + j * m, &inc, &beta, F, &inc FCONE);
}
mprod++;
R_CheckUserInterrupt ();
/* optionally apply shift, scale, center */
if (shift)
{
// Note, not a bug because shift only applies to square matrices
for (kk = 0; kk < m; ++kk)
F[kk] = F[kk] + shift[0] * W[j * m + kk];
}
if (scale)
{
for (kk = 0; kk < n; ++kk)
F[kk] = F[kk] / scale[kk];
}
if (center)
{
beta = 0;
for (kk = 0; kk < m; ++kk) beta += W[j *m + kk];
if (scale)
for (kk = 0; kk < n; ++kk)
F[kk] = F[kk] - beta * center[kk] / scale[kk];
else
for (kk = 0; kk < n; ++kk)
F[kk] = F[kk] - beta * center[kk];
}
SS = -S;
F77_CALL (daxpy) (&n, &SS, V + j * n, &inc, F, &inc);
orthog (V, F, T, n, j + 1, 1);
if (j + 1 < work)
{
R_F = F77_CALL (dnrm2) (&n, F, &inc);
R = 1.0 / R_F;
if (R_F < eps) // near invariant subspace
{
FOO = RNORM (n);
for (kk = 0; kk < n; ++kk)
F[kk] = REAL (FOO)[kk];
orthog (V, F, T, n, j + 1, 1);
R_F = F77_CALL (dnrm2) (&n, F, &inc);
R = 1.0 / R_F;
R_F = 0;
}
memmove (V + (j + 1) * n, F, n * sizeof (double));
F77_CALL (dscal) (&n, &R, V + (j + 1) * n, &inc);
B[j * work + j] = S;
B[(j + 1) * work + j] = R_F;
/* optionally apply scale */
x = V + (j + 1) * n;
if (scale)
{
x = scale + n;
memcpy (x, V + (j + 1) * n, n * sizeof (double));
for (kk = 0; kk < n; ++kk)
x[kk] = x[kk] / scale[kk];
}
switch (mult)
{
case 1:
dsdmult ('n', m, n, AS, x, W + (j + 1) * m);
break;
default:
alpha = 1.0;
beta = 0.0;
F77_CALL (dgemv) ("n", &m, &n, &alpha, (double *) A, &m,
x, &inc, &beta, W + (j + 1) * m, &inc FCONE);
}
mprod++;
R_CheckUserInterrupt ();
/* optionally apply shift */
if (shift)
{
jj = j + 1;
for (kk = 0; kk < m; ++kk)
W[jj * m + kk] = W[jj * m + kk] + shift[0] * x[kk];
}
/* optionally apply centering */
if (center)
{
jj = (j + 1) * m;
beta = F77_CALL (ddot) (&n, x, &inc, center, &inc);
for (kk = 0; kk < m; ++kk)
W[jj + kk] = W[jj + kk] - beta;
}
/* One step of classical Gram-Schmidt */
R = -R_F;
F77_CALL (daxpy) (&m, &R, W + j * m, &inc, W + (j + 1) * m,
&inc);
/* full re-orthogonalization of W_{j+1} */
orthog (W, W + (j + 1) * m, T, m, j + 1, 1);
S = F77_CALL (dnrm2) (&m, W + (j + 1) * m, &inc);
SS = 1.0 / S;
if (S < eps)
{
FOO = RNORM (m);
jj = (j + 1) * m;
for (kk = 0; kk < m; ++kk)
W[jj + kk] = REAL (FOO)[kk];
orthog (W, W + (j + 1) * m, T, m, j + 1, 1);
S = F77_CALL (dnrm2) (&m, W + (j + 1) * m, &inc);
SS = 1.0 / S;
F77_CALL (dscal) (&m, &SS, W + (j + 1) * m, &inc);
S = 0;
}
else
F77_CALL (dscal) (&m, &SS, W + (j + 1) * m, &inc);
}
else
{
B[j * work + j] = S;
}
j++;
}
memmove (BU, B, work * work * sizeof (double)); // Make a working copy of B
int *BI = (int *) T;
F77_CALL (dgesdd) ("O", &work, &work, BU, &work, BS, BU, &work, BV,
&work, BW, &lwork, BI, &info FCONE);
R_F = F77_CALL (dnrm2) (&n, F, &inc);
R = 1.0 / R_F;
F77_CALL (dscal) (&n, &R, F, &inc);
/* Force termination after encountering linear dependence */
if (R_F < eps)
R_F = 0;
Smax = 0;
for (jj = 0; jj < j; ++jj)
{
if (BS[jj] > Smax)
Smax = BS[jj];
svratio[jj] = fabs (svratio[jj] - BS[jj]) / BS[jj];
}
for (kk = 0; kk < j; ++kk)
res[kk] = R_F * BU[kk * work + (j - 1)];
/* Update k to be the number of converged singular values. */
convtests (j, nu, tol, svtol, Smax, svratio, res, &k, &converged, S);
if (converged == 1)
{
iter++;
break;
}
for (jj = 0; jj < j; ++jj)
svratio[jj] = BS[jj];
alpha = 1;
beta = 0;
F77_CALL (dgemm) ("n", "t", &n, &k, &j, &alpha, V, &n, BV, &work, &beta,
V1, &n FCONE FCONE);
memmove (V, V1, n * k * sizeof (double));
memmove (V + n * k, F, n * sizeof (double));
memset (B, 0, work * work * sizeof (double));
for (jj = 0; jj < k; ++jj)
{
B[jj * work + jj] = BS[jj];
B[k * work + jj] = res[jj];
}
/* Update the left approximate singular vectors */
alpha = 1;
beta = 0;
F77_CALL (dgemm) ("n", "n", &m, &k, &j, &alpha, W, &m, BU, &work, &beta,
U1, &m FCONE FCONE);
memmove (W, U1, m * k * sizeof (double));
iter++;
}
/* Results */
memmove (s, BS, nu * sizeof (double)); /* Singular values */
alpha = 1;
beta = 0;
F77_CALL (dgemm) ("n", "n", &m, &nu, &work, &alpha, W, &m, BU, &work, &beta,
U, &m FCONE FCONE);
F77_CALL (dgemm) ("n", "t", &n, &nu, &work, &alpha, V, &n, BV, &work, &beta,
V1, &n FCONE FCONE);
memmove (V, V1, n * nu * sizeof (double));
*ITER = iter;
*MPROD = mprod;
return (converged == 1 ? 0 : -2);
}
cholmod_common chol_c;
/* Need our own CHOLMOD error handler */
void attribute_hidden
irlba_R_cholmod_error (int status, const char *file, int line,
const char *message)
{
if (status < 0)
error ("Cholmod error '%s' at file:%s, line %d", message, file, line);
else
warning ("Cholmod warning '%s' at file:%s, line %d", message, file, line);
}
static const R_CallMethodDef CallEntries[] = {
{"IRLB", (DL_FUNC) & IRLB, 16},
{NULL, NULL, 0}
};
#ifdef HAVE_VISIBILITY_ATTRIBUTE
__attribute__ ((visibility ("default")))
#endif
void
R_init_irlba (DllInfo * dll)
{
R_RegisterCCallable("irlba", "orthog",
(DL_FUNC) &orthog);
R_RegisterCCallable("irlba", "irlb",
(DL_FUNC) &irlb);
R_registerRoutines (dll, NULL, CallEntries, NULL, NULL);
R_useDynamicSymbols (dll, 0);
M_R_cholmod_start (&chol_c);
chol_c.final_ll = 1; /* LL' form of simplicial factorization */
/* need own error handler, that resets final_ll (after *_defaults()) : */
chol_c.error_handler = irlba_R_cholmod_error;
}
void
R_unload_irlba (DllInfo * dll)
{
M_cholmod_finish (&chol_c);
}
typedef int (*cholmod_sdmult_func)
(
/* ---- input ---- */
cholmod_sparse *A, /* sparse matrix to multiply */
int transpose, /* use A if 0, or A' otherwise */
double alpha [2], /* scale factor for A */
double beta [2], /* scale factor for Y */
cholmod_dense *X, /* dense matrix to multiply */
/* ---- in/out --- */
cholmod_dense *Y, /* resulting dense matrix */
/* --------------- */
cholmod_common *Common
);
void
dsdmult (char transpose, int m, int n, void * a, double *b, double *c)
{
cholmod_sdmult_func sdmult;
sdmult = (cholmod_sdmult_func) R_GetCCallable ("Matrix", "cholmod_sdmult");
int t = transpose == 't' ? 1 : 0;
CHM_SP cha = (CHM_SP) a;
cholmod_dense chb;
chb.nrow = transpose == 't' ? m : n;
chb.d = chb.nrow;
chb.ncol = 1;
chb.nzmax = chb.nrow;
chb.xtype = cha->xtype;
chb.dtype = 0;
chb.x = (void *) b;
chb.z = (void *) NULL;
cholmod_dense chc;
chc.nrow = transpose == 't' ? n : m;
chc.d = chc.nrow;
chc.ncol = 1;
chc.nzmax = chc.nrow;
chc.xtype = cha->xtype;
chc.dtype = 0;
chc.x = (void *) c;
chc.z = (void *) NULL;
double one[] = { 1, 0 }, zero[] = { 0, 0};
sdmult (cha, t, one, zero, &chb, &chc, &chol_c);
}
irlba/vignettes/ 0000755 0001760 0000144 00000000000 14153273722 013411 5 ustar ripley users irlba/vignettes/irlba.Rnw 0000644 0001760 0000144 00000040151 13430560161 015164 0 ustar ripley users % \VignetteIndexEntry{irlba Manual}
% \VignetteDepends{irlba}
% \VignettePackage{irlba}
\documentclass[12pt]{article}
\usepackage{amsmath}
\usepackage[pdftex]{graphicx}
\usepackage{color}
\usepackage{xspace}
\usepackage{fancyvrb}
\usepackage{fancyhdr}
\usepackage[
colorlinks=true,
linkcolor=blue,
citecolor=blue,
urlcolor=blue]
{hyperref}
\usepackage{lscape}
\usepackage{Sweave}
\usepackage{tabularx}
\usepackage{listings}
\usepackage{mdwlist}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% define new colors for use
\definecolor{darkgreen}{rgb}{0,0.6,0}
\definecolor{darkred}{rgb}{0.6,0.0,0}
\definecolor{lightbrown}{rgb}{1,0.9,0.8}
\definecolor{brown}{rgb}{0.6,0.3,0.3}
\definecolor{darkblue}{rgb}{0,0,0.8}
\definecolor{darkmagenta}{rgb}{0.5,0,0.5}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\newcommand{\bld}[1]{\mbox{\boldmath $#1$}}
\newcommand{\shell}[1]{\mbox{$#1$}}
\renewcommand{\vec}[1]{\mbox{\bf {#1}}}
\newcommand{\ReallySmallSpacing}{\renewcommand{\baselinestretch}{.6}\Large\normalsize}
\newcommand{\SmallSpacing}{\renewcommand{\baselinestretch}{1.1}\Large\normalsize}
\def\tm{\leavevmode\hbox{$\rm {}^{TM}$}}
\newcommand{\R}{{\mathbf R}}
\newcommand{\brho}{{\color{blue}{\rho}}}
\newcommand{\Ra}{{\mathcal R}}
\newcommand{\PP}{{\mathbf P}}
\newcommand{\N}{{\mathbf N}}
\newcommand{\K}{{\mathcal K}}
\setlength{\oddsidemargin}{-.25 truein}
\setlength{\evensidemargin}{0truein}
\setlength{\topmargin}{-0.2truein}
\setlength{\textwidth}{7 truein}
\setlength{\textheight}{8.5 truein}
\setlength{\parindent}{0.20truein}
\setlength{\parskip}{0.10truein}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\pagestyle{fancy}
\lhead{}
\chead{The {\tt irlba} Package}
\rhead{}
\lfoot{}
\cfoot{}
\rfoot{\thepage}
\renewcommand{\headrulewidth}{1pt}
\renewcommand{\footrulewidth}{1pt}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\title{The {\tt irlba} Package}
\author{Bryan W. Lewis \\
blewis@illposed.net,
\\[6pt]
adapted from the work of:\\
Jim Baglama (University of Rhode Island)\\
and Lothar Reichel (Kent State University).
}
\begin{document}
\maketitle
\thispagestyle{empty}
\section{Introduction}
The {\tt irlba} package provides a fast way to compute partial singular value
decompositions (SVD) of large sparse or dense matrices. Recent additions to the
package can also compute fast partial symmetric eigenvalue decompositions and
principal components. The package is an R implementation of the {\it augmented
implicitly restarted Lanczos bidiagonalization algorithm} of Jim Baglama and
Lothar Reichel\footnote{Augmented Implicitly Restarted Lanczos
Bidiagonalization Methods, J. Baglama and L. Reichel, SIAM J. Sci. Comput.
2005.}. Source code is maintained at
\href{https://github.com/bwlewis/irlba}{https://github.com/bwlewis/irlba}.
The {\tt irlba} package works with real- and complex-valued dense R matrices
and real-valued sparse matrices from the {\tt Matrix} package. It provides
several easy ways to define custom matrix arithmetic that works with other
matrix classes including {\tt big.matrix} from the {\tt bigmemory} package and
others. The {\tt irlba} is both faster and more memory efficient than the
usual R {\tt svd} function for computing a few of the largest singular vectors
and corresponding singular values of a matrix. It takes advantage of available
high-performance linear algebra libraries if R is compiled to use them. In
particular, the package uses the same BLAS and LAPACK libraries that R uses
(see
\href{https://cran.r-project.org/doc/manuals/R-admin.html#BLAS}{https://cran.r-project.org/doc/manuals/R-admin.html\#BLAS}),
or the CHOLMOD library from R's Matrix package for sparse matrix problems.
A whirlwind summary of the algorithm follows, along with a few basic examples.
A much more detailed description and discussion of the algorithm may be found
in the cited Baglama-Reichel reference.
\section{Partial Singular Value Decomposition}
Let $A\in\R^{\ell\times n}$ and assume $\ell\ge n$. These notes simplify the
presentation by considering only real-valued matrices and assuming without
losing generality that there are at least as many rows as columns (the
method works more generally). A singular
value decomposition of $A$ can be expressed as:
\[
A = \sum_{j=1}^n \sigma_j u_j v_j^T,
\phantom{xxxxxxxx}
v_j^Tv_k = u_j^Tu_k =
\left\{
\begin{array}{ll}
1 & \mbox{if}\phantom{x} j=k,\\
0 & \mbox{o.w.,}\\
\end{array}
\right.
\]
where $u_j\in\R^\ell $, $v_j\in\R^n $,
$j=1,2,\ldots, n$, and
$ \sigma_1 \ge \sigma_2 \ge \cdots \ge \sigma_n \ge 0 $.
Let $1 \le k library('irlba')
> set.seed(1)
> A <- matrix(rnorm(5000*5000), 5000)
> t1 <- proc.time()
> L <- irlba(A, 5)
> print(proc.time() - t1)
user system elapsed
17.440 0.192 4.417
> gc()
used (Mb) gc trigger (Mb) max used (Mb)
Ncells 1096734 58.6 1770749 94.6 1442291 77.1
Vcells 26685618 203.6 62229965 474.8 52110704 397.6
\end{lstlisting}
Compare with the standard {\tt svd} function:\newpage
\begin{lstlisting}
> t1 <- proc.time()
> S <- svd(A, nu=5, nv=5)
> print(proc.time() - t1)
user system elapsed
277.092 11.552 74.425
> gc()
used (Mb) gc trigger (Mb) max used (Mb)
Ncells 1097441 58.7 1770749 94.6 1442291 77.1
Vcells 26741910 204.1 169891972 1296.2 176827295 1349.1
\end{lstlisting}
The {\tt irlba} method uses about 1/20 elapsed time as the
{\tt svd} method in this example and less than one third the peak memory.
The defalut tolerance value yields the following relative error
in the estimated singular values:
\begin{lstlisting}
> sqrt (crossprod(S$d[1:5]-L$d)/crossprod(S$d[1:5]))
[,1]
[1,] 4.352641e-10
\end{lstlisting}
\subsection{Convergence tolerance}
IRLBA is an iterative method that estimates a few singular values
and associated singular vectors. A sketch of the algorithm is outlined
in Section \ref{sketch} below. The R {\tt tol} and {\tt svtol} arguments control
when the algorithm converges with {\tt tol} specifying
subspace convergence, and {\tt svtol} specifying convergence of estimated
singular values.
Subspace convergence occurs when the algorithm iterations find
estimated singular vectors that satisfy
\[
\|AV_k - US_k\| < \mbox{tol} \cdot \|A\|,
\]
where $\|\cdot\|$ means spectral matrix norm, $A$ is the matrix, $V_k$ and $U_k$
are the {\it estimated} right and left $k$ singular vectors computed by the
algorithm, and $\|A\|$ is the {\it estimated} spectral norm of the matrix defined
by the largest singular value computed by the algorithm. Using R notation,
the algorithm stops when
\begin{lstlisting}
L <- irlba(A, k, tol)
svd(A %*% L$v - L$u %*% diag(L$d))$d[1] < tol * L$d[1]
\end{lstlisting}
It's possible to encounter problems that fail to converge before
the maximum number of algorithm iterations specified by the {\tt maxit}
argument.
When the largest singular values are clustered together it can be hard to
detect subspace convergence. More recent versions of the IRLBA implementation
include the {\tt svtol} argument that specifies a maximum for the relative
change in each estimated singular value from one iteration to the next.
The convergence tolerance values together help improve correct subspace
detection in difficult settings when the singular values are clustered.
But in the worst cases, block methods can perform better as shown in
the documentation for the {\tt svdr} method.
Also see the related {\tt rsvd} function by N. Benjamin Erichson,
\href{https://cran.r-project.org/package=rsvd}{https://cran.r-project.org/package=rsvd}.
\subsection{Differences with {\tt svd}}
The {\tt irlba} function is designed to compute a {\it partial} singular
value decomposition. It is largely compatible with the usual R {\tt svd}
function but there are some differences. In particular:
\begin{enumerate}
\item The {\tt irlba} function only computes the number of singular values
corresponding to the maximum of the desired singular vectors,
{\tt max(nu, nv)}. For example, if 5
singular vectors are desired ({\tt nu=nv=5}), then only the five corresponding
singular values are computed. The standard R {\tt svd} function always
returns the {\it total} set of singular values for the matrix, regardless of how
many singular vectors are specified.
\item The {\tt irlba} function is an iterative method that continues until
either a tolerance or maximum number of iterations is reached.
Problems with difficult convergence properties are not likely to be
encountered, but the method will fail with an error after the iteration limit
is reached in those cases.
\end{enumerate}
Watch out especially for the first difference noted above!
\subsection{Principal Components}
Version 2.1.0 of the package introduces optional arguments and {\tt prcomp}-like
function syntax for efficiently computing partial SVDs of matrices after
centering and scaling their columns and other adjustments.
Use the following arguments to the {\tt irlba} function, or the new
{\tt irlba\_prcomp} function for PCA:
\begin{itemize}
\item {\tt center}: if {\tt center} is a numeric vector with length equal to
the number of columns of the matrix, then each column of the matrix has the
corresponding value from {\tt center} subtracted from it.
\item {\tt scale}: if 'scale' is a numeric vector with length
equal to the number of columns of the matrix, then each column is
divided by the corresponding value from {\tt scale}.
\end{itemize}
Both centering and scaling options are performed implicitly in the algorithm
and, for instance, do not affect sparsity of the input matrix or increase
storage requirements.
The following
example compares the output of the usual {\tt prcomp} function with
output from {\tt irlba}.
Note that in general, singular vectors and principal component vectors
are only unique up to sign!
\begin{lstlisting}
> set.seed(1)
> x <- matrix(rnorm(200), nrow=20)
> p1 <- prcomp_irlba(x, n=3)
> summary(p1)
Importance of components%s:
PC1 PC2 PC3
Standard deviation 1.5411 1.2513 1.1916
Proportion of Variance 0.2806 0.1850 0.1678
Cumulative Proportion 0.2806 0.4656 0.6334
> # Compare with
> p2 <- prcomp(x, tol=0.7)
> summary(p2)
Importance of components:
PC1 PC2 PC3
Standard deviation 1.5411 1.2513 1.1916
Proportion of Variance 0.2806 0.1850 0.1678
Cumulative Proportion 0.2806 0.4656 0.6334
\end{lstlisting}
Alternatively, you can compute principal components directly using the
singular value decomposition and the {\tt center} option:
\begin{lstlisting}
> p3 <- svd(scale(x, center=colMeans(x), scale=FALSE))
> p4 <- irlba(x, 3, center=colMeans(x))
> # compare with prcomp
> sqrt(crossprod(p1$rotation[,1] - p3$v[,1]))
[,1]
[1,] 9.773228e-13
> sqrt(crossprod(p1$rotation[,1] + p4$v[,1]))
[,1]
[1,] 1.652423e-12
\end{lstlisting}
\subsection{Truncated symmetric eigenvalue decomposition}
Use the {\tt partial\_eigen} function to estimate a subset of the largest (most
positive) eigenvalues and corresponding eigenvectors of a symmetric dense or
sparse real-valued matrix. The function is particularly well-suited to
estimating the largest eigenvalues and corresponding eigenvectors of symmetric
positive semi-definite matrices of the form $A^T A$.
\subsection{User-Defined Matrix Multiplication}
The {\tt irlba} function only uses matrix vector products with the input data
matrix to compute its solution. It's easy to use R's native object model to
define custom matrix classes with user-defined matrix multiplication functions.
Such functions can be used to support special matrix objects, out of core
computation of large problems, or matrix-free operators.
Here is a simple example that defines a matrix product that scales the
columns of the matrix to have unit norm (cf the {\tt scale} option).
\begin{lstlisting}
> A <- matrix(runif(400), nrow=20)
> col_scale <- sqrt(apply(A, 2, crossprod))
> setClass("scaled_matrix", contains="matrix", slots=c(scale="numeric"))
> setMethod("%*%", signature(x="scaled_matrix", y="numeric"),
+ function(x ,y) x@.Data %*% (y / x@scale))
> setMethod("%*%", signature(x="numeric", y="scaled_matrix"),
+ function(x ,y) (x %*% y@.Data) / y@scale)
> a <- new("scaled_matrix", A, scale=col_scale)
> irlba(a, 3)$d
[1] 3.9298391 0.9565016 0.8266859
# Compare with
> svd(sweep(A, 2, col_scale, FUN=`/`))$d[1:3]
[1] 3.9298391 0.9565016 0.8266859
\end{lstlisting}
See the following link for an example that uses large-scale out of core computation:
\href{https://bwlewis.github.io/1000_genomes_examples/PCA_whole_genome.html}{http://bwlewis.github.io/1000\_genomes\_examples/PCA\_whole\_genome.html}
NOTE! The reference R algorithm implementation is used whenever user-defined
matrix multiplication is specified (instead of the faster C code path).
\section{A Quick Summary of the IRLBA Method}\label{sketch}
\subsection{Partial Lanczos Bidiagonalization}
Start with a given vector $p_1$. Compute $m$ steps of the Lanczos process:
\begin{eqnarray*}
A P_m &=& Q_m B_m \\
A^T Q_m &=& P_m B_m^T + r_m e_m^T,\\
\end{eqnarray*}
$B_m\in\R^{m\times m}, P_m \in \R^{n\times m}, $
$Q_m \in \R^{\ell \times m},$
$P_m^TP_m=Q_m^TQ_m=I_m, $
$r_m\in\R^n, P_m^Tr_m=0,$
$P_m = [p_1, p_2, \ldots, p_m]$.
\subsection{Approximating Partial SVD with A Partial Lanczos bidiagonalization}
\begin{eqnarray*}
A^TA P_m &=& A^TQ_m B_m \\
&=& P_m {\color{blue}{B_m^TB_m}} + r_m e_m^TB_m,\\
\end{eqnarray*}
\begin{eqnarray*}
AA^T Q_m &=& AP_m B_m^T + Ar_m e_m^T,\\
&=& Q_m{\color{blue}{B_mB_m^T}} + Ar_me_m^T.
\end{eqnarray*}
Compute the SVD of $B_m$:
\[
B_m = \sum_{j=1}^m\sigma^B_ju^B_j\left(v_j^B\right)^T.
\]
\\[6pt]
\[
\left(\mbox{i.e., } B_mv_j^B = \sigma_j^Bu_j^B, \mbox{ and }
B_m^Tu_j^b = \sigma_j^Bv_j^B.\right)
\]
Define:
$
\tilde{\sigma_j} := \sigma_j^B, \phantom{xxx}
\tilde{u}_j := Q_m u_j^B, \phantom{xxx}
\tilde{v}_j := P_m v_j^B.
$
Then:
\begin{eqnarray*}
A\tilde{v}_j &=& AP_mv_j^B \\
&=& Q_mB_mv_j^B \\
&=& \sigma^B_jQ_mu_j^B \\
&=& \tilde{\sigma}_j \tilde{u}_j,
\end{eqnarray*}
and
\begin{eqnarray*}
A^T\tilde{u}_j &=& A^TQ_mu_j^B \\
&=& P_mB^T_mu_j^B + r_me_m^Tu_j^B \\
&=& \sigma^B_jP_mv_j^B + r_me_m^Tu_j^B\\
&=& \tilde{\sigma}_j \tilde{v}_j + {\color{red} {r_me_m^Tu_j^B}}.
\end{eqnarray*}
The part in red above represents the error with respect to the exact SVD.
The IRLBA strategy is to iteratively reduce the norm of that error term
by augmenting and restarting.
Here is the overall method:
\begin{enumerate}
\item Compute the Lanczos process up to step $m$.
\item Compute $k