#  OC_in_R.r:  Program to Run R Version of OC. This script runs on R 3.0.0.
###

rm(list=ls(all=TRUE)) #  Remove all objects just to be safe



##  TO DO LIST FOR THE LINGUIST.###############################

### <1>  $$  INSTALL the following packages in R using the following code: [You only have to do this once.]
		# install.packages("pscl")
		# install.packages("oc")
		# install.packages("gdata")


### <2>	 $$  ENTER file path to folder where textfile is located, and where output Files will be stored

	# Windows format <- '\\home\\jtimm\\Desktop\\jt_OC'
	Directory_Name <- '/Users/wcroft/Documents/Bill/Research/Projects/MDS/IndefPrn-Timm13'    


### <3>	 $$  ENTER the name of the data file

	# DATA <- 'Attrib3-13transpose.txt' 
	DATA <- 'IndefPrn13.txt'   

### <4>  $$  If necessary, adjust the minVOTES and LOP values:

	# minVOTES specifies the minimum number of cutting lines to be used; the default is 10.
	#minVOTES <- 10; can be increased or lowered
	minVOTES <- 10

	# LOP is used to excluded highly lopsided distributions. For example, the default value (0.25) 
	# means that if the yes-no distribution for a cutting line is more lopsided than 97.5% to 2.5%,
	# then the cutting line will be dropped from the MDS analysis.
	#LOP <- .025 default; can be increased or lowered
	LOP <- .025

### <5>	 $$  Select ALL TEXT in this file (including that which precedes), and RUN Script.

######################################


# Sorts directory links and naming for output files based on user input
setwd(Directory_Name)
title <- gsub('.txt', "", DATA)

# Loads necessary packages into R 
library(pscl)
library(oc)
library(gdata)



# data.txt <- read.delim("C:/croft_exclamative/Garcia-Excl2.txt",header=)

data.txt <- read.delim(DATA,header=TRUE)

CUTs <- length(2:ncol(data.txt))
names2 <- colnames(data.txt)
names <- data.txt [,1]




tt <- data.txt [,-1]
names2 <- colnames(tt)
T <- (tt[,1:CUTs])

#T <- cbind(T,T) # Use with low # Rollcalls
#


# Format data as rollcall object
#
hr <- rollcall(T, yea=1, nay=6,  
        missing=9,
        notInLegis=8,
        desc= title,
        ) 
#
#
#  Call OC
#                     

# 2 Dimensional Analysis - Used in subsequent analyses
result <- oc(hr, dims=2, minvotes=minVOTES, lop=LOP, polarity=c(1,2))

# 1 Dimensional Analysis 
result_1 <- oc(hr, dims=1, minvotes=minVOTES, lop=LOP, polarity=c(1))

# 3 Dimensional Analysis
result_3 <- oc(hr, dims=3, minvotes=minVOTES, lop=LOP, polarity=c(1,2,3))



#Generates Calssification Summary Table
s <- t(cbind(result_1$fits, result$fits, result_3$fits))
s <- as.data.frame(cbind(1:3,s))
colnames(s) <- c("Dimensions", "Classification", "APRE")


write.fwf(x=format(as.data.frame(s),digits=5,width=10,
    scientific=FALSE),paste(title,'Class_File.txt', sep= "_")) 


#  Legislators - 2 Dimensions 
forOut <- cbind(as.character(names),result$legislators)
write.table(forOut,paste(title,'2D_X_File.txt', sep= "_"), sep = "\t", row.names=FALSE,col.names=TRUE, quote = FALSE)

#  Roll Calls - 2 Dimensions
forOut <- cbind(as.character(names2),result$rollcalls)
write.table(forOut,paste(title,'2D_Z_File.txt', sep= "_"), sep = "\t", row.names=FALSE,col.names=TRUE, quote = FALSE)


#  Legislators - 1 Dimension
forOut <- cbind(as.character(names),result_1$legislators)
write.table(forOut,paste(title,'1D_X_File.txt', sep= "_"), sep = "\t", row.names=FALSE,col.names=TRUE, quote = FALSE)


#  Roll Calls - 1 Dimension
forOut <- cbind(as.character(names2),result_1$rollcalls)
write.table(forOut,paste(title,'1D_Z_File.txt', sep= "_"), sep = "\t", row.names=FALSE,col.names=TRUE, quote = FALSE)


result999 <- ifelse(is.na(result$rollcalls),999,result$rollcalls)
nvotescaled <- sum(result999[,7]!=999)

#
#
# 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 
#
nrow <- length(result$legislators[,7])
namepos <- rep(2,nrow)
#
#
ws <- result$rollcalls[,8]
N1 <- result$rollcalls[,6]
N2 <- result$rollcalls[,7]
#
oc1 <-  result$legislators[,7]
oc2 <-  result$legislators[,8]



#Generates Point Data Figure [With Points Only]

jpeg(paste (title,'Points_Fig1.jpeg',sep = "_"),width = 7, height = 7, units = 'in',res = 300)

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 Example Tabs Data\nStimuli (Row) Ideal Points",side=3,line=1.50,cex=1.2,font=2)
# x-axis title
mtext("Dimension 1",side=1,line=3.25,cex=1.2)
# y-axis title
mtext("Dimension 2",side=2,line=2.5,cex=1.2)
#
points(oc1,oc2,pch=16,col="red",font=2)
#text(oc1,oc2,names,pos=namepos,offset=00.20,col="blue")

dev.off()


#Generates Point Data Figure [Labels Only]

jpeg(paste (title,'Points_Fig2.jpeg',sep = "_"),width = 7, height = 7, units = 'in',res = 300)
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)

mtext("OC Plot of Example Tabs Data\nStimuli (Row) Ideal Points",side=3,line=1.50,cex=1.2,font=2)
mtext("Dimension 1",side=1,line=3.25,cex=1.2)
mtext("Dimension 2",side=2,line=2.5,cex=1.2)
#text(oc1,oc2,names,pos=namepos,col="blue")
text(oc1,oc2,names,col="blue")
dev.off()


#Generates Cutting Line Figure

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 Example Tabs Data\nCoombs Mesh from Cutting Lines",side=3,line=1.50,cex=1.2,font=2)
# x-axis title
mtext("Dimension 1",side=1,line=3.25,cex=1.2)
# y-axis title
mtext("Dimension 2",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
#

#
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){
   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]
}
#
#
arrows(xws+N2[i],yws-N1[i],xwslow+N2[i],ywslow-N1[i],length=0.1,lwd=2,col="red") 
arrows(xws-N2[i],yws+N1[i],xwslow-N2[i],ywslow+N1[i],length=0.1,lwd=2,col="red") 
#
}

i <- i + 1
}

#text(oc1,oc2,names,pos=namepos,offset=00.20,col="blue")
points(oc1,oc2,pch=16,col="red",font=2)
dev.copy(jpeg,(paste (title,'CuttingLines_Fig1.jpeg', sep = "_")),width = 7, height = 7, units = 'in',res = 300)
dev.off() #Plots Figure 1.


text(ws*N1+N2,ws*N2-N1,names2,pos=namepos,offset=00.20,col="blue")
text(ws*N1-N2,ws*N2+N1,names2,pos=namepos,offset=00.20,col="blue")

dev.copy(jpeg,(paste (title,'CuttingLines_Fig2.jpeg', sep = "_")),width = 7, height = 7, units = 'in',res = 300)
dev.off() #Plots Figure 2.