## Example 1
x <- matrix(runif(20), nrow=10, ncol=2)+ 1.4
s <- matrix(c(cos(60), -sin(60), sin(60), cos(60)),
nrow=2, ncol=2, byrow=TRUE)
xbar <- 2.2 *(x %*% s) - 0.1
lt <- iProcrustes(x, xbar, translate=TRUE) ## return linear transformation
lt
## showing result
I <- matrix(1, nrow=nrow(x), ncol=1)
tx <- x - I %*% lt$T
## get the transformed matrix xnew
xnew <- lt$scal * (tx %*% lt$Q)
if (require(lattice)) {
xyplot(V1 ~ V2,
do.call(make.groups, lapply(list(x=x, xbar=xbar, T.xbar=lt$T.xbar,
xnew=xnew),as.data.frame)),
group=which, aspect=c(0.7), pch=c(1,3,2,4), col.symbol="black",
main=("Align the points in x to xbar"),
key=list(points=list(pch=c(1,3,2,4), col="black"), space="right",
text=list(c("x", "xbar", "T.xbar", "xnew"))))
}
## Example 2. centralized x and xbar prior to using iProcrustes
x <- matrix(runif(10), nrow=5, ncol=2)
s <- matrix(c(cos(60), -sin(60), sin(60), cos(60)),
nrow=2, ncol=2, byrow=TRUE)
xbar <- 1.2 *(x %*% s) - 2
I <- matrix(1, nrow=nrow(x), ncol=1)
x <- x-(I %*% colMeans(x)) ## shift the centroid of points in x to the origin
xbar <- xbar - (I %*% colMeans(xbar)) ## shift centroid to the origin
lt <- iProcrustes(x, xbar, translate=FALSE) ## return linear transformation
## only return the rotation/reflection matrix and scalling factor
lt
xnew=lt$scal *(x %*% lt$Q) ## transformed matrix aligned to centralized xbar
if (require(lattice)) {
xyplot(V1 ~ V2,
do.call(make.groups, lapply(list(x=x,xbar=xbar,
xnew=xnew), as.data.frame)),
group=which, auto.key=list(space="right"))
}
Run the code above in your browser using DataLab