# przyklad 3.3
# zbiór VEHICLE

# load("veh 1000 .dat")
# zbiór wyników predykcji 1000 modeli bazowych

lobs<-20
lmod<-10

y<-veh.test.y[1:lobs]

tt<-table(veh.test.y)
lklas<-length(tt)
t.klas<-names(tt)

y.pred<-vector(length=lobs)

p.y<-numeric(length=lobs)
p.y.pred<-p.y
klasy<-numeric(length=lklas)
r.klas<-numeric(length=lklas) # rozklad klas dla obserwacji
p.klas<-r.klas

blad<-numeric(length=lobs)
war<-blad
obc<-blad
nieobc<-blad

d<-veh.test.c[1:lobs,1:lmod]

for (i in 1:lobs) y.pred[i]<-mvote0(d[i,])

y.opt<-y ### brak szumu ####
##################
for (i in 1:lobs) 
{
p.y[i]<-sum(d[i,]==y[i])/lmod
p.y.pred[i]<-sum(d[i,]==y.pred[i])/lmod
}

for (i in 1:lobs) 
{
for (j in 1:lklas) klasy[j]<-sum(as.numeric(d[i,]==t.klas[j]))
p.klas<-klasy/lmod # prawdop przynal. do klasy wyn. pred. modeli bazowych
for (j in 1:lklas) r.klas[j]<-as.numeric(y[i]==t.klas[j])
##################
## ogolnie
##################
# blad dla pojedynczej obserwacji
blad[i]<-1-p.y[i]
#obciazenie obserwacji
obc[i]<-as.numeric(y.opt[i]!=y.pred[i])  
# brak obciazenia
nieobc[i]<-as.numeric(y.opt[i]==y.pred[i])
# wariancja dla pojedynczej obserwacji
war[i]<-1-p.y.pred[i]
}

blad.o<-mean(blad)
obc.o<-mean(obc)
war.o<-mean(war)

########################
## DEKOMPOZYCJE DLA POJEDYNCZYCH OBSERWACJI
###################

###################
## Kong i Dietterich
# blad dla pojedynczej obserwacji
for (i in 1:lobs) 
{
blad[i]<-1-p.y[i]
#obciazenie obserwacji
obc[i]<-as.numeric(y[i]!=y.pred[i])  
# brak obciazenia
nieobc[i]<-as.numeric(y[i]==y.pred[i])
# wariancja dla pojedynczej obserwacji
war[i]<-blad[i]-obc[i]
}
blad.kd<-mean(blad)
obc.kd<-mean(obc)
war.kd<-mean(war)

###################
## Tibshirani
# blad dla pojedynczej obserwacji

for (i in 1:lobs) 
{
blad[i]<-1-p.y[i]
#obciazenie obserwacji (brak szumu)
obc[i]<-(1-p.y.pred[i])
# wariancja (efekt agregacji) dla pojedynczej obserwacji
war[i]<-blad[i]-obc[i]
}
blad.t<-mean(blad)
obc.t<-mean(obc)
war.t<-mean(war)

###################
## Kohavi i Wolpert
# blad dla pojedynczej obserwacji
for (i in 1:lobs) 
{
for (j in 1:lklas)klasy[j]<-sum(as.numeric(d[i,]==j))
p.klas<-klasy/lmod  # prawdop przynal. do klasy wyn. pred. modeli bazowych
for (j in 1:lklas)r.klas[j]<-as.numeric(y[i]==j)
blad[i]<-1-p.y[i]
#obciazenie obserwacji (brak szumu)
obc[i]<-0.5*(sum((r.klas-p.klas)^2))
# wariancja (efekt agregacji) dla pojedynczej obserwacji
war[i]<-0.5*(1-sum(p.klas^2))
}
blad.kw<-mean(blad)
obc.kw<-mean(obc)
war.kw<-mean(war)


########################
## DEKOMPOZYCJE DLA CALEGO ZBIORU
###################
## Breiman
y.d.zgod<-matrix(ncol=lmod,nrow=lobs) # tabela 0-1 zgodnosci z y emp lub opt
e.p.y<-numeric(length=lobs) # srednie prawd. zgodnoci z y dla obserwacji
for (m in 1:lmod) y.d.zgod[,m]<-as.numeric(y==d[,m])
# obciazenie
for (i in 1:lobs) 
{
obs.obc<-as.numeric(y[i]!=y.pred[i])  # 1 dla obs obciazonej
e.p.y[i]<-obs.obc*(1-sum(y.d.zgod[i,])/lmod)
}
obc.b<-mean(e.p.y)
# wariancja
for (i in 1:lobs) 
{
obs.nieobc<-as.numeric(y[i]==y.pred[i])  # 1 dla obs nieobciazonej
e.p.y[i]<-obs.nieobc*(1-sum(y.d.zgod[i,])/lmod)
}
war.b<-mean(e.p.y)
###################
## Domingos
# obciazenie
obc.d<-mean(as.numeric(y!=y.pred))
# wariancja
for (i in 1:lobs) 
{
obs.obc<-as.numeric(y[i]!=y.pred[i])  # 1 dla obs obciazonej
e.p.y[i]<-obs.obc*(sum(p.y[i]))
}
v.b<-mean(e.p.y)
for (i in 1:lobs) 
{
obs.nieobc<-as.numeric(y[i]==y.pred[i])  # 1 dla obs nieobciazonej
e.p.y[i]<-obs.nieobc*(sum(1-p.y.pred[i]))
}
v.u<-mean(e.p.y)
war.d<-v.u-v.b