# przyklad 4.2
# w pamięci musi być tablica z przykladu 4.1

#####################
## Miary globalne


div_glob<-function(ww)
{

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

div_np<-function(x)
{
# x - macierz oracle labels dla M modeli i N obserwacji
kol<-ncol(x) # liczba modeli skladowych M
wie<-nrow(x) # liczba obserwacji N
t<-matrix(0,nrow=wie,ncol=kol)
for (i in 1:kol) t[,i]<-x[,i]

sblad<-numeric(length=wie)
spop<-numeric(length=wie)
for (i in 1:wie) {spop[i]<-sum(t[i,]); sblad[i]<-kol-spop[i]}
# sblad - liczba blednych klasyfikacji dla obiektu "i"
# spop - liczba poprawnych klasyfikacji dla obiektu "i"

# wariancja Kohavi i Woplert 
kw<-0
for (i in 1:wie) kw<-kw+(spop[i]*sblad[i])
ia<-kw
kw<-kw/(wie*kol*kol)

#entropia Kuncheva
ent<-0
for (i in 1:wie) ent<-ent+min(spop[i],sblad[i])
ent<-(2*ent)/(wie*(kol-1))

# Log-entropia Cunningham i Carney
logp<-numeric(length=wie)
logb<-logp
for (i in 1:wie) 
{
logp[i]<-ifelse(spop[i]==0,0,(spop[i]/kol)*log(spop[i]/kol))
logb[i]<-ifelse(sblad[i]==0,0,(sblad[i]/kol)*log(sblad[i]/kol))
}
ecc<-sum(logp)+sum(logb)
ecc<--ecc/wie

# Miara zgodnosci - Interrater agreement Fleiss
srblad<-numeric(length=kol)
for (j in 1:kol) srblad[j]<-sum(t[,j])/wie
srb<-sum(srblad)/kol
ia<-1-(ia)/(wie*kol*(kol-1)*srb*(1-srb))

pred<-numeric(length=wie)
for (j in 1:wie) pred[j]<-mvote(x[j,])
amb<-numeric(length=wie)
for (j in 1:wie)
amb[j]<-mean(as.numeric(x[j,]==pred[j]))
ambi<-mean(amb)

# Measure of difficulty Hansen i Saamon (miara trudności)
mp<-numeric(length=kol+1) #poprawna klasyfikacja
xw<-numeric(length=kol+1)
for (i in 1:(kol+1)) 
{
xw[i]<-(i-1)/kol
for (j in 1:wie) mp[i]<-mp[i]+as.numeric(spop[j]==(i-1))
}
pp<-mp/wie # czestosci wzgledne
sr<-sum(xw*pp)/sum(pp)
di<-sum(((xw-sr)^2)*pp)/sum(pp)

# 2 miary Krzanowski i Partridge
mb<-numeric(length=kol+1)
# mb - wektor liczebnosci dla rozkladu liczby blednych klasyfikacji
for (i in 1:(kol+1)) 
{
for (j in 1:wie) mb[i]<-mb[i]+as.numeric(sblad[j]==(i-1))
}
pb<-mb/wie
p0<-pb[1]

p1<-0
for (i in 2:(kol+1)) p1<-p1+((i-1)*pb[i])/kol
p2<-0
for (i in 2:(kol+1)) p2<-p2+(((i-1)*(i-2)*pb[i])/(kol*(kol-1)))
gd<-1-p2/p1

cc<-0
for (i in 2:(kol+1)) cc<-cc+((kol-(i-1))*pb[i])/(kol-1)
cc<-cc/(1-p0)
cfd<-ifelse(p0==1,0,cc)

# tm - wyjscie
tm<-matrix(0,nrow=8,ncol=1)

tm[1]<-kw   	# Kohavi-Wolpert
tm[2]<-ent	# Entropia
tm[3]<-ecc	# Entropia CC
tm[4]<-ia	# IntAgreement
tm[5]<-ambi	# Ambiguity
tm[6]<-di	# Measure of Diff
tm[7]<-gd	# GD
tm[8]<-cfd	# CFD
return(tm)
}

wo<-matrix(0,nrow=10,ncol=3)

tw<-matrix(nrow=77,ncol=8)
colnames(tw)<-c("K-W","Ent","E CC","Kappa","Amb","Theta","GD","CFD")

for (i in 1:77)
{
wo<-ww[,,i]
# dla jednej warstwy macierzy (jeden uklad klasyfikacji)
tw[i,]<-div_np(wo)
}
tw
}


tab77<-div_glob(roz)
mr<-tab77
cor(mr)
blad<-liczb(rr,bl=T)
razem<-cbind(blad,mr)
cor(razem)

plot(razem[,3],razem[,1],ylab="Błąd modelu zagregowanego",xlab="Wartości miary",main="Entropia",pch=16)

text(0.4,0.1,"Model nr 39",pos=2)
text(0.4,0.6,"Model nr 45",pos=2)

arrows(0.4,0.1,razem[39,3],razem[39,1],length = 0.15, angle = 20, code = 2)
arrows(0.4,0.6,razem[45,3],razem[45,1],length = 0.15, angle = 20, code = 2)