Skip to content

Commit

Permalink
Make fast.prcomp return a valid prcomp object
Browse files Browse the repository at this point in the history
Functions like predict.prcomp expect a prcomp object to have "center"
and "scale" attributes.
  • Loading branch information
Ryan C. Thompson committed Dec 6, 2024
1 parent 09ba72e commit 7c929d3
Showing 1 changed file with 5 additions and 2 deletions.
7 changes: 5 additions & 2 deletions R/fast.prcomp.R
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@
#' # prcomp directly on matrix is SLOW:
#' system.time( pr.x <- prcomp(x) )
#'
#' # prcomp.fast is much faster
#' # fast.prcomp is much faster
#' system.time( fast.pr.x <- fast.prcomp(x) )
#'
#' # and the results are equivalent
Expand All @@ -82,6 +82,8 @@ fast.prcomp <- function (x, retx = TRUE, center = TRUE, scale. = FALSE,
{
x <- as.matrix(x)
x <- scale(x, center = center, scale = scale.)
cen <- attr(x, "scaled:center")
sc <- attr(x, "scaled:scale")
s <- La.svd(x, nu = 0)
if (!is.null(tol)) {
rank <- sum(s$d > (s$d[1] * tol))
Expand All @@ -92,7 +94,8 @@ fast.prcomp <- function (x, retx = TRUE, center = TRUE, scale. = FALSE,

dimnames(s$vt) <- list(paste("PC", seq(len = nrow(s$vt)), sep = ""),
colnames(x) )
r <- list(sdev = s$d, rotation = t(s$vt) )
r <- list(sdev = s$d, rotation = t(s$vt),
center = cen %||% FALSE, scale = sc %||% FALSE)
if (retx)
r$x <- x %*% t(s$vt)
class(r) <- "prcomp"
Expand Down

0 comments on commit 7c929d3

Please sign in to comment.