#**********************************************************************************************************************************************************************************
#************************************** HEMOLYZED vs NOT HEMOLYZED SAMPLES ********************************************************************************************************

library(Biobase)       # 2.18.0 version
library(nonrandom)     # 1.42 version
library(adk)           # 1.0-2 version
library(bootfs)        # 1.0.5 version
library(e1071)         # 1.6-3 version

setwd("")              # folder path

#**********************************************************************************************************************************************************************************
# subset             : annotated data frame
# X                  : expression matrix 
# pheno              : phenotypic data   
# X.train.f90        : final data RAW
# X.train.f90.ratios : final data RATIOS
#**********************************************************************************************************************************************************************************
### DATA

subset <- dataset[,dataset$Type=="sample"]
subdet <- detection[,dataset$Type=="sample"]
X <- exprs(subset)                  
pheno <- pData(subset)   
                 
#**********************************************************************************************************************************************************************************
#                                               SAMPLE PROCESSING
#**********************************************************************************************************************************************************************************
### CALIPER PS MATCHING (x=0.2)

# ps calculation
ps <- pscore(formula = HS.cl ~ Status+Age.class,data =pheno,name.pscore = "ps")

# caliper matching (caliper width of 0.2 of the pooled sd of the logit of the ps)
out<-ps.match(ps, object.control=NULL, matched.by=NULL,control.matched.by=ps, who.treated=1, treat=NULL,
name.match.index="match.index", ratio=2, caliper="logit", x=0.2, givenTmatchingC=TRUE, bestmatch.first=TRUE, 
setseed=403,combine.output=TRUE)

data<-out$data.matched
data[order(data$match.index),]

# training set
X.train     <- X[,colnames(X) %in% data$SampleID]
pheno.train <- pheno[rownames(pheno) %in% data$SampleID,]
Y <- pheno.train$HS.cl

# testing set
X.test     <- X[,colnames(X) %in% data$SampleID==F]
pheno.test <- pheno[rownames(pheno) %in% data$SampleID,]

#**********************************************************************************************************************************************************************************
#                                               DATA PRE-PROCESSING
#**********************************************************************************************************************************************************************************
### 90% FILTERING 

percdet <- apply(subdet,1,sum)/ncol(subdet)*100
X.train.f90 <- X.train[percdet>90,]        

#**********************************************************************************************************************************************************************************
### RATIO BASED NORMALIZATION
         
rationames<-character()                                            
X.train.f90.ratios <- NULL

for(i in 1:(dim(X.train.f90)[1]-1)) {
	for (j in (i+1):dim(X.train.f90)[1]) {
		ratio<-X.train.f90[i,] - X.train.f90[j,]
            X.train.f90.ratios <- rbind(X.train.f90.ratios,ratio)
		name<-paste(rownames(X.train.f90)[i],rownames(X.train.f90)[j],sep=".")
		rationames<-c(rationames,name)
}
}
rownames(X.train.f90.ratios) <- rationames

#**********************************************************************************************************************************************************************************
#                                               CLASS COMPARISON
#**********************************************************************************************************************************************************************************
### FC, T-TEST & AD TEST 

FC  <- f.FC(X.train.f90,Y=Y)
tt  <- f.T(X=X.train.f90,Y=Y)
ad  <- f.AD(X=X.train.f90, Y=Y)

#**********************************************************************************************************************************************************************************
# FDR CORRECTION for multiple testing

tt.pFDR=round(p.adjust(tt, method="BH"),5)
ad.pFDR=round(p.adjust(ad, method="BH"),5)

#**********************************************************************************************************************************************************************************
### VOLCANO PLOT

# thresholds:
# -log10(0.05) = 1.30103
# log2(1) = 0

pdf(paste("Testi\\Volcano.pdf",sep=""),width=7,height=7)

FC.th<-1;pval.th<-0.05

log.FC<-log2(FC);log.pval<--log10(tt.pFDR)

plot(log.FC,log.pval,main="Raw data",xlab="log2(Fold Change)",ylab="-log10(p-value)",xlim=c(-3,3),ylim=c(0,6),
     pch=16,cex.main=1.4,cex.axis=1.5, cex.lab=1.5) 

points(log.FC[log.FC>log2(FC.th)&log.pval>(-log10(pval.th))],log.pval[log.FC>log2(FC.th)&log.pval>(-log10(pval.th))],pch=16,col=2)
points(log.FC[log.FC<(-log2(FC.th))&log.pval>(-log10(pval.th))],log.pval[log.FC<(-log2(FC.th))&log.pval>(-log10(pval.th))],pch=16,col=3,)
points(log.FC[log.FC<(-log2(FC.th))&log.pval>(-log10(pval.th))],log.pval[log.FC<(-log2(FC.th))&log.pval>(-log10(pval.th))],pch=16,col=3,)

abline(h=-log10(pval.th),col=4,lwd=1);abline(v=log2(FC.th),col="gray",lty=2,lwd=2);abline(v=-log2(FC.th),col="gray",lty=2,lwd=2)
up<-sum(log.FC>log2(FC.th)&log.pval>(-log10(pval.th)));down<-sum(log.FC<(-log2(FC.th))&log.pval>(-log10(pval.th)))
text(-1,5.5,paste("n=",down,sep=""),font=2,cex=1.4);text(1,5.5,paste("n=",up,sep=""),font=2,cex=1.4)

dev.off()

#**********************************************************************************************************************************************************************************
### SCATTER PLOT

pdf(file="Testi\\AD_T_pval_graph.pdf")

pval.th<-0.05
log.pval.tt<--log10(tt.pFDR);log.pval.ad<--log10(ad.pFDR)

plot(log.pval.ad,log.pval.tt,xlim=c(0,4), ylim=c(0,4), xlab="-log10 AD test pval",ylab="-log10 T-test pval", main="Raw data", 
     pch=16, cex.main=1.4,cex.axis=1.5,cex.lab=1.5)

points(log.pval.ad[log.pval.ad>-log10(pval.th)&log.pval.tt>-log10(pval.th)],log.pval.tt[log.pval.ad>-log10(pval.th)&log.pval.tt>(-log10(pval.th))],pch=16,col=2)
points(log.pval.ad[log.pval.ad<(-log10(pval.th))&log.pval.tt<(-log10(pval.th))],log.pval.tt[log.pval.ad<(-log10(pval.th))&log.pval.tt<(-log10(pval.th))],pch=16,col=1)
points(log.pval.ad[log.pval.ad>-log10(pval.th)&log.pval.tt<(-log10(pval.th))],log.pval.tt[log.pval.ad>-log10(pval.th)&log.pval.tt<(-log10(pval.th))],pch=16,col=4)
points(log.pval.ad[log.pval.ad<(-log10(pval.th))&log.pval.tt>-log10(pval.th)],log.pval.tt[log.pval.ad<(-log10(pval.th))&log.pval.tt>-log10(pval.th)],pch=16,col=4)

abline(0,1, lty=2, col=2);abline(h=-log10(pval.th),col=4,lwd=1);abline(v=-log10(pval.th),col=4,lwd=1)
ad.tt <- sum(log.pval.ad>-log10(pval.th)&log.pval.tt>-log10(pval.th)) 
ad <- sum(log.pval.ad>-log10(pval.th)&log.pval.tt<(-log10(pval.th)))
tt <- sum(log.pval.ad<(-log10(pval.th))&log.pval.tt>(-log10(pval.th))) 
no.ad.tt <- sum(log.pval.ad<(-log10(pval.th))&log.pval.tt<(-log10(pval.th)))

text(3,2.5,paste("n=",AD.W,sep=""),font=2,cex=1.4);text(3,0.5,paste("n=",AD,sep=""),font=2,cex=1.4)
text(0.5,2.5,paste("n=",W,sep=""),font=2,cex=1.4);text(0.5,0.5,paste("n=",no.AD.W,sep=""),font=2,cex=1.4)

dev.off()

#**********************************************************************************************************************************************************************************
#                                               CLASS PREDICTION
#**********************************************************************************************************************************************************************************

#************************************
# STEP 1: BOOTSTRAP MIRNA SELECTION *
#************************************

logX <- t(X.train.f90)
groupings <- list(grx=Y)
n.bootstrap<-1000                                       

# BOOTSTRAP FS (1000 samples)

retBS1000 <- f.doBS(logX, groupings,fs.methods=c("pamr","scad+L2","rf_boruta"),DIR="1000_BOOT_f90", seed=123, bstr=n.bootstrap, 
saveres=FALSE, jitter=FALSE,maxiter=100, maxevals=50, bounds=NULL,max_allowed_feat=NULL, n.threshold=50,maxRuns=30, seed.boot=403)
     
res1000 <- resultBS(retBS1000, DIR="1000_BOOT_f90", vlabel.cex = 3, filter = 200, saveres = FALSE)

# list of miRNA from bootstrap selection 
tab.boot<-data.frame(res1000$tophits, as.numeric(res1000$tophits[,2])/n.bootstrap)
n.feat.select<-seq(1,dim(tab.boot)[1],1)
tab.boot<-data.frame(tab.boot,n.feat.select)
names(tab.boot)<-c("feat","freq","th","n.feat")

# co-occorrences of "hsa-miR-451" and "hsa-miR-16" 
res1000$adj["hsa-miR-451","hsa-miR-16"]          

### EGG-SHAPED PLOT (filter=300)

op <- par(mfrow =  c(1, 3),pty='s') 

pdf(file="Testi\\Egg-graph.f90.f.boot300.pdf") 

ig <- f.egg_graph(res1000$adj, main = "Egg-graph",highlight = NULL,layout="layout.ellipsis",pdf=NULL, pointsize=12, tk=FALSE,
node.color="darkblue", node.filter=NULL,vlabel.cex=3, vlabel.cex.min=0.5, vlabel.cex.max=1.3,max_node_cex=8,edge.width=0.5, 
filter=300, max_edge_cex=3.5, ewprop=3)   

dev.off() 

#************************************************
# STEP 2: CROSS VALIDATED LINEAR SVM CLASSIFIER *
#************************************************

### LOOCV LINEAR SVM 

set.seed(123)              

# SVM PARAMETERS

# cost
par<-10^(-4:4)

# class weights
W<-matrix(c(0.2,0.8,0.3,0.7,0.4,0.6,0.5,0.5),ncol=2,byrow=T)

# fixed grid of parameters

# NUMBER OF FEATURES included in the SVM model
cut<-c(seq(1,10,by=1),seq(11,20,by=2),seq(20,50,by=5),seq(60,80,by=10),max(tab.boot$n.feat))  

# predicted labels array
Z<-array(dim=c(nrow(W),length(par),length(cut),ncol(X))) 

# predicted probabilities array
PROB<-array(dim=c(nrow(W),length(par),length(cut),ncol(X)))

chi<-list()

for(k in 1:ncol(X)) {                                                                # LOOCV loop (number of subjects)

for(i in 1:length(cut)) {                                                            # CUT (number of features) loop
 
for(j in 1:length(par)) {                                                            # PAR loop

for(h in 1:nrow(W)) {                                                                # WEIGHT CLASS loop

chi[[i]] <-as.vector(tab.boot$feat[tab.boot$n.feat<=cut[i]])                         # set of features

Xtrain<-t(matrix(as.numeric(X[chi[[i]],-k]), ncol=ncol(X)-1, nrow=length(chi[[i]])))    
Ytrain<-Y[-k]
Xval<-as.matrix(X[chi[[i]],k])                                                       # prediction for one subject (the one left out)
Yval<-Y[k]     

SVM<-svm(Xtrain, as.character(Ytrain), type="C-classification", kernel="linear", class.weights=c("-1"=W[h,1],"1"=W[h,2]),
	cost=par[j],probability = TRUE)       

pred<-predict(SVM,t(Xval),decision.values=T)

z<-as.numeric(as.vector(pred))
Z[h,j,i,k]<-z
 
pred2<-attr(predict(SVM,t(Xval),probability=TRUE),"probabilities")[,2]

prob<-as.numeric(as.vector(pred2))
PROB[h,j,i,k]<-prob
print(k)
}
}
}
}

### SENSITIVITY, SPECIFICITY, YOUDEN INDEX calculation

model.perf<-data.frame()
for(i in 1:length(cut)) {
	for(j in 1:length(par)) {
		for(h in 1:nrow(W)) {
			z<-factor(Z[h,j,i,],levels=c(0,1))
			t<-table(z,Y)
			sens.test<-t[2,2]/(t[2,2]+t[1,2])
			spec.test<-t[1,1]/(t[1,1]+t[2,1])
                  youden<-sens.test+spec.test-1
                  model<-paste(cut[i],par[j],W[h,1],W[h,2],sep="_")
			model.perf<-rbind(model.perf,data.frame(model,sens.test,spec.test,youden))
		}
}
}

# sort by Youden index
sort <- model.perf[order(-model.perf$youden),]

### ROC SPACE 

unique<-unique(model.perf[,2:3])    
count<-numeric()
for(i in 1:dim(unique)[1]){
	count<-c(count,sum(unique[i,1]==model.perf[,2]&unique[i,2]==model.perf[,3]))
}
countmatrix<-cbind(unique,count)

pdf(file="Testi\\ROC space.pdf", width=8.5, height=8.5)

par(mar=c(5,4.5,4,2))
plot((1-countmatrix[,2]),
	countmatrix[,1],
	xlim=c(0,1),
	ylim=c(0,1),
	xaxt="n",
	yaxt="n",
	col=4,
	cex=3.5,
	xlab="FPR or (1-Specificity)",
	ylab="TPR or Sensitivity",
	main="ROC Space SVM Linear",
	cex.main=1.7,
	cex.lab=1.5)
axis(1,at=seq(0,1,0.1),cex.axis=1.2)
axis(2,at=seq(0,1,0.1),cex.axis=1.2)
lines(x=seq(-1,2,0.1),y=seq(-1,2,0.1),lty=2,col=2,lwd=2)
abline(v=seq(0,1,0.1),col="lightgrey",lty=3)
abline(h=seq(0,1,0.1),col="lightgrey",lty=3)
text((1-countmatrix[,2]),countmatrix[,1],labels=countmatrix[,3],cex=0.8)
legend(0.6,0.05,legend="Random Classification",lty=2,lwd=2,col=2,box.col=0,cex=1)

dev.off()