options(OutDec=",")
library("cluster")
library("rpart")

cl_sel<-function(x,z,bl,miara=1,metoda="single")
{ # x - macierz predykcji modeli, z - prawdziwa klasa, 
  # bl - wektor błedów dla modeli z x, miara - miara odleglosci 1-6

mac_div<-function(x,z,mi=miara)
{ # x - macierz obs * modele , z - klasa prawdziwa mi - miara diversity

div_pair<-function(o1,o2)
{ # oracle dla C1 i C2
# do obliczen w procedurze
# o1 oracle label for classifier 1
# o2 oracle label for classifier 2
# tm - wyjscie
tm<-matrix(0,nrow=6,ncol=1)
tt<-table(o1,o2)
t1<-matrix(0,ncol=2,nrow=2)
t1<-tt
if (sum(o1)==0 & sum(o2)==0) t1[1,1]<-tt[1,1]
if (sum(o1)==length(o1) & sum(o2)==length(o2)) t1[2,2]<-tt[1,1]
if (sum(o1)==0 & sum(o2)>0) t1[1,]<-tt[1,]
if (sum(o1)>0 & sum(o2)==0) t1[,1]<-tt[,1]
a<-t1[2,2]
b<-t1[2,1]
c<-t1[1,2]
d<-t1[1,1]
rownames(tm)<-c("Pears","Hamm","Yule","DoubF","Kappa","Disag")
# przeksztalcanie na przedzial (0,1)
# na odleglosci
tm[1]<-1-abs(((a*d)-(b*c))/(sqrt(a+b)*sqrt(c+d)*sqrt(a+c)*sqrt(b+d))) #modyfikacja
tm[2]<-1-abs(((a+d)-(b+c))/(a+b+c+d)) #modyfikacja
tm[3]<-1-abs((a*d-b*c)/(a*d+b*c)) #modyfikacja
tm[4]<-1-abs(d/(a+b+c+d)) # modyfikacja
tm[5]<-1-abs((2*(a*c-b*d))/((a+b)*(c+d)+(a+c)*(b+d))) # modyfikacja
tm[6]<-(b+c)/(a+b+c+d)
return(tm)
} # koniec div_pair

nklas<-ncol(x)
nobs<-nrow(x)
odl<-matrix(nrow=nklas,ncol=nklas)
rownames(odl)<-rownames(odl, do.NULL = FALSE, prefix = "C")
colnames(odl)<-colnames(odl, do.NULL = FALSE, prefix = "C")
for (i in 1:nklas) for (j in 1:nklas)
{
o1<-as.numeric(x[,i]==z) # oracle label for classifier x[,i]
o2<-as.numeric(x[,j]==z) # oracle label for classifier x[,j]
odl[i,j]<-div_pair(o1,o2)[mi]
if (odl[i,j]<0) odl[i,j]<-abs(odl[i,j])
}
return(odl)
} # koniec mac_div

mvote<-function(x)
{ # losowe rozstrzyganie remisow
t<-table(x)
ll<-length(t)
tm<-as.matrix(t)
m<-rownames(tm)[which.max(t)]
mm<-ifelse(sum(t==max(t))>1, rownames(tm)[sample(1:ll,1)], m)
if (is.numeric(x)) mm<-as.numeric(mm)
return(mm)
} # koniec m_vote

y<-NULL
kl<-ncol(x) # liczba modeli = max. liczba klas
obs<-nrow(x) # liczba obserwacji
ls<-numeric(length=kl) # liczba skupień
ls<-0
pr<-numeric(length=obs) # predykcja agregatu
macodl<-as.dist(mac_div(x,z,mi=miara))
# klasy<-hclust(macodl,method=metoda)
# klasy<-pam(macodl,diss=TRUE)
klasy<-agnes(macodl,diss=TRUE, method=metoda)
for (i in 2:(kl-1))
{
ss<-silhouette(cutree(klasy,k=i),macodl)
ls[i]<-mean(ss[,3])
}
optls<-which.max(ls) # optymalna liczba skupien
# print(optls) 
# drukowanie liczby skupien #
numery<-cutree(klasy,k=optls) 
for (j in 1:optls)
{ 
# wybór modelu najbardziej dokladnego z kazdej klasy
rob<-as.matrix(x[,which(numery==j)])
rblad<-bl[which(numery==j)]
najdok<-which.min(rblad)
y<-cbind(y,rob[,najdok])
}
for (i in 1:obs) pr[i]<-mvote(y[i,])
structure(list(pred=pr,olklas=optls))
# koniec cl_sel #
}

# tylko dla jednego zbioru
# Spam 

data(spam)
m<-nrow(spam)
ucz <- sample(1:m, size = 3000, replace = FALSE) 
spam1<-spam[ucz,]
spam.test<-spam[-ucz,]
blad<-matrix(nrow=6,ncol=4)
met<-c("average","single","complete","ward")
colnames(blad)<-met
rownames(blad)<-c("Pears","Hamm","Yule","DF","Kappa","Disag")
olk<-blad
ks<-c(10,20,30,40,50,60,70,80,90,100,150,200)
for (k in seq(along=ks)) 
{
#### petla ###
yklas<-NULL
m<-nrow(spam1)
lmod<-ks[k] # liczba modeli pojedynczych do klasyfikacji
blad.test.tr<-numeric(length=lmod)
for (i in 1:lmod)
{ # drzewa
ucz <- sample(1:m, size = round(2*m/3), replace = TRUE) 
spam1.ucz <- spam1[ucz,]
spam.tr<-rpart(spam~.,spam1.ucz)
# tak bylo - blad dla uczacego ?
#Z.test<-predict(spam.tr,spam1,type ="class")
#blad.test.tr[i]<-1-sum(Z.test==spam1$spam)/length(Z.test)
Z.test<-predict(spam.tr,spam.test,type ="class")
blad.test.tr[i]<-1-sum(Z.test==spam1$spam)/length(Z.test)
yklas<-cbind(yklas,as.matrix(Z.test))
}
# blad.test.tr

for (i in 1:6) for (j in 1:4)
{
xx<-cl_sel(yklas,as.matrix(spam.test$spam),blad.test.tr,miara=i, metoda=met[j])
blad[i,j]<-1-sum(xx$pred==spam.test$spam)/length(xx$pred)
olk[i,j]<-xx$olklas
}
print(blad)
}