#### Principal Component Analysis applied directly to Sequence Matrix 
####  Tomokazu Konishi

##### R scripts for calculations

### reading the aligned sequence data:
###  the data have to be formatted in tab-separated text with two colums,
###  (name of sequence) \t (aligned sequence)

 sites <- read.table(file="abcd.txt", header=F, sep="\t")
 sites<-as.matrix(sites)
 dim(sites)

### finding the size of data
  n_sample <- dim(sites)[1]
  n_seq <- nchar(sites[2,2])

### translation of the sequence to bollean vectors 

bool <- array(0, dim=c(n_sample, 21*n_seq))


colnames(bool) <- c(paste("A_", 1:n_seq, sep=""),paste("C_", 1:n_seq, sep=""),paste("D_", 1:n_seq, sep=""),paste("E_", 1:n_seq, sep=""),paste("F_", 1:n_seq, sep=""),paste("G_", 1:n_seq, sep=""),paste("H_", 1:n_seq, sep=""),paste("I_", 1:n_seq, sep=""),paste("K_", 1:n_seq, sep=""),paste("L_", 1:n_seq, sep=""),paste("M_", 1:n_seq, sep=""),paste("N_", 1:n_seq, sep=""),paste("P_", 1:n_seq, sep=""),paste("Q_", 1:n_seq, sep=""),paste("R_", 1:n_seq, sep=""),paste("S_", 1:n_seq, sep=""),paste("T_", 1:n_seq, sep=""),paste("V_", 1:n_seq, sep=""),paste("W_", 1:n_seq, sep=""),paste("Y_", 1:n_seq, sep=""),paste("-_", 1:n_seq, sep=""))
rownames(bool) <- sites[,1]


  for (s in 1:n_sample){
     se <- sites[s, 2]
     se <- tolower(se)

#

	for (le in  1:n_seq){

	 base <- substr(se, le,le)
 
	if(base =="a") {
	bool[s, le] <-1
		} else {

	if(base =="c") {
	bool[s, le+n_seq] <-1
		} else {

	if(base =="d") {
	bool[s, le+n_seq*2] <-1
		} else {

	if(base =="e") {
	bool[s, le+n_seq*3] <-1
		} else {

	if(base =="f") {
	bool[s, le+n_seq*4] <-1
		} else {

	if(base =="g") {
	bool[s, le+n_seq*5] <-1
		} else {

	if(base =="h") {
	bool[s, le+n_seq*6] <-1
		} else {

	if(base =="i") {
	bool[s, le+n_seq*7] <-1
		} else {

	if(base =="k") {
	bool[s, le+n_seq*8] <-1
		} else {

	if(base =="l") {
	bool[s, le+n_seq*9] <-1
		} else {

	if(base =="m") {
	bool[s, le+n_seq*10] <-1
		} else {

	if(base =="n") {
	bool[s, le+n_seq*11] <-1
		} else {

	if(base =="p") {
	bool[s, le+n_seq*12] <-1
		} else {

	if(base =="q") {
	bool[s, le+n_seq*13] <-1
		} else {

	if(base =="r") {
	bool[s, le+n_seq*14] <-1
		} else {

	if(base =="s") {
	bool[s, le+n_seq*15] <-1
		} else {

	if(base =="t") {
	bool[s, le+n_seq*16] <-1
		} else {

	if(base =="v") {
	bool[s, le+n_seq*17] <-1
		} else {

	if(base =="w") {
	bool[s, le+n_seq*18] <-1
		} else {

	if(base =="y") {
	bool[s, le+n_seq*19] <-1
		} else {

	if(base =="-") {
	bool[s, le+n_seq*20] <-1

	}}}}}}}}}}}}}}}}}}}}}
	}}


############ PCA 

## centering : the center can be replaced to certain group
	center<- apply(bool, 2, mean)
	diffs<-sweep(bool, 2, center)
        diffs<-diffs/2^0.5  # dounble counting
	# checking distribution of the distances
    		dist<- (apply(diffs^2, 1, sum)/n_seq)^0.5
        	qqnorm(dist)
		hist(dist)

	# you can specify the range of sequence used in the calculation by replacing the removed range with zero;
	# for example, this will reproduce the result shown in the test.
   #		 diffs[,c(1:47, 1:47+n_seq, 1:47+2*n_seq,1:47+3*n_seq,1:47+4*n_seq)  ] <- 0   # removes the first 47 sites.
   #		 diffs[, c(248:n_seq, 248:n_seq+n_seq, 248:n_seq+2*n_seq,248:n_seq+3*n_seq, 248:n_seq+4*n_seq) ] <- 0   # removes the last 53 sites.

### PCA core
	res_svd <- svd(diffs)  #
	str(res_svd)
			Left <- res_svd$u		# the left singular vectors
			Right <- res_svd$v		# the right singular vectors
			sqL <- diag(res_svd$d)		# diagonal matrix of the singular values

 	### calculatinf of pc's 
	sPC_res  	<-	 Right %*% sqL / (n_sample^0.5)
	sPC_sample	 <-	 Left %*% sqL/ (n_seq^0.5)

	rownames(sPC_res)<- colnames(bool) 
 	rownames(sPC_sample)<- rownames(bool) 

#### output to text files
	write.table(sPC_sample, file="sPC_sample.txt", sep="\t")
	write.table(sPC_res, file="sPC_res.txt", sep="\t")


(sum(diffs^2)/n_seq)^0.5


#### output to png images
# sample
	png(width=2100, height=2300, pointsize = 80, file="sPC_sample_12.png")
	  par(lwd=4, mex=0.6, mai=c(4,4,3,0.2))
  	  plot( sPC_sample [,1], sPC_sample[,2], col="gray50" ,  pch=1, main="sample", xlab="", ylab="" , axes=T)
	dev.off()

# sites
	png(width=2100, height=2300, pointsize = 80, file="sPC_res_12.png")
	  par(lwd=4, mex=0.6, mai=c(4,4,3,0.2))
  	  plot( sPC_res [,1], sPC_res[,2], col="gray50" ,  pch=1, main="residure", xlab="", ylab="" , axes=T)
	dev.off()

 # contribution
	png(width=2100, height=2300, pointsize = 80, file="contributions.png")
	  par(lwd=4, mex=0.6, mai=c(4,4,3,0.2))
	  plot(1:20, (res_svd$d/sum(res_svd$d)*100)[1:20], pch=1, type="b",  lty=3, ylab="(%)", xlab="PC", main="Contribution", col="gray50")
	dev.off()


# 3D presentation
  install.packages("rgl")
  library("rgl")

 plot3d( sPC_sample [,1], sPC_sample[,2], sPC_sample[,3], col="black", pch=NA, main="Human", xlab="sPC1", ylab="sPC2", zlab="sPC3", type="p")
 #  text3d( sPC_sample [,1], sPC_sample[,2], sPC_sample[,3], texts=sites[,1], cex=.5, col="gray50", font=1)
 writeWebGL(width=700)


## TK 19 Dec 2017
