The R Project SVN R-packages

## it looks like <<- assignments here should actually be to env.

# Represent the tree as a flat collection of nodes
# but allocate the list ahead of time and grow it
# by doubling the space. This makes things a lot faster
# for large trees.

utils::globalVariables(c('e', 'idx', 'nodeNames', 'nodeSet', 'parentCount'))
## nothing here is exported.

if(FALSE){
xmlFlatListTree =
function(nodes = list(),
         parents = character(), children = list(),
         env = new.env(),
         n = 200)
{
    # To make things reasonably fast, we store the nodes in a pre-allocated list

  env = structure(env, class = c("XMLFlatListTree", "XMLFlatTree"))

  assign("nodeSet", vector("list", n), env)
  assign("idx", 1, env)
  assign("parentCount", 0, env)

  assign("nodeNames", character(n), env)
  assign("parents", character(n), env)


  #XXX Deal with this if parents is specified.

  # Assign the parents and children values and fill in any orphans, etc.
  # after calling addNode for the different nodes.

  if(!exists(".nodes", env))
    env$.nodes <- env #?

    # function to generate a new node identifier.  Can be given the
    # proposed name and will then make one up if that conflicts with another
    # identifier.
  f = function(suggestion = "") {
     if(suggestion == "" || suggestion %in% nodeNames)
        as.character(idx + 1)
     else
        suggestion
  }
  environment(f) = env

  assign( ".nodeIdGenerator", f, env)


  g = addParentNode
  environment(g) = env
  assign(".addParentNode", g, env)


  assign(".this", env, env)
  assign("n", n, env)


  addNode = function(node, parentId) {
    node = asXMLTreeNode(node, .this)
    id = node$id

       # Put it in the nodeSet by position.
    nodeSet[[ idx ]] <<- node
    nodeNames[idx] <<- id

    idx <<- idx + 1

    if(inherits(parentId, "XMLTreeNode"))
      parentId = parentId$id

    if(length(parentId)) {
      parentCount <<- parentCount + 1
      .parents[ parentCount ] <<- parentId
      names(.parents)[parentCount] <<- id

      .children [[ parentId ]] <<- c(.children[[ parentId ]], id )
    }
    if(idx == n) {
      n <<- 2*n
      length(nodeSet) <<- n
    }

    return(node)
  }
  environment(addNode)  = env
  env$.addNode <- addNode

  # Populate the tree with any initial nodes.
  # XXX putting these in .nodes and not nodeSet!
  ids = names(nodes)
  nodes = lapply(seq(along = nodes),
                  function(i) {
                         x = nodes[[ i ]]
                         if(!("id" %in% names(unclass(x))))
                            x$id = f( ifelse(ids[ i ] == "", xmlName(x), ids[i]) )

                         if(!inherits(x, "XMLTreeNode")) {
                ## no 'e' is visible here
                            x$env = e
                            class(x) = c("XMLTreeNode", class(x))
                         }
                         x
                       })

  names(nodes) = sapply(nodes, function(x) x$id)
  env$.nodes <- nodes

  env$.parents = parents
  env$.children = children

  .tidy =
     # to be run when adding to the tree is complete.
     # This shrinks the vectors to their actual size
     # rather than their preallocated sizes.
   function() {
      idx <- idx - 1
      length(nodeSet) <- idx
      length(nodeNames) <- idx
      names(nodeSet) <- nodeNames
      .nodes <<- nodeSet
      idx
   }
  .tidy
  environment(.tidy) <- env
  env$.tidy = .tidy

  env
}


xmlRoot.xmlFlatListTree =
function(x, skip = TRUE, ...)
{
  #XXX
   stop("not implemented")
}



# Represent the tree as a flat collection of nodes
# combined with

# See tests/tree.R

# Use an environment within the node so that we can lookup the children and parent information
#  directly from within

#
#  provide tools to set parent and children relationship.
#
#  Validate entries for parents and children to ensure nodes exist.
#
#  as(, "XMLTreeNode") function to make certain environment, id and class are present.
#
#  Suppose we are given an empty xmlTree() object when parsing an XML document.
# Then when we are converting the results back to R, we need to add nodes as we traverse the tree.
#  Need to make no
#   see convertNode() called in createXMLNode()
#  Given out an id within this tree for each node
#



xmlFlatTree =
  #
  # This version just concatenates each node to an existing list and so suffers
  # horrifically from garbage collection.
  # We leave it here in case it is useful either directly to someone for use on
  # small documents, or for performance comparisons with other approaches.
  #
function(nodes = list(), parents = character(), children = list(), env = new.env())
{
  # Assign the parents and children values and fill in any orphans, etc.
  # after calling addNode for the different nodes.

  if(!exists(".nodes", env))
    env$.nodes <- env

    # function to generate a new node identifier.  Can be given the
    # proposed name and will then make one up if that conflicts with another
    # identifier.
  f = function(suggestion = "") {
     if(suggestion == "" || suggestion %in% names(.nodes))
        as.character(length(.nodes) + 1)
     else
        suggestion
  }
  environment(f) = env

  assign( ".nodeIdGenerator", f, env)

  g = addParentNode
  environment(g) = env
  assign(".addParentNode", g, env)

  assign(".this", env, env)

  addNode = function(node, parentId) {
    node = asXMLTreeNode(node, .this)
    id = node$id

    if(length(parentId)) {
      .parents[ id ] <<- parentId
      .children [[ parentId ]] <<- c(.children[[ parentId ]], id )
    }
    .nodes[[ id ]] <<- node

    id
  }
  environment(addNode)  = env
  env$.addNode <- addNode

  ids = names(nodes)
  nodes = lapply(seq(along = nodes),
                  function(i) {
                         x = nodes[[ i ]]
                         if(!("id" %in% names(unclass(x))))
                            x$id = f( ifelse(ids[ i ] == "", xmlName(x), ids[i]) )

                         if(!inherits(x, "XMLTreeNode")) {
                ## FIXME: there is no visible 'e' here
                            x$env = e
                            class(x) = c("XMLTreeNode", class(x))
                         }
                         x
                       })

  names(nodes) = sapply(nodes, function(x) x$id)
  env$.nodes <- nodes

  env$.parents = parents
  env$.children = children

  structure(env, class = c("XMLSimpleFlatTree", "XMLFlatTree"))
}
}