# Programm zur Durchführung einer optimalen Skalierung

# V 0.2 vom 23.12.2004

# (c) Dr. Alexander Preuß

# Eine vollständige Datenmatrix N muss vorhanden sein!



# Bestimmung von I und J

I <- nrow(N)

J <- ncol(N)

# Bestimmung min(I,J)

r = min(I,J)

# Bestimmung der Vektoren EinsI und EinsJ

einsI <- matrix(rep(1, times=I), ncol = 1)
einsJ <- matrix(rep(1, times=J), ncol = 1)

# Bestimmung der Zeilen- und Spaltensummen von N

ssum <- t(einsI)%*%N
zsum <- N%*%einsJ

# Bestimmung der Gesamtsumme n

n <- sum(zsum)


# Bestimmung der Diagonalmatrizen Dz und Ds sowie Dz^(-0.5) und Ds^(-0.5)
# und Dz^(-1) und Ds^(-1)

Dz <- diag(c(zsum))
Ds <- diag(c(ssum))

Dzm5 <- diag(1/sqrt(c(zsum)))
Dsm5 <- diag(1/sqrt(c(ssum)))

Dzm1 <- diag(1/(c(zsum)))
Dsm1 <- diag(1/(c(ssum)))

# Bestimmung der Matrix A

A <- Dzm5%*%N%*%Dsm5

# Eigenwertzerlegung von AA'

L <- eigen(A%*%t(A))$values
E <- eigen(A%*%t(A))$vectors

# Bildung der Matrix E12, die die beiden größten Eigenvektoren enthält

E12 <- E[1:I,2:3]

# Bildung der Standardkoordinaten

x <- sqrt(n)*Dzm5%*%E12
y <- matrix(rep(0, times=J*2), ncol=2)
y[1:J,1] <- (1/sqrt(L[2]))*Dsm1%*%t(N)%*%x[1:I,1]
y[1:J,2] <- (1/sqrt(L[3]))*Dsm1%*%t(N)%*%x[1:I,2]

# Bestimmung der Anpassungsgüte

Summe_L = sum(L) - 1
G1 = L[2]/Summe_L
G2 = L[3]/Summe_L
G = G1 + G2

# Bildung der Gesamtkoordinaten

K12 <- matrix(rep(0, times = (I + J)*2), ncol=2)

K12[1:I,1:2] <- x
K12[(I+1):(I+J),1:2] <- y

# Graphische Ausgabe der Standardkoordinaten

plot(K12[1:(I+J),1],K12[1:(I+J),2], pch=".",xlab="1. Achse", ylab="2. Achse")
abline(h=0)
abline(v=0)

for (i in 1:I) {text(x[i,1],x[i,2],rnamen[i])}
for (j in 1:J) {text(y[j,1],y[j,2],cnamen[j])}