####################################################
#reading data and description for boys for t-shirt
####################################################


d=read.table("tshirt.txt", sep = ",")


medidas <- c("X10","X0030_mk","X1510","X1520","X1530","X3020_mk",
             "X3030_LR","X4020","X4030","X4040_mk","X4080_LR","X4510","X5020","X5030_mk","X5040_mk",
             "X6010_mk","X6011_mk","X6012_mk","X6510_mk","X7520","X7525","X7540","X8010_LR",
             "X8030_LR","X8040_LR","X8520_LR","X8550_LR")
             #,"X0100","X0110","X9035_LR","X9510_LR","X9520_LR","X9550_LR")

datos=d[,c("User_code","Size_fit","Expert_evaluation", medidas)]



library(verification)
library(caret)

###########################
#Classification boys Leave One Out individual
###########################



#boys

db=datos[d$SEXO=="V",]
#girls
#db=datos[d$SEXO=="M",]
#db=db[-22,] #nan in expert evaluation 

#removing nans, boys

kk=db[-24,1:30]
kk=kk[-24,]

kk=kk[-62,]

db=kk
###end removing nans


##############
#LDA
##############

library(MASS)

#size fit
ninos=unique(db[,1])

preaire=c()
da=db[,c(2,4:30)]
da$Size_fit <- as.factor(da$Size_fit) 

for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

z <- lda(as.factor(Size_fit) ~ ., da, subset = TR)

TE=db[,1] %in% ninos[i]


preaire=rbind(preaire,predict(z, da[TE,])$posterior)

}


clre=max.col(preaire[,1:3])-2


sum(clre==db[,2]) #79 correct from 106


rlda=rps( db[,2]+2,preaire)
confusionMatrix(clre,db[,2])


##############
#QDA
##############

library(MASS)

#size fit
ninos=unique(db[,1])

preaire=c()
da=db[,c(2,4:30)]
da$Size_fit <- as.factor(da$Size_fit) 

for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

z <- qda(as.factor(Size_fit) ~ ., da, subset = TR)

TE=db[,1] %in% ninos[i]


preaire=rbind(preaire,predict(z, da[TE,])$posterior)

}


clre=max.col(preaire[,1:3])-2


sum(clre==db[,2]) # Error in qda.default(x, grouping, ...) : 
  some group is too small for 'qda'



###############
#POLR
###############
#regression


#size fit
ninos=unique(db[,1])

set.seed(2015)
preaire=c()
da=db[,c(2,4:30)]
da$Size_fit <- as.factor(da$Size_fit) 

for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]


nullmodel <- polr(as.factor(Size_fit) ~ 1, data = da, subset = TR)
stepmodel <- step_start(nullmodel, da,TR)

TE=db[,1] %in% ninos[i]


preaire=rbind(preaire,predict(stepmodel, da[TE,],type='probs'))

}


clre=max.col(preaire[,1:3])-2


sum(clre==db[,2]) 


rpolr=rps( db[,2]+2,preaire)
confusionMatrix(clre,db[,2])  

###########
#RF selecting mtry each time LOU
############
preai=c()


da=db[,-1]
attach(da)
mtv=c()

who=1:length(ninos)

for (i in who){

TR=db[,1] %in% ninos[-i]

aooo=c()

for (j in 5:15){
my_cforest_control <- cforest_control(teststat = "max",
    testtype = "Teststatistic", mincriterion = 0, ntree = 500, mtry = j,
    replace = TRUE)
set.seed(2015)
marboli=cforest(factor(Size_fit,ordered=TRUE)+Expert_evaluation~.,data=da,subset=TR,controls=my_cforest_control) 


qqi=predict(marboli,OOB=T)
pmi=matrix(unlist(qqi),ncol=4,byrow=TRUE)
cli=max.col(pmi[,1:3])-2

aooo[j-4]=sum(cli==db[TR,2])

}
mtv[i]=which.max(aooo)+4


my_cforest_control <- cforest_control(teststat = "max",
    testtype = "Teststatistic", mincriterion = 0, ntree = 500, mtry = which.max(aooo)+4,
    replace = TRUE)
set.seed(2015)
marboli=cforest(factor(Size_fit,ordered=TRUE)+Expert_evaluation~.,data=da,subset=TR,controls=my_cforest_control) 


TE=db[,1] %in% ninos[i]

qq=predict(marboli,db[TE,],OOB=FALSE)

preai=rbind(preai,matrix(unlist(qq),ncol=4,byrow=TRUE))
}

cl=max.col(preai[,1:3])-2

conjunto=db[,1] %in% ninos

sum(cl==db[conjunto,2])  


rrf=rps( db[,2]+2,preai[,1:3])

confusionMatrix(cl,db[conjunto,2])  

##############
#LDA variable selection 
##############

library(MASS)
library(klaR)

#size fit
ninos=unique(db[,1])

preaire=c()
da=db[,c(2,4:30)]
da$Size_fit <- as.factor(da$Size_fit) 

for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

#gw_obj <- greedy.wilks(as.factor(Size_fit)[TR] ~ ., data = da[TR,], niveau = 0.1)
gw_obj <- greedy.wilks(Size_fit ~ ., data = da, subset=TR, niveau = 0.1)

z <- lda(gw_obj$formula, da, subset = TR)

TE=db[,1] %in% ninos[i]


preaire=rbind(preaire,predict(z, da[TE,])$posterior)

}


clre=max.col(preaire[,1:3])-2


sum(clre==db[,2]) #74 correct from 106

rlda2=rps( db[,2]+2,preaire)
confusionMatrix(clre,db[,2])  

##############
# Ensemble LDA-RF
##############

library(verification)

############
#combining: ensemble
##########
#weighting

w=seq(0,1,0.01)


prc=c()
clw=c()
aw=c()

for (i in 1:length(w)){
prc=w[i]*preai[,1:3]+(1-w[i])*preaire
clw=max.col(prc[,1:3])-2
aw[i]=sum(clw==db[,2])
}

p=6

1- rrf$rps^p/(rrf$rps^p+ rlda$rps^p)
#[1] 0.5225434
#> aw[53]
#[1] 81

i=53
prc=w[i]*preai[,1:3]+(1-w[i])*preaire
clw=max.col(prc[,1:3])-2
confusionMatrix(clw,db[,2])  
rrfw=rps( db[,2]+2,prc[,1:3])

##############
# Ensemble POLR-RF
##############

############
#combining: ensemble
##########
#weighting

w=seq(0,1,0.01)


prc=c()
clw=c()
aw=c()

for (i in 1:length(w)){
prc=w[i]*preai[,1:3]+(1-w[i])*preaire
clw=max.col(prc[,1:3])-2
aw[i]=sum(clw==db[,2])
}

p=6
1- rrf$rps^p/(rrf$rps^p+ rpolr$rps^p)

#[1] 0.8373916
# aw[85]
#[1] 79

i=85
prc=w[i]*preai[,1:3]+(1-w[i])*preaire
clw=max.col(prc[,1:3])-2
confusionMatrix(clw,db[,2])  
rrfw=rps( db[,2]+2,prc[,1:3])

##############
# Ensemble LDA variable selection-RF
##############

library(verification)

############
#combining: ensemble
##########
#weighting

w=seq(0,1,0.01)


prc=c()
clw=c()
aw=c()

for (i in 1:length(w)){
prc=w[i]*preai[,1:3]+(1-w[i])*preaire
clw=max.col(prc[,1:3])-2
aw[i]=sum(clw==db[,2])
}

p=6
1- rrf$rps^p/(rrf$rps^p+ rlda2$rps^p)
#[1] 0.3312349
#> aw[34]
#[1] 76

i=34
prc=w[i]*preai[,1:3]+(1-w[i])*preaire
clw=max.col(prc[,1:3])-2
confusionMatrix(clw,db[,2])  
rrfw=rps( db[,2]+2,prc[,1:3])

###################
#k-nn
####################

library(class)
ninos=unique(db[,1])
da=db[,4:30]
attach(db)

set.seed(20)
#chosing the number of neighbours

wk=c()


preai=c()
for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

ac=c()
for (k in 1:7){
qq=knn.cv(da[TR,], db[TR,2], k = k)
ac[k]=sum(db[TR,2]==qq)
}

km=which.max(ac)
wk[i]=km

TE=db[,1] %in% ninos[i]
ki=knn(da[TR,], da[TE,], db[TR,2],k=km)




preai=c(preai,ki)


}

sum(db[,2]==round(preai-2))
#74
wk


#3 3 4 3 2 4 2 3 4 4 4 7 3 2 3 4 3 2 3 3 3 4 3 4 3 4 3 4 3 4 3 3 4 3 4 3 5 3 3 4 4 3 2 5 3 3 3 3 4 3

#> table(wk)
#wk
#  2  3  4  5  7 
# 5 26 16  2  1 




confusionMatrix(round(preai-2),db[,2])  


#######################
#MARS
#######################

#Size_fit classification
library(mda)

ninos=unique(db[,1])
da=db[,4:30]
attach(db)

preai=c()
for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]


TE=db[,1] %in% ninos[i]

marsi=mars(da[TR,],db[TR,2])




preai=c(preai,predict(marsi,da[TE,]))


}

 sum(db[,2]==round(preai))
  cm=round(preai)
  cm[cm>1]=1
  cm[cm<(-1)]=-1
sum(db[,2]==cm)
 
 
confusionMatrix(cm,db[,2])  


#Size_fit classification and Expert Evaluation
library(mda)

ninos=unique(db[,1])
da=db[,4:30]
attach(db)

preai=c()
for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]


TE=db[,1] %in% ninos[i]

marsi=mars(da[TR,],db[TR,2:3])




preai=rbind(preai,predict(marsi,da[TE,]))


}

 sum(db[,2]==round(preai[,1]))
 
 summary(abs(preai[,2]-db[,3]))

# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#0.01389 0.51950 1.48500 1.94800 2.70900 9.37300 

 

 cm=round(preai[,1])
  cm[cm>1]=1
  cm[cm<(-1)]=-1
sum(db[,2]==cm)#69
 
 
confusionMatrix(cm,db[,2])  


###########
#SVM
##############



library(e1071)
ninos=unique(db[,1])

preai=c()
for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

svmi=svm(db[TR,4:30],db[TR,2])




TE=db[,1] %in% ninos[i]



preai=c(preai,predict(svmi,db[TE,4:30]))


}

sum(db[,2]==round(preai))
#73 #type regression


#clasification
library(e1071)
ninos=unique(db[,1])

preai=c()
for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

svmi=svm(db[TR,4:30],as.factor(db[TR,2]))




TE=db[,1] %in% ninos[i]



preai=c(preai,predict(svmi,db[TE,4:30]))


}

sum(db[,2]==(preai-2))
#75

confusionMatrix(round(preai-2),db[,2])  


###########
#clustered SVM
##############

ce=8 #recomended Gu and Han, page 312
library(SwarmSVM)
ninos=unique(db[,1])

preai=c()
for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

svmi=clusterSVM(db[TR,4:30],as.factor(db[TR,2]),centers = ce, seed = 512,verbose=0)




TE=db[,1] %in% ninos[i]


if(sum(TE)>1){
preai=c(preai,predict(svmi,db[TE,4:30])$predictions)}

if(sum(TE)==1){
p1=predict(svmi,as.matrix(rbind(db[TE,4:30],db[TE,4:30])))$predictions
preai=c(preai,p1[1])
}


}

sum(db[,2]==(preai-2))

confusionMatrix(round(preai-2),db[,2]) 

################
#FDA
################

library(mda)
preai=c()
for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

fdai=fda(as.factor(db[TR,2])~as.matrix(db[TR,4:30]),method=mars)


TE=db[,1] %in% ninos[i]



preai=c(preai,predict(fdai,as.matrix(db[TE,4:30])))


}
sum(db[,2]==(preai-2))

#72


confusionMatrix(round(preai-2),db[,2])  


#####################
#Projection pursuit
#####################


#Size_fit classification



ninos=unique(db[,1])
da=db[,4:30]
attach(db)

who=1:length(ninos)

preai=c()
nm=c()
for (i in 1:length(ninos)){

TR=db[,1] %in% ninos[-i]

whoi=who[-i]
appi=c()

for (num in 1:27){
pprii=c()
for(h in whoi){
TRi=db[,1] %in% ninos[c(-i,-h)]


TEi=db[,1] %in% ninos[h]


# fit PPR
fiti <- ppr(da[TRi,],db[TRi,2],nterms=num)
pprii=c(pprii,predict(fiti,da[TEi,],nterms=num))
}
appi[num]=sum(round(pprii)==db[TR,2])

}

nm[i]=which.max(appi)

TE=db[,1] %in% ninos[i]

ppri=ppr(da[TR,],db[TR,2],nterms=nm[i])

preai=c(preai,predict(ppri,da[TE,]))


}

 sum(db[,2]==round(preai))
#83
#> nm
#  [1]  1  2  2  1  9  2  1  1  1  1  6  2  1  4  4 10  1  1  1  1  6  1  4  5  6  1  5  3  1  1  1  1 11  9  2  1  2  1  1  1  2  1  1  7  2  7  1 10  6  1

 

confusionMatrix(round(preai),db[,2])  


###########################
#Classification girls Leave One Out individual
###########################


db=datos[d$SEXO=="M",]

#removing nan

kk=db[-22,1:30] #nan de expert evaluation
kk=kk[-22,]

kk=kk[-64,]

kk=kk[-64,]


db=kk
###end removing nans



##############
#The same classifiers as boys
##############


#k-nn, set.seed(2016)

