Information Technology Reference
In-Depth Information
We illustrate the above procedure for calibrating a biplot axis with and without lambda
scaling using the first four columns of the reaction-kinetic data set available as
Reaction-
Kinetic.data
. For reference purposes we give this data set in Table 2.1. The following
code shows how to implement the calibration procedure to equip a biplot with calibrated
axes. Figure 2.7 shows the sample point
11
and biplot axis for variable
y
.
function (X = ReactionKinetic.data[,1:4], add = c(2,2),
shift = 0, lambda = 1, n.int = 5)
{
options(pty = "s")
par(mar = c(3,3,3,3))
# obtain biplot scaffolding
X.svd <- svd(X) # X not scaled or centered
col.means <- apply(X,2,mean)
sds <- apply(X,2,function(x) sqrt(var(x)))
UDelta <- X.svd$u %*% diag(X.svd$d)[,1:2]*lambda
V <- X.svd$v[,1:2]/lambda
# setup of plotting region
limx <- c(min(V[,1], UDelta[,1]), max(V[,1], UDelta[,1])) + shift
limy <- c(min(V[,2], UDelta[,2]), max(V[,2], UDelta[,2]))
plot(rbind(UDelta,V), asp = 1, xlim = limx*1.1, ylim = limy*1.1,
type = "n", xlab = "", ylab = "", xaxt = "n", yaxt = "n",
xaxs = "i", yaxs = "i", main = "")
points(x = 0, y = 0, pch = "O", cex = 2, col = "green")
# plot row co-ordinate
points(x = UDelta[11,1], y = UDelta[11,2], pch = 15)
text(x = UDelta[11,1], y = UDelta[11,2], text = "11", pos = 1,
cex = 0.70)
# plot axis for column 'y'
eq.line <- Draw.line2(x = c(0, V[1,1]), y = c(0,V[1,2]))
# plot column marker
arrows(x0 = 0, y0 = 0, x1 = V[1,1], y1 = V[1,2], col = "red",
lwd = 2, length = 0.15)
# plot row marker
arrows(x0 = 0, y0 = 0, x1 = UDelta[11,1], y1 = UDelta[11,2],
col = "red", lty = 2, lwd = 1.85, length = 0.1)
# obtain 'nice' markers
markers.x <- pretty(range(X[,1]), n = n.int)
# ensure O towards middle of figure
if (add[2]>0)
for(i in 1:add[2])
markers.x <- c(markers.x, markers.x[length(markers.x)]+
(markers.x[length(markers.x)] -
markers.x[length(markers.x)-1]))
if (add[1]>0)
for(i in 1:add[1])
markers.x <- c(markers.x[1] - (markers.x[2] - markers.x[1]),
markers.x)
markers.v <- markers.x
# apply eq (2.10)
calibrations.x <- (markers.v / sum(V[1,1:2]^2)) * V[1,1]
calibrations.y <- (markers.v / sum(V[1,1:2]^2)) * V[1,2]
