library(TExPosition)
add.alpha <- function(col, alpha=0.65){
	apply(
		sapply(col, col2rgb)/255, 
		2, 
		function(x){
			rgb(x[1], x[2], x[3], alpha=alpha)
		}
	)  
}


data.in <- read.csv('DFW_BeerResponses.csv',header=TRUE,row.names=1)

##Sort the data 
data.sorted <- data.in
data.sorted <- data.sorted[order(data.sorted[,1], data.sorted[,2], data.sorted[,3], data.sorted[,4],decreasing=FALSE),]

###Bar plot
dev.new()
barplot(t(data.sorted),horiz=TRUE,axes=FALSE,col=c('olivedrab','goldenrod','steelblue4','firebrick','grey80','black'),las=1,cex.names=0.5,legend.text=colnames(data.in),args.legend=c(x=210,y=45,horiz=TRUE,cex=.75,box.lty=0),main="Raw values")

##Correspondence Analysis
ca.res <- epCA(data.in,graphs=FALSE,symmetric=TRUE)
fj.cols <- as.matrix(c('olivedrab','goldenrod','steelblue4','firebrick','grey80','black'))
epGraphs(ca.res,contributionPlots=FALSE,fj.col=fj.cols)
	##evidence suggests we can combine the data a bit.
	

##collapse the data.	
data.collapse <- cbind(data.in[,1:2],data.in[,3]+data.in[,4],data.in[,5]+data.in[,6])
colnames(data.collapse) <- c("A FAVORITE","LIKE","OK-NOT LIKE","NO-NEVER")
collapse.res <- epCA(data.collapse,graphs=FALSE)
##then CA plots
epGraphs(collapse.res,contributionPlots=FALSE,fj.col=as.matrix(c('olivedrab','goldenrod','firebrick','grey80')))

##Some stuff for the final pictures.
coll.comp1 <- paste0("Component 1 variance: ", round(collapse.res$ExPosition.Data$t[1],digits=3), "%")
coll.comp2 <- paste0("Component 2 variance: ", round(collapse.res$ExPosition.Data$t[2],digits=3), "%")
	##determine which beer belongs to which response.
Dsup <- fastEucCalc(collapse.res$ExPosition.Data$fi[,1:2], collapse.res$ExPosition.Data$fj[,1:2])
minD <- apply(Dsup, 1, min)
Group_Assigned <- Re(Dsup == repmat(minD, 1, ncol(Dsup)))
beer.cols <- matrix(add.alpha("white",0),nrow(Group_Assigned),1)

for(i in 1:nrow(Group_Assigned)){
	beer.cols[i,] <- c('olivedrab','goldenrod','firebrick','grey80')[which(Group_Assigned[i,]==1)]
}
beer.cols <- as.matrix(beer.cols)
prettyPlot(collapse.res$ExPosition.Data$fi,col=beer.cols,constraints= collapse.res$Plotting.Data$constraints,pch=20,contributionCircles=TRUE,contributions= collapse.res$ExPosition.Data$ci,xlab=coll.comp1,ylab=coll.comp2,cex=1.5)




###Bar plots again!

###Most favorited.
collapse.reorder <- data.collapse
collapse.reorder <- collapse.reorder[order(collapse.reorder[,1], collapse.reorder[,2], collapse.reorder[,3],decreasing=FALSE),]

dev.new()
barplot(t(collapse.reorder),horiz=TRUE,axes=FALSE,col=c('olivedrab','goldenrod','firebrick','grey80'),las=1,cex.names=0.5,legend.text=rownames(collapse.res$ExPosition.Data$fj),args.legend=c(x=210,y=45,horiz=TRUE,cex=.75,box.lty=0),main="Raw values")


###Least disliked.
collapse.reorder <- data.collapse
collapse.reorder <- collapse.reorder[order(collapse.reorder[,3], collapse.reorder[,2], collapse.reorder[,1],decreasing=TRUE),]
collapse.reorder <- collapse.reorder[,c(3,2,1,4)]

dev.new()
barplot(t(collapse.reorder),horiz=TRUE,axes=FALSE,col=c('firebrick','goldenrod','olivedrab','grey80'),las=1,cex.names=0.5,legend.text=c("OK-NOT LIKE","LIKE","A FAVORITE","NO-NEVER"),args.legend=c(x=210,y=45,horiz=TRUE,cex=.75,box.lty=0),main="Raw values")