Question

The following code tries to build a simple binary tree. A non-leaf node contains a left child 'Lchild' and a right child 'Rchild'. A leaf node contains nothing. Nodes are generated one by one, first for the left branch then the right. Nodes are numbered by the time they were generated. Node information including its Lchild and Rchild and are added to BiTree to grow the tree. The question is, how can I achieve the goal avoiding defining 'BiTree' and 'i' as global? Since it will cause some

## rm(list=ls()) ## ANTI-SOCIAL
set.seed(1234)

##this part generate dataset
numVar <- 40  ##number of variables
numSamples <- 400  ##number of samples
Class <- sample(c(0,1), replace = 1, numSamples)  ##categorical outcome as '0' or '1'
predictor <- matrix( sample(c(-1,0,1), replace=1, numSamples*numVar), ncol=numVar)
data <- data.frame(predictor, Class)

##BiTree is a list storing a nodes information, reprenting a tree, defined as global
BiTree <- array( list(NULL), dim = 15 )

##set i as global variable to store the ID of each node on the tree, defiend as global
i <- 1

##function to create a tree
##parameter 'root' is the ID of root node for each sub-tree
createTree <- function( data, root )
{


   force( root ) ##without this the result will be wrong

   ##stop grow the sub-tree if data size is smaller than 10
   if( (nrow(data) <= 10 ) )  { i <<- i + 1; return(); }

   ##seperate the data into two parts to grow left-sub-tree and right-sub-tree
   index.P1 <- 1:floor( nrow( data )/2 )
   index.P2 <- !index.P1
   data.P1 <- data[ index.P1,  ]
   data.P2 <- data[ index.P2,  ]

   ##NOTE HERE: result will differ with or without execute any of the following call of root


   ##i records the ID of node in the tree. it increments after one new node is added to     the tree
   i <<- i + 1

   ##record node ID for left child of the root
   BiTree[[ root ]]$Lchild <<- i

   ##create left branch
   createTree( data.P1, i )

   ##record node ID for right child of the root
   BiTree[[ root ]]$Rchild <<- i

   ##create right branch
   createTree( data.P2, i )
}

createTree( data, 1 )
Était-ce utile?

La solution

If it is just a programming exercise and you wish to use pure R, the only other way is by using environments. No other R objects are passed by "reference", i.e. changes made to args are "visible" after a function call.

Here is a very primitive implementation of a BST on environments, that mimics the usage of dynamically allocated memory and pointers. I do not recommend using it in practice. This solution is just for fun.

If you need an access to a "ordered set" container, you should rather use STL's set in an RCpp program.

A "School" implementation of a BST

  # assumption: elements can be compared with < and ==

  # Each node will be represented by a list with 3 elements
  # (object, left, right)
  # instead of pointer we will use strings

  # note that the maximal number of nodes
  # that can be created is restricted

  # create a new empty tree
  bst_new <- function() {
     e <- new.env()
     e$root <- NULL
     e$last <- 0L # this will emulate a "heap"
     class(e) <- 'bst'
     e
  }


  # insert an element
  # duplicates are ignored
  bst_insert <- function(bst, val) {
     stopifnot(is.environment(bst), class(bst) == 'bst')

     if (is.null(bst$root)) {
        bst$root <- as.character(bst$last)
        bst$last <- bst$last + 1L
        assign(bst$root, list(val, NULL, NULL), bst)
     }
     else {
        cur_id <- bst$root
        repeat {
           cur_node <- get(cur_id, bst)
           if (val == cur_node[[1]])
              return(invisible(NULL)) # ignore
           else if (val < cur_node[[1]]) {
              if (is.null(cur_node[[2]])) {
                 cur_node[[2]] <- as.character(bst$last)
                 assign(cur_id, cur_node, bst)
                 bst$last <- bst$last + 1L
                 assign(cur_node[[2]], list(val, NULL, NULL), bst)
                 return(invisible(NULL))
              }
              else {
                 cur_id <- cur_node[[2]]
              }
           }
           else {
              if (is.null(cur_node[[3]])) {
                 cur_node[[3]] <- as.character(bst$last)
                 assign(cur_id, cur_node, bst)
                 bst$last <- bst$last + 1L
                 assign(cur_node[[3]], list(val, NULL, NULL), bst)
                 return(invisible(NULL))
              }
              else {
                 cur_id <- cur_node[[3]]
              }
           }
        }
     }
  }

  # print all elems, in order
  bst_print <- function(bst) # or print.bst
  {
     stopifnot(is.environment(bst), class(bst) == 'bst')

     bst_print_tmp <- function(bst, id_node) {
        if (is.null(id_node)) return(invisible(NULL))

        cur_node <- get(as.character(id_node), envir=bst)
        bst_print_tmp(bst, cur_node[[2]]) # left
        print(cur_node[[1]]) # this
        bst_print_tmp(bst, cur_node[[3]]) # right
     }

     bst_print_tmp(bst, bst$root)
     invisible(NULL)
  }


  tree <- bst_new()
  bst_insert(tree, 3)
  bst_insert(tree, 5)
  bst_insert(tree, 1)
  bst_insert(tree, 2)
  bst_insert(tree, 8)
  bst_insert(tree, 7)
  bst_print(tree)

## [1] 1
## [1] 2
## [1] 3
## [1] 5
## [1] 7
## [1] 8
Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top