######################################################
# Script to reproduce the PCA calculations on the R
######################################################

#####
# preparing a text file of aligned sequence 
#####

# Here uses an example of HA sequences, which is served as a FASTA file, "seg4.fas".
# This can be transferred into a tab-separated text file, by replacing "\n" to "\t" and then "\t>" to "\n>".
# The text was named as "seg4.txt". Please find it stored in the same folder.
# The text file should be placed on the active directory of the R.
# 
#

### reading the sequence file onto the R
 Nuc <- read.table(file="seg1trim.txt",  sep="\t") 
 Nuc <-as.matrix(Nuc)

 (n_sample<-dim(Nuc)[1])
 (n_base<- nchar(Nuc[2,2]))

### preparing the boolean vector
 Nuc_base <- array(0, dim=c(n_sample, 5*n_base))
 colnames(Nuc_base) <- c(paste("A_", 1:n_base, sep=""),paste("T_", 1:n_base, sep=""),paste("G_", 1:n_base, sep=""),paste("C_", 1:n_base, sep=""),paste("-_", 1:n_base, sep=""))
 rownames(Nuc_base) <- Nuc[,1]


### filling the boolean vector
  for (s in 1:n_sample){
     se <- Nuc[s, 2]
     se <- tolower(se)
	for (le in  1:n_base){
	 base <- substr(se, le,le)
 
	if(base =="a") {
	Nuc_base[s, le] <-1
		} else {

	if(base =="t") {
	Nuc_base[s, le+n_base] <-1
		} else {

	if(base =="g") {
	Nuc_base[s, le+n_base*2] <-1
		} else {

	if(base =="c") {
	Nuc_base[s, le+n_base*3] <-1
		} else {

	if(base =="-") {
	Nuc_base[s, le+n_base*4] <-1
}}}}}}}

(nameNuc <- rownames(Nuc_base) )

### centering the boolean vector
 means<- apply(Nuc_base, 2, mean) # mean of all samples
 diffs<-sweep(Nuc_base, 2, means)  # differences from the mean
 diffs<-diffs/2^0.5 # double counts

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

### calculatinf of PCs
	sPC_base  	<-	 Right %*% sqL / (n_sample^0.5)  # PC for base
	sPC_sample	 <-	diffs %*%   Right  / (n_base)^0.5  # PC for sample

#####
## output ##
#####


### PC1 vs PC2 for samples
 plot(-1*sPC_sample[,1], sPC_sample[,2], ylab="sPC2", xlab="sPC1", main="HA")

 # Here the sign of PC1 was adjusted to align different presentations for comparison.

### Contributions
 plot(res_svd$d/sum(res_svd$d)*100)

### by specifying samples such as "A", "R", or "M", the figure presented here could be reproduced. 
# In this case, for example,


types<-c("M" ,"M" ,"A" ,"6" ,"8" ,"8" ,"A" ,"M" ,"2" ,"R" ,"R" ,"R" ,"R" ,"6" ,"8" ,"A" ,"A" ,"1" ,"6" ,"1" ,"6" ,"6" ,"6" ,"6" ,"6" ,"1" ,"8" ,"8" ,"1" ,"8" ,"6" ,"8" ,"7" ,"6" ,"7" ,"6" ,"8" ,"1" ,"2" ,"M" ,"8" ,"2" ,"8" ,"Sw" ,"Ia" ,"18" ,"43" ,"30" ,"T")

 plot(-1*sPC_sample[,1], sPC_sample[,2], ylab="sPC2", xlab="sPC1", main="HA", pch="")
 text(-1*sPC_sample[,1], sPC_sample[,2],labels=types)

# colors can be specified by this way,
 colors <- which(types=="R")
 text(-1*sPC_sample[colors,1], sPC_sample[colors,2],labels=types[colors], col="green")

### text output
 rownames(sPC_base)<-  colnames(Nuc_base) 
 write.table(sPC_base, file="sPC_base.txt", sep="\t")
 write.table(sPC_sample, file="sPC_sample.txt", sep="\t")


