R/count.surrogates.R

In StephanSeifert/SurrogateMinimalDepth: Surrogate minimal depth variable importance

#'Count surrogate variables
#'
#'This function counts surrogate variables and returns the total average number of surrogate variables and the average number of surrogate variables of the respective layers.
#'This is necessary since the actual number of surrogate splits can be lower than the predefined number (when less surrogate splits outperform the majority rule).
#'
#'@param trees list of trees that was generated by getTreeranger function and layers, surrogate variables, and adjusted agreement values were added by addLayer and getSurrogates functions
#' @return List with the following components:
#' \itemize{
#' \item s.a: total average number of surrogate variables
#' \item s.l: average number of surrogate variables in the respective layers
#' }
#' @export
count.surrogates=function(trees){
  ntree=length(trees)
  surrogates.trees=lapply(1:ntree,scount,trees)

  s.a=mean(sapply(surrogates.trees,"[[","s.a"))
  s.l.list=lapply(surrogates.trees,"[[","s.l")
  s.l.all <- matrix(NA, nrow = 1000, ncol = ntree)
  for (u in 1:ntree){
   s.l.tree=s.l.list[[u]][,2]
   s.l.all[1:length(s.l.tree),u]=s.l.tree
  }
  s.l=rowMeans(s.l.all,na.rm = TRUE)
  names(s.l)=c(0:999)

  return(list(s.a=s.a,s.l=s.l))
}

#' scount
#'
#' This is an internal function
#'
#' @keywords internal
scount=function(i=1,trees){
  tree=trees[[i]]
  nonterminal.nodes=tree[which(sapply(tree,"[[","status")==1)]
  s.a=(mean(sapply((lapply(nonterminal.nodes,"[",-c(1:7))),length)))/2
  maxlayer=unlist(nonterminal.nodes[length(nonterminal.nodes)])["layer"]
  s.l=matrix(NA,maxlayer+1,2)
  colnames(s.l)=c("layer","No. Surrogates")
  s.l[,1]=0:maxlayer
  for (u in 0:maxlayer){
  nodes.at.layer=nonterminal.nodes[which(sapply(nonterminal.nodes,"[[","layer")==u)]
  surr=lapply(nodes.at.layer,"[",-c(1:7))
  s.u=(mean(sapply(surr,length)))/2
  s.l[u+1,2]=s.u
  }
  return(list(s.a=s.a,s.l=s.l))
}