library("MASS")
library("ade4")
library("ggplot2")
# Se introduce la tabla
sex<-matrix(c(21,21,14,13,8,8,9,6,8,2,2,3,4,10,10),ncol=5,byrow=TRUE)
# Se calculan los porcentajes
ncol<-5
nrow<-3
n<-sum(sex)
rtot<-apply(sex,1,sum)
ctot<-apply(sex,2,sum)
xrtot<-cbind(rtot,rtot,rtot,rtot,rtot)
xctot<-rbind(ctot,ctot,ctot)
xrtot<-sex/xrtot
xctot<-sex/xctot
rdot<-rtot/n
cdot<-ctot/n
# Se calculan las matrices de distancias entre columnas
dcols<-matrix(0,ncol,ncol)
for(i in 1:ncol){
for(j in 1:ncol){d<-0
for(k in 1:nrow) d<-d+(xctot[k,i]-xctot[k,j])^2/rdot[k]
dcols[i,j]<-sqrt(d)}}
# Se calculan las matrices de distancias entre filas
drows<-matrix(0,nrow,nrow)
for(i in 1:nrow){
for(j in 1:nrow){d<-0
for(k in 1:ncol) d<-d+(xrtot[i,k]-xrtot[j,k])^2/cdot[k]
drows[i,j]<-sqrt(d)}}
# Se aplica el MDS metrico
r1<-cmdscale(dcols,eig=TRUE)
r1$points
r1$eig
c1<-cmdscale(drows,eig=TRUE)
c1$points
c1$eig
xrtot
qplot(xlab="Coordenada 1",ylab="Coordenada 2",main="Análisis de Correspondencia simple",xlim=range(r1$points[,1],c1$points[,1]),ylim=range(r1$points[,1],
c1$points[,1]),geom="tile")+geom_vline(xintercept =0, colour="black"
,linetype=5)+geom_hline(yintercept =0,
colour="black",linetype=5)+annotate("text", x = c1$points[1,1],y = c1$points[1,2],
label="Nopar",col="red")+annotate("text", x = c1$points[2,1],y = c1$points[2,2],
label="parnS",col="red")+annotate("text", x = c1$points[3,1],y = c1$points[3,2],
label="parS",col="red")+annotate("text", x = r1$points[1,1],y = r1$points[1,2],
label="ED1")+annotate("text", x = r1$points[2,1],y = r1$points[2,2],
label="ED2")+annotate("text", x = r1$points[3,1],y = r1$points[3,2],
label="ED3")+annotate("text", x = r1$points[4,1],y = r1$points[4,2],
label="ED4")+annotate("text", x = r1$points[5,1],y = r1$points[5,2],
label="ED5")
