# # wnominate_hou108_Coombs_mesh.r # # ANALYZING SPATIAL MODELS OF CHOICE AND JUDGMENT WITH R # Dave Armstrong, Ryan Bakker, Royce Carroll, Christopher Hare, Keith T. Poole, and Howard Rosenthal # http://voteview.com/asmcjr.asp # # # Remove all objects just to be safe. rm(list=ls(all=TRUE)) # library(wnominate) library(pscl) # hr <- readKH( url("ftp://voteview.com/dtaord/hou108kh.ord"), dtl=NULL, yea=c(1,2,3), nay=c(4,5,6), missing=c(7,8,9), notInLegis=0, desc="108th House Roll Call Data", debug=FALSE) # result <- wnominate(hr, ubeta=15, uweights=0.5, dims=2, minvotes=20, lop=0.025, trials=3, polarity=c(1,5), verbose=FALSE) # WEIGHT <- (result$weights[2])/(result$weights[1]) print(WEIGHT) X1 <- result$legislators$coord1D X2 <- (result$legislators$coord2D)*WEIGHT party <- result$legislators$partyCode state <- result$legislators$icpsrState # DL1 <- result$rollcalls[,7] DL2 <- result$rollcalls[,8] ZM1 <- result$rollcalls[,9] ZM2 <- result$rollcalls[,10] YEA1 <- ZM1 - DL1 YEA2W <- (ZM2 - DL2) * WEIGHT NAY1 <- ZM1 + DL1 NAY2W <- (ZM2 + DL2) * WEIGHT A1 <- NAY1 - YEA1 A2 <- NAY2W - YEA2W ALENGTH <- sqrt(A1*A1 + A2*A2) N1W <- A1 / ALENGTH N2W <- A2 / ALENGTH for (i in 1:nrow(result$rollcalls)){ if (N1W[i] < 0 & !is.na(N2W[i])) N2W[i] <- -N2W[i] if (N1W[i] < 0 & !is.na(N1W[i])) N1W[i] <- -N1W[i] } # ws <- N1W*ZM1 + N2W*ZM2*WEIGHT xws <- ws*N1W yws <- ws*N2W # rcsamp <- sample(1:nrow(result$rollcalls), 100, replace=F) # plot(X1, X2, main="The 108th House\nCutting Lines", xlab="First Dimension (Liberal - Conservative)\nD = N Democrat, S = S Democrat, R = Republican, I = Ind", ylab="Second Dimension", xlim=c(-1,1), ylim=c(-1,1), asp=1, type="n") # Southern Democrats points(X1[party == 100 & state >= 40 & state <= 51], X2[party == 100 & state >= 40 & state <= 51], pch="S", col="gray67", font=2) points(X1[party == 100 & state == 53], X2[party == 100 & state == 53], pch="S", col="gray67", font=2) points(X1[party == 100 & state == 54 ], X2[party == 100 & state == 54], pch="S", col="gray67", font=2) # Northern Democrats points(X1[party == 100 & (state < 40 | state > 54)],X2[party == 100 & (state < 40 | state > 54)], pch="D", col="gray67", font=2) points(X1[party == 100 & state == 52], X2[party == 100 & state == 52], pch="D", col="gray67", font=2) # Republicans points(X1[party == 200], X2[party == 200], pch="R", col="gray33", font=2) # Independents points(X1[party == 328], X2[party == 328], pch="I", col="gray50", font=2) # for (i in 1:length(rcsamp)){ segments(xws[rcsamp[i]], yws[rcsamp[i]], xws[rcsamp[i]]+N2W[rcsamp[i]], yws[rcsamp[i]]-N1W[rcsamp[i]], lwd=2, col="black") segments(xws[rcsamp[i]], yws[rcsamp[i]], xws[rcsamp[i]]-N2W[rcsamp[i]], yws[rcsamp[i]]+N1W[rcsamp[i]], lwd=2,col="black") } # C1 <- N2W C2 <- -N1W for (i in 1:nrow(result$rollcalls)){ if (C1[i] < 0 & !is.na(C2[i])) C2[i] <- -C2[i] if (C1[i] < 0 & !is.na(C1[i])) C1[i] <- -C1[i] } theta <- atan2(C2,C1) theta4 <- theta * (180/pi) # cut.table <- cbind(theta4, N1W, N2W) # nrollcall <- 528 print(cut.table[nrollcall,]) # mean(abs(theta4), na.rm=T) length(theta4[!is.na(theta4) & abs(theta4) > 60]) / length(theta4[!is.na(theta4)]) # hist(theta4, breaks=20, xlim=c(-100,100), col="gray", main="Cutting Line Angles", xlab="Angle") #