
###################################################
#Q_i^k computing

qik=function(xx,cl,k){
#xx is the matrix of proximities
#cl is the class of the cases
#k is the number of neighbors

 dxx=1-xx
  diag(dxx)=2 #for not be chosing as neighgbor of itself

   ww=apply(dxx,2,rank,ties.method="random") #columnnas

  nei=matrix(0,nrow=dim(xx)[1], ncol=k)
  for (i in 1:k){
  for (j in 1: dim(xx)[1]){
  nei[j,i]= which(ww[,j] == (i+1)) 
  }}
 
 situa=c()
 
 for(i in 1:dim(xx)[1]){
 #si coincide etiqueta  con la de su clase 1, si no 0
 et=cl[i]
 coi=cl[nei[i,]]==et
  situa[i]=sum(xx[i,nei[i,]]*coi)/sum(xx[i,nei[i,]])

 }
 return(situa)

}
###################################################

###################################################
#TM_i^k computing

tmik=function(xx,cl,k){
#xx is the matrix of proximities
#cl is the class of the cases
#k is the number of neighbors

 dxx=1-xx
  diag(dxx)=2 #for not be chosing as neighgbor of itself

   ww=apply(dxx,2,rank,ties.method="random") #columnnas

  nei=matrix(0,nrow=dim(xx)[1], ncol=k)
  for (i in 1:k){
  for (j in 1: dim(xx)[1]){
  nei[j,i]= which(ww[,j] == (i+1)) 
  }}
 
 wsitua=c()
 
 for(i in 1:dim(xx)[1]){
 #si coincide etiqueta  con la de su clase 1, si no 0
 et=cl[i]
 coi=cl[nei[i,]]==et
  wsitua[i]=sum(xx[i,nei[i,]]*coi)

 }

ma=c()
nacl=unique(cl) #clases
ncl=length(nacl)#number of classes
for(i in 1:ncl){
ma[i]=max(wsitua[cl==nacl[i]])
}



situall=c()

 for(i in 1:dim(xx)[1]){
 ci=cl[i]
 wci=which(nacl==ci)
 mai=ma[wci]
  situall[i]=wsitua[i]/mai
   }
return(situall)

}
###################################################


###################################################
#return which variables used in prediction in tree with library party
prevtreeparty<-function(x,da1){

wv=c()

names(x) <- c("nodeID", "weights", "criterion", "terminal",
                  "psplit", "ssplits", "prediction", "left", "right")
                  

decision=x$terminal

while(decision==FALSE){

wv=c(wv,as.numeric(x$psplit[1]))
if(da1[,as.numeric(x$psplit[1])]<=x$psplit[3]){
x=x$left
} else{
x=x$right
}
names(x) <- c("nodeID", "weights", "criterion", "terminal",
                  "psplit", "ssplits", "prediction", "left", "right")
decision=x$terminal
}
return(wv)
}

#wv=prevtreeparty(x,da1)
#names(da1[wv])
###################################################

###################################################
#return which variables used in prediction with library RandomForest
prevtree<-function(ar,da1){

wv=c()
wrow=1
decision=ar[1,5]

while(decision==1){

wv=c(wv,ar[wrow,3])
if(da1[ar[wrow,3]]<ar[wrow,4]){
wrow=ar[wrow,1]
} else{
wrow=ar[wrow,2]
}
decision=ar[wrow,5]
}
return(wv)
}

###################################################


###################################################
#IPM casewise with RF by party for OOB samples
ipmparty=function(marbol,da,ntree){
#marbol: randomforest obtained by party
#da: data frame with the predictors only, not responses
#ntree: number of trees in the random forest


#percentage of use per tree (if 2 times of a total of 2 splits is more than 2 times of a total of three)
dime=dim(da)
pup=matrix(0,nrow=dime[1],ncol=dime[2]) 

w=marbol@where

mi=matrix(0,ncol=ntree,nrow=dim(da)[1])

for(i in 1:ntree){
mi[which( w[[i]]!=0),i]=1 # 0 es cuando está out-of-bag
}

totob=ntree-rowSums(mi) #number of times out-of-bag

for (i in 1:ntree){

ar=marbol@ensemble[[i]]

#mirar que individuos out-of-bag
ib=mi[,i] #in bag
#out-of-bag
ob=which(ib==0)

#mirar que variables usan en ese arbol para predecir
for(j in 1:length(ob)){
da1=da[ob[j],]
wv=prevtreeparty(ar,da1)
pupi=table(wv)/length(wv)
dond= unique(sort(wv))

pup[ob[j],dond]=pup[ob[j],dond]+ as.numeric(pupi)
}
}

pupf=pup
for(h in 1:dime[1]){
pupf[h,]=pup[h,]/totob[h]
}


dimnames(pupf)=dimnames(da)

return(pupf)

}

###################################################



###################################################
###################################################
#IPM casewise with RF by party for new samples, not in the learning set
ipmpartynew=function(marbol,da,ntree){
#marbol: randomforest obtained by party
#da: data frame with the predictors only, not responses
#ntree: number of trees in the random forest

da=as.data.frame(da)

#percentage of use per tree (if 2 times of a total of 2 splits is more than 2 times of a total of three)
dime=dim(da)
if(is.null(dime)){pup=matrix(0,nrow=1,ncol=length(da))
da=t(as.matrix(da))
dime=dim(da)
}else{
pup=matrix(0,nrow=dime[1],ncol=dime[2])} 


#w=marbol@get_where(newdata = as.data.frame(da))


#if(is.null(dime)){mi=matrix(0,ncol=ntree,nrow=1)
#}else{
#mi=matrix(0,ncol=ntree,nrow=dim(da)[1])}

#for(i in 1:ntree){
#mi[which( w[[i]]!=0),i]=1 # 0 es cuando está out-of-bag
#}

#totob=ntree-rowSums(mi) #number of times out-of-bag
totob=ntree

for (i in 1:ntree){

ar=marbol@ensemble[[i]]


ob=dim(da)[1]

#mirar que variables usan en ese arbol para predecir
for(j in 1:ob){
da1=as.matrix(da[j,],nrow=1,ncol=dim(da)[2])
wv=prevtreeparty(ar,da1)
pupi=table(wv)/length(wv)
dond= unique(sort(wv))

pup[j,dond]=pup[j,dond]+ as.numeric(pupi)
}
}


pupf=pup/totob



dimnames(pupf)=dimnames(da)

return(pupf)

}


###################################################



###################################################
###################################################
#IPM casewise with RF by Randomforest library for OOB samples
ipmrf=function(marbolr,da,ntree){
#marbolr: randomforest obtained by Randomforest library
#da: data frame with the predictors only, not responses
#ntree: number of trees in the random forest

mi=marbolr$inbag


#in version of randomForest 4.6.12: The "inbag" component of the randomForest object now records the number of 
 # times an observation is included in the bootstrap sample, instead of just indicating whether it is included or not
 
 mi[mi>1]=1


#percentage of use per tree (if 2 times of a total of 2 splits is more than 2 times of a total of three)
dime=dim(da)
pup=matrix(0,nrow=dime[1],ncol=dime[2]) 


#considering only use without taking into account if one, two or more times: no es lo mismo usarlo solo una vez 


totob=ntree-rowSums(mi) #number of times out-of-bag

for (i in 1:ntree){
ar=getTree(marbolr,k=i) #sin label

#mirar que individuos out-of-bag
ib=mi[,i] #in bag
#out-of-bag
ob=which(ib==0)

#mirar que variables usan en ese arbol para predecir
for(j in 1:length(ob)){
da1=da[ob[j],]
wv=prevtree(ar,da1)
pupi=table(wv)/length(wv)
dond= unique(sort(wv))

pup[ob[j],dond]=pup[ob[j],dond]+ as.numeric(pupi)
}
}

pupf=pup
for(h in 1:dime[1]){
pupf[h,]=pup[h,]/totob[h]
}



dimnames(pupf)=dimnames(da)

return(pupf)
}

###################################################



###################################################
#IPM casewise with RF by Randomforest library for new samples, not in the learning set
ipmrfnew=function(marbolr,da,ntree){
#marbolr: randomforest obtained by Randomforest library
#da: data frame with the predictors only, not responses
#ntree: number of trees in the random forest


da=as.data.frame(da)

#percentage of use per tree (if 2 times of a total of 2 splits is more than 2 times of a total of three)
dime=dim(da)
if(is.null(dime)){pup=matrix(0,nrow=1,ncol=length(da))
da=t(as.matrix(da))
dime=dim(da)
}else{
pup=matrix(0,nrow=dime[1],ncol=dime[2])} 



totob=ntree

for (i in 1:ntree){
ar=getTree(marbolr,k=i) #sin label

ob=dim(da)[1]

#mirar que variables usan en ese arbol para predecir
for(j in 1:ob){
da1=da[j,]
wv=prevtree(ar,da1)
pupi=table(wv)/length(wv)
dond= unique(sort(wv))

pup[j,dond]=pup[j,dond]+ as.numeric(pupi)
}
}

pupf=pup/totob



dimnames(pupf)=dimnames(da)

return(pupf)
}

###################################################




