## rot.proc <- function(x, y, scale=TRUE, weights=NULL, centerweight=FALSE, reflection=TRUE) {
## if (centerweight && !is.null(weights)) {
## xcent <- apply(x,2,weighted.mean,w=weights)
## ycent <- apply(y,2,weighted.mean,w=weights)
## x <- scale(x,scale=F,center=xcent)
## y <- scale(y,scale=F,center=ycent)
## }
## ### rotates 2 already centred matrices onto each other#
## if (!is.null(weights)) {
## Dn <- diag(weights)
## X1 <- Dn%*%x
## Y1 <- Dn%*%y
## XY <- crossprod(X1,Y1)
## } else
## XY <- crossprod(x,y)
## sv1 <- svd(XY)
## gamm <- tcrossprod(sv1$v,sv1$u)
## if (sign(det(gamm)) < 1 && !reflection) {
## if (!reflection) {
## u <- sv1$u
## v <- sv1$v
## chk1 <- Re(prod(eigen(v)$values))
## chk2 <- Re(prod(eigen(u)$values))
## if ((chk1 < 0) && (chk2 > 0)) {
## v[, dim(v)[2]] <- v[, dim(v)[2]] * (-1)
## gamm <- v %*% t(u)
## }
## if ((chk2 < 0) && (chk1 > 0)) {
## u[, dim(u)[2]] <- u[, dim(u)[2]] * (-1)
## gamm <- v %*% t(u)
## }
## }
## }
## del <- sv1$d
## ctrace <- function(MAT) sum(diag(crossprod(MAT)))
## if (scale) {
## if (!is.null(weights))
## bet <- sum(del)/ctrace(Y1)
## else
## bet <- sum(del)/ctrace(y)
## yrot <- bet*y%*%gamm}
## else
## yrot <- y%*%gamm
## return(yrot)
## }
rot.proc <- function(x, y, scale=TRUE, weights=NULL, centerweight=FALSE, reflection=TRUE) {
out <- rotonto(x=x, y=y, scale=scale, weights=weights, centerweight=centerweight, reflection=reflection,signref = FALSE)$yrot
return(out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.