https://github.com/cran/XML
Tip revision: 2a8f7641e89371e9cc8bbf40bde78f04d735b16c authored by CRAN Team on 18 January 2020, 14:23:57 UTC
version 3.99-0.2
version 3.99-0.2
Tip revision: 2a8f764
flatTree.R
## 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"))
}
}