# # OC_in_R_2015.r # # Program to Run R Version of OC # # # Remove all objects just to be safe # rm(list=ls(all=TRUE)) # library(pscl) library(oc) library(wnominate) library(gdata) # # # hr <- readKH("c:/uga_course_homework_11_2015/sen112kh.ord", dtl=NULL, yea=c(1,2,3), nay=c(4,5,6), missing=c(7,8,9), notInLegis=0, desc="112th Senate Data", debug=FALSE) # # # Call OC # # Example: 1-Dim # result1 <- oc(hr, dims=1, polarity=c(2)) # # Example: 2-Dim # result <- oc(hr, dims=2, polarity=c(2,7)) summary(result) windows() plot(result) # # ---- Useful Commands To See What is in an Object # # > length(result) # [1] 5 # > class(result) # [1] "OCobject" # > names(result) # [1] "legislators" "rollcalls" "dimensions" "eigenvalues" "fits" # # result$legislators # result$rollcalls # result$dimensions # result$eigenvalues # result$fits # # Legislators # write.fwf(x=format(as.data.frame(result$legislators),digits=5,width=10, scientific=FALSE),rownames=TRUE,"c:/uga_course_homework_11_2015/Sen112_X.txt") # # Roll Calls # write.fwf(x=format(as.data.frame(result$rollcalls),digits=5,width=10, scientific=FALSE),rownames=TRUE,"c:/uga_course_homework_11_2015/Sen112_Z.txt") # # result999 <- ifelse(is.na(result$rollcalls),999,result$rollcalls) nvotescaled <- sum(result999[,7]!=999) # ws <- result$rollcalls[,8] N1 <- result$rollcalls[,6] N2 <- result$rollcalls[,7] # oc1 <- result$legislators[,13] oc2 <- result$legislators[,14] party <- result$legislators[,6] state <- result$legislators[,2] # windows() par(mfrow=c(1,2)) # plot(oc1,oc2,type="n",asp=1, main="", xlab="", ylab="", xlim=c(-1.0,1.0),ylim=c(-1.0,1.0),cex=1.2,font=2) # # Main title mtext("OC Plot of 112th Senate (2011-12)\nSenator Ideal Points",side=3,line=1.50,cex=1.2,font=2) # x-axis title # x-axis title mtext("D=Northern Democrat, S=Southern Democrat\nR=Republican",side=1,line=3.25,cex=1.2) #mtext("Liberal - Conservative",side=1,line=2.75,cex=1.2) # y-axis title #mtext("Social/Lifestyle Issues",side=2,line=2.5,cex=1.2) # The meaning of the second dimension is no longer clear # # # Southern Democrats points(oc1[party == 100 & state >= 40 & state <= 51],oc2[party == 100 & state >= 40 & state <= 51],pch='S',col="red",font=2) points(oc1[party == 100 & state == 53],oc2[party == 100 & state == 53],pch='S',col="red",font=2) points(oc1[party == 100 & state == 54],oc2[party == 100 & state == 54],pch='S',col="red",font=2) # Northern Democrats points(oc1[party == 100 & state != 99 & (state < 40 | state > 54)],oc2[party == 100 & state != 99 & (state < 40 | state > 54)],pch='D',col="red",font=2) points(oc1[party == 100 & state == 52],oc2[party == 100 & state == 52],pch='D',col="red",font=2) # Republicans points(oc1[party == 200 & state != 99],oc2[party == 200 & state != 99],pch='R',col="blue",font=2) # # President Bush # points(oc1[state == 99],oc2[state == 99],pch='P',col="black",font=2) # plot(N1,N2,type="n",asp=1, main="", xlab="", ylab="", xlim=c(-1.0,1.0),ylim=c(-1.0,1.0),cex=1.2,font=2) # # Main title mtext("OC Plot of 112th Senate (2011-12)\nCoombs Mesh from Cutting Lines",side=3,line=1.50,cex=1.2,font=2) # x-axis title mtext("Liberal - Conservative",side=1,line=2.75,cex=1.2) # y-axis title #mtext("Social/Lifestyle Issues",side=2,line=2.5,cex=1.2) # # # Set Length of Arrows off ends of Cutting Lines # xlarrow <- 0.1 #xlarrow <- 0.0 # # i <- 1 #while (i <= 4){ while (i <= length(ws)){ if(result999[i,7]!=999){ # Plot Cutting Line # # This computes the point on the Normal Vector # Through which the Cutting Line passes # xws <- ws[i]*N1[i] yws <- ws[i]*N2[i] # # This computes the Cutting Line # arrows(xws,yws,xws+N2[i],yws-N1[i],length=0.0,lwd=2,col="black") arrows(xws,yws,xws-N2[i],yws+N1[i],length=0.0,lwd=2,col="black") # # # SET POLARITY HERE # polarity <- oc1*N1[i] + oc2*N2[i] - ws[i] vote <- hr$votes[,i] ivote <- as.integer(vote) errors1 <- ivote==1 & polarity >= 0 errors2 <- ivote==6 & polarity <= 0 errors3 <- ivote==1 & polarity <= 0 errors4 <- ivote==6 & polarity >= 0 kerrors1 <- ifelse(is.na(errors1),9,errors1) kerrors2 <- ifelse(is.na(errors2),9,errors2) kerrors3 <- ifelse(is.na(errors3),9,errors3) kerrors4 <- ifelse(is.na(errors4),9,errors4) kerrors12 <- sum(kerrors1==1)+sum(kerrors2==1) kerrors34 <- sum(kerrors3==1)+sum(kerrors4==1) # # if kerrors12 > kerrors34 then YEA is above the cutting line # if kerrors12 < kerrors34 then YEA is below the cutting line # # ( xwslow, ywslow ) is a point on the # normal vector above/below the cutting point # by xlarrow units. This allows the computation # of points to draw the arrows to from the ends # of the normal vectors # if(kerrors12 < kerrors34){ xwslow <- (ws[i]- xlarrow)*N1[i] ywslow <- (ws[i]- xlarrow)*N2[i] } if(kerrors12 >= kerrors34){ xwslow <- (ws[i]+ xlarrow)*N1[i] ywslow <- (ws[i]+ xlarrow)*N2[i] } # # ( xws+N2[i] , yws-N1[i] ) and # ( xws-N2[i] , yws+N1[i] ) are the coordinates for the two points # at the ends of the cutting line # # ( xwslow+N2[i],ywslow-N1[i] ) and # ( xwslow-N2[i],ywslow+N1[i] ) are the points above/below the # endpoints of the cutting line # to which the arrows are drawn # arrows(xws+N2[i],yws-N1[i],xwslow+N2[i],ywslow-N1[i],length=0.1,lwd=2,col="red") # These can be commented out if the arrows(xws-N2[i],yws+N1[i],xwslow-N2[i],ywslow+N1[i],length=0.1,lwd=2,col="red") # graph gets too busy # } i <- i + 1 } # # Overlay the Coombs Mesh with the Ideal Points # # Democrats points(oc1[party == 100 & state != 99],oc2[party == 100 & state != 99],pch=16,col="red",font=2) # Republicans points(oc1[party == 200 & state != 99],oc2[party == 200 & state != 99],pch=16,col="blue",font=2) #