File: flatTree.R

package info (click to toggle)
r-cran-xml 3.99-0.19-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 3,688 kB
  • sloc: ansic: 6,659; xml: 2,890; asm: 486; sh: 12; makefile: 2
file content (243 lines) | stat: -rw-r--r-- 6,384 bytes parent folder | download | duplicates (4)
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"))
}
}