R/print.R

In natydasilva/PPtreeExt: Projection Pursuit Classification Tree extensions

#' Print PPtreeclassMOD object
#' 
#' @param x something
#' @param coef.print something
#' @param cutoff.print something
#' @param verbose something
#' @param ... something
#' @export
#' 
print.PPtreeclassMOD <- function(x,coef.print  = FALSE, cutoff.print=FALSE,
                               verbose = TRUE,...){
  PPtreeOBJ <- x
  TS <- PPtreeOBJ$Tree.Struct
  Alpha <- PPtreeOBJ$projbest.node
  cut.off <- PPtreeOBJ$splitCutoff.node
  gName <- names(table(PPtreeOBJ$origclass))
  pastemake <- function(k,arg,sep.arg=""){
    temp <- ""
    for(i in 1:k)
      temp <- paste(temp, arg, sep = sep.arg)
    return(temp)
  }
  TreePrint <- "1) root"
  i <- 1  
  flag.L <- rep(FALSE,nrow(TS))
  keep.track <- 1
  depth.track <- 0
  depth<-0
  while(sum(flag.L)!=nrow(TS)){
    if(!flag.L[i]){                    
      if(TS[i,2] == 0) {
        flag.L[i] <-TRUE
        n.temp <-length(TreePrint)
        tempp <-strsplit(TreePrint[n.temp],") ")[[1]]
        temp.L <-paste(tempp[1],")*",tempp[2],sep="")
        temp.L <- paste(temp.L,"  ->  ","\"",gName[TS[i,3]],"\"",sep="")
        TreePrint <- TreePrint[-n.temp]
        id.l <-length(keep.track)-1
        i <- keep.track[id.l]
        depth <-depth -1
      } else if(!flag.L[TS[i,2]]){
        depth <- depth+1
        emptyspace <- pastemake(depth, "   ")
        temp.L <- paste(emptyspace, TS[i,2], ")  proj",
                      TS[i,4],"*X < cut",TS[i,4], sep = "")
        i <- TS[TS[i,2],1]   
      } else{
        depth <- depth +1
        emptyspace <- pastemake(depth,"   ")          
        temp.L <- paste(emptyspace,TS[i,3],")  proj",
                       TS[i,4],"*X >= cut",TS[i,4],sep="")
        flag.L[i] <- TRUE
        i <- TS[TS[i,3],1]
      } 
      keep.track <- c(keep.track,i)
      depth.track <- c(depth.track,depth)
      TreePrint <-c(TreePrint,temp.L)
    } else{
      id.l<-id.l-1
      i<-keep.track[id.l]
      depth<-depth.track[id.l]
    }
  }
  colnames(Alpha)<-colnames(PPtreeOBJ$origdata)
  rownames(Alpha)<-paste("proj",1:nrow(Alpha),sep="")  
  # colnames(cut.off)<-paste("Rule",1:ncol(cut.off),sep="")
  # rownames(cut.off)<-paste("cut",1:nrow(cut.off),sep="")
  TreePrint.output<-
    paste("=============================================================",                          
          "\nProjection Pursuit Classification Tree result",                           
          "\n=============================================================\n")
  for(i in 1:length(TreePrint))
    TreePrint.output<-paste(TreePrint.output,TreePrint[i],sep="\n")
  TreePrint.output<-paste(TreePrint.output,"\n",sep="")
  sample.data.X<-PPtreeOBJ$origdata
  sample.data.class<-PPtreeOBJ$origclass
  error.rate<- PPtreeViz::PPclassify(PPtreeOBJ,sample.data.X)$predict.error
  colnames(Alpha)<-paste(1:ncol(Alpha),":\"",colnames(Alpha),"\"",sep="")
  if(verbose){
    cat(TreePrint.output)
    if(coef.print){
      cat("\nProjection Coefficient in each node",
          "\n-------------------------------------------------------------\n")
      print(round(Alpha,4))
    }
    if(cutoff.print){
      cat("\nCutoff values of each node",
          "\n-------------------------------------------------------------\n")
      print(round(cut.off,4))
    }    
    cat("\nError rates of various cutoff values",
        "\n-------------------------------------------------------------\n")
    print(round(error.rate,4))
  }    
  return(invisible(TreePrint)) 
}