R/tree.R

#' @export
Tree <- R6::R6Class(
  "Tree", 
  private = list(
    .root_node = NULL,
    .transform_data = data.frame()
  ),
  public = list(
    initialize = function(root_node, transform_data=NULL) { 
      private$.root_node <- root_node
      if(!is.null(transform_data)) {
        private$.transfrom_data <- transform_data
      }
    },
    get_root_node = function() {
      private$.root_node
    },
    get_leaves = function() {
      self$get_root_node()$get_leaves()
    },
    normalize = function() {
      self$get_root_node()$normalize()
    },
    get_transform_data = function() {
      self$get_root_node()$get_transform_data()
    },
    get_edge_df = function() {
      self$get_root_node()$get_edge_df()
    },
    #     render = function() {
    #       edges <- self$get_edge_df()
    #       edges_df <- DiagrammeR::create_edges(from = edges$from,
    #                                            to = edges$to)
    #       graph <- DiagrammeR::create_graph(edges_df = edges_df)
    #       DiagrammeR::render_graph(graph)
    #     },
    render = function(trans_label, width=NULL, height=NULL) {
      edges <- self$get_edge_df()
      nodes <- unique(unlist(lapply(as.list(edges), as.character)))
      if(missing(trans_label)) {
        trans_label <- nodes
        names(trans_label) <- nodes
      }
      nodes_df <- DiagrammeR::create_nodes(
        nodes = nodes,
        label = trans_label[nodes]
      )
      edges_df <- DiagrammeR::create_edges(from = edges$from,
                                           to = edges$to)
      graph <- DiagrammeR::create_graph(
        nodes_df = nodes_df,
        edges_df = edges_df,
        graph_attrs = "rankdir = LR")
      DiagrammeR::render_graph(graph, width=width, height=height)
    },
    merge_nodes = function(values, labels) {
      print(length(self$get_leaves()))
      target_nodes <- self$get_target_nodes()
      labels <- transform_labels(labels, self$get_transform_data())
      for(target_node in target_nodes) {
        children <- target_node$get_children()
        names <- sapply(children, function(node) node$get_label())
        names(children) <- names
        value_list <- Map(function(node) {
          values[labels == node$get_label()]
        }, children)
        
        which_can_merge <- which_can_merge(value_list)
        if(!is.null(which_can_merge)) {
          target_node$merge_children(which_can_merge)
        }
      }
    },
    get_target_nodes = function() {
      self$get_root_node()$get_target_nodes()
    },
    mergetree = function(values, labels) {
      is_finished <- FALSE
      while(!is_finished) {
        leaves <- self$get_leaves()
        self$normalize()
        self$merge_nodes(values, labels)
        is_finished <- identical(leaves, self$get_leaves())
      }
    }
  )
)
hoxo-m/mergetree documentation built on May 16, 2017, 12:56 a.m.