R/node.R

#' @export
Node <- R6::R6Class(
  "Node", 
  private = list(
    .label = NULL,
    .children = NULL,
    .merged = NULL
  ),
  public = list(
    initialize = function(label) { 
      self$set_label(label)
    },
    set_label = function(label) {
      private$.label <- label
    },
    get_label = function(label) {
      private$.label
    },
    add_child = function(node) { 
      private$.children <- c(private$.children, list(node))
    },
    merge = function(node) {
      m <- node$get_merged()
      if(length(m) > 0) {
        private$.merged <- c(private$.merged, m)
      } else {
        private$.merged <- c(private$.merged, node$get_label())
      }
    },
    get_children = function() {
      private$.children
    },
    get_leaves = function() {
      if(length(private$.children) == 0) {
        self$get_label()
      } else {
        child_nodes <- self$get_children()
        unlist(Map(function(node) { node$get_leaves() }, child_nodes))
      }
    },
    get_merged = function() {
      private$.merged
    },
    clear_children = function() {
      private$.children <- NULL
    },
    get_transform_data = function() {
      merged <- self$get_merged()
      trans_df <- data.frame()
      if(!is.null(merged)) {
        trans_df <- data.frame(before=merged, after=self$get_label(), stringsAsFactors = FALSE)
      }
      children <- self$get_children()
      for(child in children) {
        trans_df <- rbind(trans_df, child$get_transform_data())
      }
      trans_df
    },
    normalize = function() {
      children <- self$get_children()
      if(length(children) == 0) return
      
      if(length(children) == 1) {
        the_child <- children[[1]]
        self$merge(the_child)
        children <- the_child$get_children()
      }
      self$clear_children()
      for(child in children) {
        child$normalize()
        self$add_child(child)
      }
    },
    get_edge_df = function() {
      children <- self$get_children()
      if(length(children) == 0) return(NULL)
      child_labels <- sapply(children, function(node) node$get_label())
      edge_df <- data.frame(from = self$get_label(), to=child_labels, stringsAsFactors = FALSE)
      for(child in children) {
        edge_df <- rbind(edge_df, child$get_edge_df())
      }
      edge_df
    },
    get_target_nodes = function() {
      children <- self$get_children()
      if(length(children) == 0) return(NULL)
      if(self$is_target_node()) return(self)

      result <- list()
      for(child in children) {
        result <- c(result, child$get_target_nodes())
      }
      result
    },
    is_target_node = function() {
      children <- self$get_children()
      if(length(children) == 0) return(FALSE)
      all(sapply(children, function(node) length(node$get_children()) == 0))
    },
#     merge_children = function(which_can_merge) {
#       leave_node_label <- which_can_merge[1]
#       delete_node_label <- which_can_merge[2]
#       children <- self$get_children()
#       leave_node <- Find(function(node) node$get_label() == leave_node_label, children)
#       delete_node <- Find(function(node) node$get_label() == delete_node_label, children)
#       
#       self$delete_child(delete_node)
#       leave_node$merge(delete_node)
#     },
    merge_children = function(which_can_merge) {
      new_node <- Node$new(paste(which_can_merge, collapse = " & "))
      children <- self$get_children()
      for(label in which_can_merge) {
        node <- Find(function(x) x$get_label() == label, children)
        new_node$merge(node)
        self$delete_child(node)
      }
      self$add_child(new_node)
    },
    delete_child = function(child) {
      private$.children <- Filter(function(node) !identical(node, child), self$get_children())
    }
  )
)
hoxo-m/mergetree documentation built on May 16, 2017, 12:56 a.m.