1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243
|
## 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"))
}
}
|