Skip to main content

Browse the archive

https://github.com/cran/Hmisc
13 October 2021, 15:55:31 UTC
Revision 288a6220b956d91fff5bd3cdc5eb883d53ebe1bd authored by Charles Dupont on 10 January 2006, 13:38:31 UTC, committed by cran-robot on 10 January 2006, 13:38:31 UTC 
version 3.0-9
1 parent df80191
Raw File
Tip revision: 288a6220b956d91fff5bd3cdc5eb883d53ebe1bd authored by Charles Dupont on 10 January 2006, 13:38:31 UTC
version 3.0-9
Tip revision: 288a622
pc1.s 
pc1 <- function(x, hi)
{
  p <- ncol(x)
  x <-  x[!is.na(x %*% rep(1,p)),]
  xo <- x
  for(i in 1:p) {
    y <- x[,i]
    x[,i] <- (y-mean(y))/sqrt(var(y))
  }
  
  g <- prcomp(x)
  cat("Fraction variance explained by PC1:",format(g$sdev[1]^2/sum(g$sdev^2)),
      "\n\n")
  pc1 <- g$x[,1]
  
  f <- lsfit(xo, pc1)
  
  if(!missing(hi)) {
    if(sum(f$coef[-1]<0) >= p/2)
      pc1 <- -pc1
    
    r <- range(pc1)
    pc1 <- hi*(pc1-r[1])/diff(r)
    f <- lsfit(xo, pc1)
  }
  
  cat("Coefficients to obtain PC1:\n\n")
  print(f$coef)
  attr(pc1,"coef") <- f$coef
  invisible(pc1)
}
back to top