remove.node {arvoRe}R Documentation

Usage

remove.node(TheTree, node.col, node.number)

Arguments

TheTree
node.col
node.number

Examples

##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--    or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function(TheTree, node.col, node.number) {
        removelines <- select.subtree(TheTree, node.col, node.number, change.row.names = FALSE)
        removelines <- rownames(removelines)
        
        num.lin <- dim(TheTree)[1]
        
        whoiwant <- as.numeric(setdiff(as.character(1:num.lin), removelines))
        
        ans <- TheTree[whoiwant,]
        
        ans <- as.data.frame(ans)
        
        ans$Level <- as.numeric(as.character(ans$Level))
        ans$Node.N <- as.numeric(as.character(ans$Node.N))
        ans$Node.name <- as.character(ans$Node.name)
        ans$Father <- as.numeric(as.character(ans$Father))
        ans$Father.Name <- as.character(ans$Father.Name)
        ans$Prob <- as.numeric(as.character(ans$Prob))
        ans$Type <- as.character(ans$Type)
        ans$Note <- as.character(ans$Note)
        ans$Destiny <- as.character(ans$Destiny)
        ans$Payoff1 <- as.numeric(as.character(ans$Payoff1))
        ans$Payoff2 <- as.numeric(as.character(ans$Payoff2))
        
        ans <- ans[ order(ans$Level,ans$Father, ans$Node.N),]
        
        position <- which(ans$Level == 2)
        
if( ( length(position) > 1 ) && ( dim(ans)[1] > 2 )) {
        #- Correção para o primeiro do nível ---------------------------------------------------------------
        .stopit <- FALSE
        i <- 1
        nans <- dim(ans)[1]
        while ( !.stopit ) {
                i <- i + 1
                GTtflag <-      ( as.numeric(ans$Node.N[i]) != 1 ) &&
                                        ( as.numeric(ans$Level[i]) > as.numeric(ans$Level[i-1]) )
                        if (GTtflag) {
                                old.value <- ans$Node.N[i]
                                ans$Node.N[i] <- 1
                                usedlevel <- ans$Level[i] + 1
                                position <- intersect(which(ans$Level == usedlevel),which(ans$Father == old.value))
                                if ( length(position) > 0) {
                                        ans$Father[position] <- ans$Node.N[i]
                                        ans$Father.Name[position] <- ans$Node.name[i]
                                }
                                ans <- ans[ order(ans$Level,ans$Father, ans$Node.N),]
                                i <- 1
                        } else {
                                if (i >= nans) .stopit <- TRUE
                        }
                }

        #- Correção para numeracao dos nodos -------------------------------------------------------------
        .stopit <- FALSE
        i <- 1
        nans <- dim(ans)[1]
        while ( !.stopit ) {
                i <- i + 1
                GTtflag <-      ( as.numeric(ans$Node.N[i]) > as.numeric(ans$Node.N[i-1])+1 ) &&
                                        ( as.numeric(ans$Level[i]) == as.numeric(ans$Level[i-1]) )
                        if (GTtflag) {
                                old.value <- ans$Node.N[i]
                                ans$Node.N[i] <- ans$Node.N[i-1] + 1
                                usedlevel <- ans$Level[i-1] + 1
                                position <- intersect(which(ans$Level == usedlevel),which(ans$Father == old.value))
                                if ( length(position) > 0) {
                                        ans$Father[position] <- old.value
                                        ans$Father.Name[position] <- ans$Node.name[i-1]
                                }
                                ans <- ans[ order(ans$Level,ans$Father, ans$Node.N),]
                                i <- 1
                        } else {
                                if (i >= nans) .stopit <- TRUE
                        }
                }
        #--------------------------------------------------------------------------------------------------
  }             
        rownames(ans) <- NULL
        return(ans)
  }

[Package arvoRe version 0.1.7 Index]