Receiver Operating Characteristic plot
r_wrapper.sh $script_file
rm(list = objects() )
############# FORMAT X DATA #########################
format<-function(data) {
ind=NULL
for(i in 1 : ncol(data)){
if (is.na(data[nrow(data),i])) {
ind<-c(ind,i)
}
}
#print(is.null(ind))
if (!is.null(ind)) {
data<-data[,-c(ind)]
}
data
}
########GET RESPONSES ###############################
get_resp<- function(data) {
resp1<-as.vector(data[,ncol(data)])
resp=numeric(length(resp1))
for (i in 1:length(resp1)) {
if (resp1[i]=="Control ") {
resp[i] = 0
}
if (resp1[i]=="XLMR ") {
resp[i] = 1
}
}
return(resp)
}
######## CHARS TO NUMBERS ###########################
f_to_numbers<- function(F) {
ind<-NULL
G<-matrix(0,nrow(F), ncol(F))
for (i in 1:nrow(F)) {
for (j in 1:ncol(F)) {
G[i,j]<-as.integer(F[i,j])
}
}
return(G)
}
###################NORMALIZING#########################
norm <- function(M, a=NULL, b=NULL) {
C<-NULL
ind<-NULL
for (i in 1: ncol(M)) {
if (sd(M[,i])!=0) {
M[,i]<-(M[,i]-mean(M[,i]))/sd(M[,i])
}
# else {print(mean(M[,i]))}
}
return(M)
}
##### LDA DIRECTIONS #################################
lda_dec <- function(data, k){
priors=numeric(k)
grandmean<-numeric(ncol(data)-1)
means=matrix(0,k,ncol(data)-1)
B = matrix(0, ncol(data)-1, ncol(data)-1)
N=nrow(data)
for (i in 1:k){
priors[i]=sum(data[,1]==i)/N
grp=subset(data,data\$group==i)
means[i,]=mean(grp[,2:ncol(data)])
#print(means[i,])
#print(priors[i])
#print(priors[i]*means[i,])
grandmean = priors[i]*means[i,] + grandmean
}
for (i in 1:k) {
B= B + priors[i]*((means[i,]-grandmean)%*%t(means[i,]-grandmean))
}
W = var(data[,2:ncol(data)])
svdW = svd(W)
inv_sqrtW =solve(svdW\$v %*% diag(sqrt(svdW\$d)) %*% t(svdW\$v))
B_star= t(inv_sqrtW)%*%B%*%inv_sqrtW
B_star_decomp = svd(B_star)
directions = inv_sqrtW%*%B_star_decomp\$v
return( list(directions, B_star_decomp\$d) )
}
################ NAIVE BAYES FOR 1D SIR OR LDA ##############
naive_bayes_classifier <- function(resp, tr_data, test_data, k=2, tau) {
tr_data=data.frame(resp=resp, dir=tr_data)
means=numeric(k)
#print(k)
cl=numeric(k)
predclass=numeric(length(test_data))
for (i in 1:k) {
grp = subset(tr_data, resp==i)
means[i] = mean(grp\$dir)
#print(i, means[i])
}
cutoff = tau*means[1]+(1-tau)*means[2]
#print(tau)
#print(means)
#print(cutoff)
if (cutoff>means[1]) {
cl[1]=1
cl[2]=2
}
else {
cl[1]=2
cl[2]=1
}
for (i in 1:length(test_data)) {
if (test_data[i] <= cutoff) {
predclass[i] = cl[1]
}
else {
predclass[i] = cl[2]
}
}
#print(means)
#print(mean(means))
#X11()
#plot(test_data,pch=predclass, col=resp)
predclass
}
################# EXTENDED ERROR RATES #################
ext_error_rate <- function(predclass, actualclass,msg=c("you forgot the message"), pr=1) {
er=sum(predclass != actualclass)/length(predclass)
matr<-data.frame(predclass=predclass,actualclass=actualclass)
escapes = subset(matr, actualclass==1)
subjects = subset(matr, actualclass==2)
er_esc=sum(escapes\$predclass != escapes\$actualclass)/length(escapes\$predclass)
er_subj=sum(subjects\$predclass != subjects\$actualclass)/length(subjects\$predclass)
if (pr==1) {
# print(paste(c(msg, 'overall : ', (1-er)*100, "%."),collapse=" "))
# print(paste(c(msg, 'within escapes : ', (1-er_esc)*100, "%."),collapse=" "))
# print(paste(c(msg, 'within subjects: ', (1-er_subj)*100, "%."),collapse=" "))
}
return(c((1-er)*100, (1-er_esc)*100, (1-er_subj)*100))
}
## Main Function ##
files_alias<-c("${my_title}")
tau=seq(0,1,by=0.005)
nfiles=1
f = c("${input}")
rez_ext<-list()
for (i in 1:nfiles) {
rez_ext[[i]]<-dget(paste(f[i], sep="",collapse=""))
}
tau<-tau[1:(length(tau)-1)]
for (i in 1:nfiles) {
rez_ext[[i]]<-rez_ext[[i]][,1:(length(tau)-1)]
}
######## OPTIMAIL TAU ###########################
#rez_ext
rate<-c("Optimal tau","Tr total", "Tr Y", "Tr X")
m_tr<-numeric(nfiles)
m_xp22<-numeric(nfiles)
m_x<-numeric(nfiles)
for (i in 1:nfiles) {
r<-rez_ext[[i]]
#tr
# rate<-rbind(rate, c(files_alias[i]," "," "," ") )
mm<-which((r[3,])==max(r[3,]))
m_tr[i]<-mm[1]
rate<-rbind(rate,c(tau[m_tr[i]],r[,m_tr[i]]))
}
print(rate)
pdf(file= paste("${pdf_output}"))
plot(rez_ext[[i]][2,]~rez_ext[[i]][3,], xlim=c(0,100), ylim=c(0,100), xlab="${X_axis} [1-FP(False Positive)]", ylab="${Y_axis} [1-FP(False Positive)]", type="l", lty=1, col="blue", xaxt='n', yaxt='n')
for (i in 1:nfiles) {
lines(rez_ext[[i]][2,]~rez_ext[[i]][3,], xlab="${X_axis} [1-FP(False Positive)]", ylab="${Y_axis} [1-FP(False Positive)]", type="l", lty=1, col=i)
# pt=c(r,)
points(x=rez_ext[[i]][3,m_tr[i]],y=rez_ext[[i]][2,m_tr[i]], pch=16, col=i)
}
title(main="${my_title}", adj=0, cex.main=1.1)
axis(2, at=c(0,20,40,60,80,100), labels=c('0','20','40','60','80','100%'))
axis(1, at=c(0,20,40,60,80,100), labels=c('0','20','40','60','80','100%'))
#leg=c("10 kb","50 kb","100 kb")
#legend("bottomleft",legend=leg , col=c(1,2,3), lty=c(1,1,1))
#dev.off()