r - How to avoid using global variables in this case -
the following code tries build simple binary tree. non-leaf node contains left child 'lchild' , right child 'rchild'. leaf node contains nothing. nodes generated 1 one, first left branch right. nodes numbered time generated. node information including lchild , rchild , added bitree grow tree. question is, how can achieve goal avoiding defining 'bitree' , 'i' global? since cause
## 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 '0' or '1' predictor <- matrix( sample(c(-1,0,1), replace=1, numsamples*numvar), ncol=numvar) data <- data.frame(predictor, class) ##bitree list storing nodes information, reprenting tree, defined global bitree <- array( list(null), dim = 15 ) ##set global variable store id of each node on tree, defiend global <- 1 ##function create tree ##parameter 'root' id of root node each sub-tree createtree <- function( data, root ) { force( root ) ##without result wrong ##stop grow sub-tree if data size smaller 10 if( (nrow(data) <= 10 ) ) { <<- + 1; return(); } ##seperate data 2 parts grow left-sub-tree , 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 differ or without execute of following call of root ##i records id of node in tree. increments after 1 new node added tree <<- + 1 ##record node id left child of root bitree[[ root ]]$lchild <<- ##create left branch createtree( data.p1, ) ##record node id right child of root bitree[[ root ]]$rchild <<- ##create right branch createtree( data.p2, ) } createtree( data, 1 )
if programming exercise , wish use pure r, other way using environments. no other r objects passed "reference", i.e. changes made args "visible" after function call.
here primitive implementation of bst on environments, mimics usage of dynamically allocated memory , pointers. not recommend using in practice. solution fun.
if need access "ordered set" container, should rather use stl's set in rcpp program.
a "school" implementation of bst
# assumption: elements can compared < , == # each node represented list 3 elements # (object, left, right) # instead of pointer use strings # note maximal number of nodes # can created restricted # create new empty tree bst_new <- function() { e <- new.env() e$root <- null e$last <- 0l # emulate "heap" class(e) <- 'bst' e } # insert element # duplicates 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 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]]) # 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
Comments
Post a Comment