# # double_center_nations.r -- Double-Center Program # # Data Must Be Transformed to Squared Distances Below # # # BRAZIL 9.00 4.83 5.28 3.44 4.72 4.50 3.83 3.50 2.39 3.06 5.39 3.17 # CONGO 4.83 9.00 4.56 5.00 4.00 4.83 3.33 3.39 4.00 3.39 2.39 3.50 # CUBA 5.28 4.56 9.00 5.17 4.11 4.00 3.61 2.94 5.50 5.44 3.17 5.11 # EGYPT 3.44 5.00 5.17 9.00 4.78 5.83 4.67 3.83 4.39 4.39 3.33 4.28 # FRANCE 4.72 4.00 4.11 4.78 9.00 3.44 4.00 4.22 3.67 5.06 5.94 4.72 # INDIA 4.50 4.83 4.00 5.83 3.44 9.00 4.11 4.50 4.11 4.50 4.28 4.00 # ISRAEL 3.83 3.33 3.61 4.67 4.00 4.11 9.00 4.83 3.00 4.17 5.94 4.44 # JAPAN 3.50 3.39 2.94 3.83 4.22 4.50 4.83 9.00 4.17 4.61 6.06 4.28 # CHINA 2.39 4.00 5.50 4.39 3.67 4.11 3.00 4.17 9.00 5.72 2.56 5.06 # USSR 3.06 3.39 5.44 4.39 5.06 4.50 4.17 4.61 5.72 9.00 5.00 6.67 # USA 5.39 2.39 3.17 3.33 5.94 4.28 5.94 6.06 2.56 5.00 9.00 3.56 # YUGOSLAVIA 3.17 3.50 5.11 4.28 4.72 4.00 4.44 4.28 5.06 6.67 3.56 9.00 # # Remove all objects just to be safe # rm(list=ls(all=TRUE)) # library(MASS) library(stats) # # T <- matrix(scan("C:/uga_course_homework_5_2015/nations.txt",0),ncol=12,byrow=TRUE) # nrow <- length(T[,1]) ncol <- length(T[1,]) # names <- c("Brazil ","Congo ","Cuba ","Egypt ","France ","India ","Israel ", "Japan ","China ","USSR ","USA ","Yugoslavia ") # # pos -- a position specifier for the text. Values of 1, 2, 3 and 4, # respectively indicate positions below, to the left of, above and # to the right of the specified coordinates # namepos <- rep(2,nrow) # TT <- rep(0,nrow*ncol) dim(TT) <- c(nrow,ncol) TTT <- rep(0,nrow*ncol) dim(TTT) <- c(nrow,ncol) # xrow <- NULL xcol <- NULL xcount <- NULL matrixmean <- 0 matrixmean2 <- 0 # # Transform the Matrix # i <- 0 while (i < nrow) { i <- i + 1 xcount[i] <- i j <- 0 while (j < ncol) { j <- j + 1 # # Square the Nations Similarities to get Dissimilarities # TT[i,j] <- (9.0 - T[i,j])**2 # } } # # Put it Back in T # T <- TT TTT <- sqrt(TT) # # # Call Double Center Routine From R Program # cmdscale(....) in stats library # The Input data are DISTANCES!!! Not Squared Distances!! # Note that the R routine does not divide # by -2.0 # ndim <- 2 # dcenter <- cmdscale(TTT,ndim, eig=FALSE,add=FALSE,x.ret=TRUE) # # returns double-center matrix as dcenter$x if x.ret=TRUE # # Do the Division by -2.0 Here # TTT <- (dcenter$x)/(-2.0) # # # Below is the old Long Method of Double-Centering # # Compute Row and Column Means # xrow <- rowMeans(T, na.rm=TRUE) xcol <- colMeans(T, na.rm=TRUE) matrixmean <- mean(xcol) matrixmean2 <- mean(xrow) # # Double-Center the Matrix Using old Long Method # Compute comparison as safety check # i <- 0 while (i < nrow) { i <- i + 1 j <- 0 while (j < ncol) { j <- j + 1 TT[i,j] <- (T[i,j]-xrow[i]-xcol[j]+matrixmean)/(-2) } } # # # Double-Center the Matrix Using old Long Method # Compute comparison as safety check # i <- 0 while (i < nrow) { i <- i + 1 j <- 0 while (j < ncol) { j <- j + 1 TT[i,j] <- (T[i,j]-xrow[i]-xcol[j]+matrixmean)/(-2) } } # # Run some checks to make sure everything is correct # xcheck <- sum(abs(TT-TTT)) # # # Perform Eigenvalue-Eigenvector Decomposition of Double-Centered Matrix # ev <- eigen(TT) # # Find Point furthest from Center of Space # aaa <- sqrt(max((abs(ev$vec[,1]))**2 + (abs(ev$vec[,2]))**2)) bbb <- sqrt(max(((ev$vec[,1]))**2 + ((ev$vec[,2]))**2)) # # Weight the Eigenvectors to Scale Space to Unit Circle # torgerson1 <- ev$vec[,1]*(1/aaa)*sqrt(ev$val[1]) #torgerson2 <- ev$vec[,2]*(1/aaa) # #torgerson1 <- -ev$vec[,1]*(1/aaa) torgerson2 <- -ev$vec[,2]*(1/aaa)*sqrt(ev$val[2]) xmax <- max(torgerson1,torgerson2) xmin <- min(torgerson1,torgerson2) # windows() plot(torgerson1,torgerson2,type="n",asp=1, main="", xlab="", ylab="", xlim=c(xmin,xmax),ylim=c(xmin,xmax),font=2) points(torgerson1,torgerson2,pch=16,col="red",font=2) text(torgerson1,torgerson2,names,pos=namepos,offset=0.2,col="blue",font=2) # # # Main title mtext("Double-Centered Nations Data \n Torgerson Coordinates",side=3,line=1.25,cex=1.5,font=2) # x-axis title mtext("Communist --- Non-Communist",side=1,line=2.75,cex=1.2,font=2) # y-axis title mtext("Developed --- 3rd World",side=2,line=2.5,cex=1.2,font=2) # # windows() # Get Absolute Value of Eigenvalues # Eigenvalues <- NULL Eigenorder <- order(abs(ev$value)) EigenNegative <- NULL DUMMY <- NULL i <- 1 while (i <= nrow){ DUMMY[i] <- i EigenNegative[i] <- 1 Eigenvalues[i] <- abs(ev$value[Eigenorder[nrow+1-i]]) if( ev$value[Eigenorder[nrow+1-i]] < 0.0)EigenNegative[i] <- 0 i <- i + 1 } plot(DUMMY,Eigenvalues, xlab="",ylab="", main="", type="n",axes=FALSE) # # Main title mtext("Eigenvalues of Double-Centered\n Agreement Score Matrix for Nations Example",side=3,line=1.25,cex=1.2,font=2) # x-axis title mtext("Dimension",side=1,line=2.75,cex=1.2) # y-axis title mtext("Eigenvalue",side=2,line=2.5,cex=1.2) # axis(1,1:nrow, # labels=c(' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9','10','11','12'), font=2,col.axis='black',cex.axis=1) # axis(2,at=NULL,col.axis='black',cex.axis=1.0,font=2) # box() i <- 1 while (i <=nrow){ if(EigenNegative[i]==1)points(DUMMY[i],Eigenvalues[i],pch=16,col="red",cex=1.2,font=2) if(EigenNegative[i]==0)points(DUMMY[i],Eigenvalues[i],pch=15,col="black",cex=1.4,font=2) i <- i + 1 } lines(DUMMY[1:nrow],Eigenvalues[1:nrow],lty=1,lwd=3,col="blue")