The R Project SVN – R-packages – Diff – /trunk/XML/R/xmlToDataFrame.R



  #   </obs>
  #   <obs>
  #     <var1>value</var1>
  #     <var2>value</var2>
  #     <var3>value</var3>
  #   </obs>
  #  </top>
  #
  # This can handle cases where not all observations have the same
  # fields.
  #
  # z = xmlToDataFrame("~/size.xml")
  # z = xmlToDataFrame("~/size.xml", c("integer", "integer", "numeric"))
  #
 
           function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)
              standardGeneric("xmlToDataFrame"))
 
setMethod("xmlToDataFrame", "character",
             # parse the XML document if it is a file name and
             # not a regular XML document already.
          function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)
               xmlToDataFrame(xmlParse(doc), colClasses, homogeneous, collectNames, stringsAsFactors = stringsAsFactors))
 
 
 
setMethod("xmlToDataFrame", c("XMLInternalDocument", nodes = "missing"),
  function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)
      xmlToDataFrame(doc, colClasses, homogeneous, collectNames, nodes = xmlChildren(xmlRoot(doc)), stringsAsFactors))
 
tmp =
function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)
{
 
  if(length(nodes) == 0)
    return(data.frame())
 
    # Find out how many fields there.
  nfields = sapply(nodes, xmlSize)
  nvar = max(nfields)
 
  if(collectNames)
     varNames = unique(unlist( lapply(nodes, names) ))
  else
     varNames = names(nodes[[which.max(nfields)]])
 
  if(is.na(homogeneous))
    homogeneous = all(nfields == nvar) && all(sapply(nodes[-1], function(x) all(names(x) == varNames)))
 
 
  if(!homogeneous)
    return(fromRaggedXML2DataFrame(nodes, varNames, c(length(nfields), length(varNames)), colClasses, stringsAsFactors))
 
     # Function to operate on each
  fun = function(x) {
           tmp = xmlSApply(x, xmlValue)
           length(tmp) = nvar
           tmp
        }

  vals = unlist(lapply(nodes, fun))
 
  ans = matrix(vals, length(nfields), byrow = TRUE)
 
 
 
  ans =
    if(length(colClasses)) {
       as.data.frame(lapply(seq(along = colClasses),
                                       function(i) {
                                          as(ans[, i], colClasses[i])

 
  ans
}
 
bob =
function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)
  xmlToDataFrame(nodes = doc, colClasses = colClasses, homogeneous = homogeneous, collectNames = collectNames, stringsAsFactors = stringsAsFactors)
 
setMethod("xmlToDataFrame", c(nodes = "XMLNodeSet"), tmp)
setMethod("xmlToDataFrame", c(nodes = "list"), tmp)
setOldClass("XMLInternalNodeList")

setMethod("xmlToDataFrame", "XMLNodeSet",   bob)
setMethod("xmlToDataFrame", "XMLInternalNodeList",   bob)
setMethod("xmlToDataFrame", "list",   bob)
 
setMethod("xmlToDataFrame", "XMLInternalElementNode",
          function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)
            xmlToDataFrame(nodes = xmlChildren(doc), colClasses = colClasses, homogeneous = homogeneous, collectNames = collectNames, stringsAsFactors = stringsAsFactors))
 
fromRaggedXML2DataFrame =
  #
  # This reads data from the nodes of an XML document and assumes
  # that they do not all have the same number or even names of fields.
  # So this does extra work to match each observation to the union of
  # the field names across all nodes.
  #
  # o = fromRaggedXML2DataFrame("size2.xml")
  # o = fromRaggedXML2DataFrame("size1.xml")
  #
function(nodes, varNames = unique(unlist( lapply(nodes, names) )),
          dims = c(length(nodes), length(varNames)),   colClasses = NULL,
          stringsAsFactors = FALSE)
{
  #XXX
  if(is.character(nodes))
    nodes = xmlChildren(xmlRoot(xmlParse(nodes)))
 
   # create an empty data frame with as many rows and columns as needed.
  ans = as.data.frame(replicate(dims[2], rep(as.character(NA), dims[1]), simplify = FALSE), stringsAsFactors = FALSE)
  names(ans) = varNames
 
    # Fill in the rows based on the names.
  for(i in seq(length = dims[1]))
     ans[i, names(nodes[[i]])] = xmlSApply(nodes[[i]], xmlValue)
 
 
    # Convert the columns to the specified classes if specified.
    # Should drop cols with NULL. Also guess those with NA.
  if(length(colClasses))  {
    i = ! sapply(colClasses, is.null)
    ans = ans[ i ]
    varNames = varNames[i]
    colClasses = colClasses[ i ]
    ans = as.data.frame(lapply(seq(length = ncol(ans)),
                                function(i) {
                                  as(ans[, i], colClasses[[i]])
                                }), stringsAsFactors = stringsAsFactors)
  }
 
  names(ans) = varNames
 
  ans
}
 
 

setMethod("xmlAttrsToDataFrame", "list",
           function(doc, attrs = character(), omit = character(), ...) {
               # assuming these are all nodes.
 
             combineNamedVectors(lapply(doc, xmlAttrs), attrs, omit, ...)
 
           })
setMethod("xmlAttrsToDataFrame", "XMLInternalNodeList",
           function(doc, attrs = character(), omit = character(), ...) {
               # assuming these are all nodes.
 
             combineNamedVectors(lapply(doc, xmlAttrs), attrs, omit, ...)
 
           })
 
inAllRecords =
function(x)
{

}
 
allNames =
function(x)
  unique( unlist(lapply(x, names))  )
 
 
combineNamedVectors   =
function(els, attrs = character(), omit = character(), ...)
{
  if(is.function(attrs))
     attrs = attrs(els)
 
  if(!length(attrs)) {
    attrs = allNames(els)
 
    if(length(omit))
      attrs = setdiff(attrs, omit)
  }
 
  if(length(attrs) == 0) {
    warning("no elements to combine across records")
    return(data.frame())
  }
 
  values = lapply(els, function(x) {
                         structure(x[attrs], names = attrs)
                       })
  ans = as.data.frame(do.call(rbind, values), row.names = NULL, ...)
  rownames(ans) = NULL
  ans
}
 

Rev 7747	Rev 8025
Line 13...	Line 13...
13	`# </obs>`	13	`# </obs>`
14	`# <obs>`	14	`# <obs>`
15	`# <var1>value</var1>`	15	`# <var1>value</var1>`
16	`# <var2>value</var2>`	16	`# <var2>value</var2>`
17	`# <var3>value</var3>`	17	`# <var3>value</var3>`
18	`# </obs>`	18	`# </obs>`
19	`# </top>`	19	`# </top>`
20	`#`	20	`#`
21	`# This can handle cases where not all observations have the same`	21	`# This can handle cases where not all observations have the same`
22	`# fields.`	22	`# fields.`
23	`#`	23	`#`
24	`# z = xmlToDataFrame("~/size.xml")`	24	`# z = xmlToDataFrame("~/size.xml")`
25	`# z = xmlToDataFrame("~/size.xml", c("integer", "integer", "numeric"))`	25	`# z = xmlToDataFrame("~/size.xml", c("integer", "integer", "numeric"))`
26	`#`	26	`#`
27		27
28	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = default.stringsAsFactors())`	28	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)`
29	`standardGeneric("xmlToDataFrame"))`	29	`standardGeneric("xmlToDataFrame"))`
30		30
31	`setMethod("xmlToDataFrame", "character",`	31	`setMethod("xmlToDataFrame", "character",`
32	`# parse the XML document if it is a file name and`	32	`# parse the XML document if it is a file name and`
33	`# not a regular XML document already.`	33	`# not a regular XML document already.`
34	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = default.stringsAsFactors())`	34	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)`
35	`xmlToDataFrame(xmlParse(doc), colClasses, homogeneous, collectNames, stringsAsFactors = stringsAsFactors))`	35	`xmlToDataFrame(xmlParse(doc), colClasses, homogeneous, collectNames, stringsAsFactors = stringsAsFactors))`
36		36
37		37
38		38
39	`setMethod("xmlToDataFrame", c("XMLInternalDocument", nodes = "missing"),`	39	`setMethod("xmlToDataFrame", c("XMLInternalDocument", nodes = "missing"),`
40	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = default.stringsAsFactors())`	40	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)`
41	`xmlToDataFrame(doc, colClasses, homogeneous, collectNames, nodes = xmlChildren(xmlRoot(doc)), stringsAsFactors))`	41	`xmlToDataFrame(doc, colClasses, homogeneous, collectNames, nodes = xmlChildren(xmlRoot(doc)), stringsAsFactors))`
42		42
43	`tmp =`	43	`tmp =`
44	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = default.stringsAsFactors())`	44	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)`
45	`{`	45	`{`
46		46
47	`if(length(nodes) == 0)`	47	`if(length(nodes) == 0)`
48	`return(data.frame())`	48	`return(data.frame())`
49		49
50	`# Find out how many fields there.`	50	`# Find out how many fields there.`
51	`nfields = sapply(nodes, xmlSize)`	51	`nfields = sapply(nodes, xmlSize)`
52	`nvar = max(nfields)`	52	`nvar = max(nfields)`
53		53
54	`if(collectNames)`	54	`if(collectNames)`
55	`varNames = unique(unlist( lapply(nodes, names) ))`	55	`varNames = unique(unlist( lapply(nodes, names) ))`
56	`else`	56	`else`
57	`varNames = names(nodes[[which.max(nfields)]])`	57	`varNames = names(nodes[[which.max(nfields)]])`
58		58
59	`if(is.na(homogeneous))`	59	`if(is.na(homogeneous))`
60	`homogeneous = all(nfields == nvar) && all(sapply(nodes[-1], function(x) all(names(x) == varNames)))`	60	`homogeneous = all(nfields == nvar) && all(sapply(nodes[-1], function(x) all(names(x) == varNames)))`
61		61
62		62
63	`if(!homogeneous)`	63	`if(!homogeneous)`
64	`return(fromRaggedXML2DataFrame(nodes, varNames, c(length(nfields), length(varNames)), colClasses, stringsAsFactors))`	64	`return(fromRaggedXML2DataFrame(nodes, varNames, c(length(nfields), length(varNames)), colClasses, stringsAsFactors))`
65		65
66	`# Function to operate on each`	66	`# Function to operate on each`
67	`fun = function(x) {`	67	`fun = function(x) {`
68	`tmp = xmlSApply(x, xmlValue)`	68	`tmp = xmlSApply(x, xmlValue)`
69	`length(tmp) = nvar`	69	`length(tmp) = nvar`
70	`tmp`	70	`tmp`
71	`}`	71	`}`
Line 73...	Line 73...
73	`vals = unlist(lapply(nodes, fun))`	73	`vals = unlist(lapply(nodes, fun))`
74		74
75	`ans = matrix(vals, length(nfields), byrow = TRUE)`	75	`ans = matrix(vals, length(nfields), byrow = TRUE)`
76		76
77		77
78		78
79	`ans =`	79	`ans =`
80	`if(length(colClasses)) {`	80	`if(length(colClasses)) {`
81	`as.data.frame(lapply(seq(along = colClasses),`	81	`as.data.frame(lapply(seq(along = colClasses),`
82	`function(i) {`	82	`function(i) {`
83	`as(ans[, i], colClasses[i])`	83	`as(ans[, i], colClasses[i])`
Line 89...	Line 89...
89		89
90	`ans`	90	`ans`
91	`}`	91	`}`
92		92
93	`bob =`	93	`bob =`
94	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = default.stringsAsFactors())`	94	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)`
95	`xmlToDataFrame(nodes = doc, colClasses = colClasses, homogeneous = homogeneous, collectNames = collectNames, stringsAsFactors = stringsAsFactors)`	95	`xmlToDataFrame(nodes = doc, colClasses = colClasses, homogeneous = homogeneous, collectNames = collectNames, stringsAsFactors = stringsAsFactors)`
96		96
97	`setMethod("xmlToDataFrame", c(nodes = "XMLNodeSet"), tmp)`	97	`setMethod("xmlToDataFrame", c(nodes = "XMLNodeSet"), tmp)`
98	`setMethod("xmlToDataFrame", c(nodes = "list"), tmp)`	98	`setMethod("xmlToDataFrame", c(nodes = "list"), tmp)`
99	`setOldClass("XMLInternalNodeList")`	99	`setOldClass("XMLInternalNodeList")`
Line 102...	Line 102...
102	`setMethod("xmlToDataFrame", "XMLNodeSet", bob)`	102	`setMethod("xmlToDataFrame", "XMLNodeSet", bob)`
103	`setMethod("xmlToDataFrame", "XMLInternalNodeList", bob)`	103	`setMethod("xmlToDataFrame", "XMLInternalNodeList", bob)`
104	`setMethod("xmlToDataFrame", "list", bob)`	104	`setMethod("xmlToDataFrame", "list", bob)`
105		105
106	`setMethod("xmlToDataFrame", "XMLInternalElementNode",`	106	`setMethod("xmlToDataFrame", "XMLInternalElementNode",`
107	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = default.stringsAsFactors())`	107	`function(doc, colClasses = NULL, homogeneous = NA, collectNames = TRUE, nodes = list(), stringsAsFactors = FALSE)`
108	`xmlToDataFrame(nodes = xmlChildren(doc), colClasses = colClasses, homogeneous = homogeneous, collectNames = collectNames, stringsAsFactors = stringsAsFactors))`	108	`xmlToDataFrame(nodes = xmlChildren(doc), colClasses = colClasses, homogeneous = homogeneous, collectNames = collectNames, stringsAsFactors = stringsAsFactors))`
109		109
110	`fromRaggedXML2DataFrame =`	110	`fromRaggedXML2DataFrame =`
111	`#`	111	`#`
112	`# This reads data from the nodes of an XML document and assumes`	112	`# This reads data from the nodes of an XML document and assumes`
113	`# that they do not all have the same number or even names of fields.`	113	`# that they do not all have the same number or even names of fields.`
114	`# So this does extra work to match each observation to the union of`	114	`# So this does extra work to match each observation to the union of`
115	`# the field names across all nodes.`	115	`# the field names across all nodes.`
116	`#`	116	`#`
117	`# o = fromRaggedXML2DataFrame("size2.xml")`	117	`# o = fromRaggedXML2DataFrame("size2.xml")`
118	`# o = fromRaggedXML2DataFrame("size1.xml")`	118	`# o = fromRaggedXML2DataFrame("size1.xml")`
119	`#`	119	`#`
120	`function(nodes, varNames = unique(unlist( lapply(nodes, names) )),`	120	`function(nodes, varNames = unique(unlist( lapply(nodes, names) )),`
121	`dims = c(length(nodes), length(varNames)), colClasses = NULL,`	121	`dims = c(length(nodes), length(varNames)), colClasses = NULL,`
122	`stringsAsFactors = default.stringsAsFactors())`	122	`stringsAsFactors = FALSE)`
123	`{`	123	`{`
124	`#XXX`	124	`#XXX`
125	`if(is.character(nodes))`	125	`if(is.character(nodes))`
126	`nodes = xmlChildren(xmlRoot(xmlParse(nodes)))`	126	`nodes = xmlChildren(xmlRoot(xmlParse(nodes)))`
127		127
128	`# create an empty data frame with as many rows and columns as needed.`	128	`# create an empty data frame with as many rows and columns as needed.`
129	`ans = as.data.frame(replicate(dims[2], rep(as.character(NA), dims[1]), simplify = FALSE), stringsAsFactors = FALSE)`	129	`ans = as.data.frame(replicate(dims[2], rep(as.character(NA), dims[1]), simplify = FALSE), stringsAsFactors = FALSE)`
130	`names(ans) = varNames`	130	`names(ans) = varNames`
131		131
132	`# Fill in the rows based on the names.`	132	`# Fill in the rows based on the names.`
133	`for(i in seq(length = dims[1]))`	133	`for(i in seq(length = dims[1]))`
134	`ans[i, names(nodes[[i]])] = xmlSApply(nodes[[i]], xmlValue)`	134	`ans[i, names(nodes[[i]])] = xmlSApply(nodes[[i]], xmlValue)`
135		135
136		136
137	`# Convert the columns to the specified classes if specified.`	137	`# Convert the columns to the specified classes if specified.`
138	`# Should drop cols with NULL. Also guess those with NA.`	138	`# Should drop cols with NULL. Also guess those with NA.`
139	`if(length(colClasses)) {`	139	`if(length(colClasses)) {`
140	`i = ! sapply(colClasses, is.null)`	140	`i = ! sapply(colClasses, is.null)`
141	`ans = ans[ i ]`	141	`ans = ans[ i ]`
142	`varNames = varNames[i]`	142	`varNames = varNames[i]`
143	`colClasses = colClasses[ i ]`	143	`colClasses = colClasses[ i ]`
144	`ans = as.data.frame(lapply(seq(length = ncol(ans)),`	144	`ans = as.data.frame(lapply(seq(length = ncol(ans)),`
145	`function(i) {`	145	`function(i) {`
146	`as(ans[, i], colClasses[[i]])`	146	`as(ans[, i], colClasses[[i]])`
147	`}), stringsAsFactors = stringsAsFactors)`	147	`}), stringsAsFactors = stringsAsFactors)`
148	`}`	148	`}`
149		149
150	`names(ans) = varNames`	150	`names(ans) = varNames`
151		151
152	`ans`	152	`ans`
153	`}`	153	`}`
154		154
155		155
Line 177...	Line 177...
177	`setMethod("xmlAttrsToDataFrame", "list",`	177	`setMethod("xmlAttrsToDataFrame", "list",`
178	`function(doc, attrs = character(), omit = character(), ...) {`	178	`function(doc, attrs = character(), omit = character(), ...) {`
179	`# assuming these are all nodes.`	179	`# assuming these are all nodes.`
180		180
181	`combineNamedVectors(lapply(doc, xmlAttrs), attrs, omit, ...)`	181	`combineNamedVectors(lapply(doc, xmlAttrs), attrs, omit, ...)`
182		182
183	`})`	183	`})`
184	`setMethod("xmlAttrsToDataFrame", "XMLInternalNodeList",`	184	`setMethod("xmlAttrsToDataFrame", "XMLInternalNodeList",`
185	`function(doc, attrs = character(), omit = character(), ...) {`	185	`function(doc, attrs = character(), omit = character(), ...) {`
186	`# assuming these are all nodes.`	186	`# assuming these are all nodes.`
187		187
188	`combineNamedVectors(lapply(doc, xmlAttrs), attrs, omit, ...)`	188	`combineNamedVectors(lapply(doc, xmlAttrs), attrs, omit, ...)`
189		189
190	`})`	190	`})`
191		191
192	`inAllRecords =`	192	`inAllRecords =`
193	`function(x)`	193	`function(x)`
194	`{`	194	`{`
Line 197...	Line 197...
197	`}`	197	`}`
198		198
199	`allNames =`	199	`allNames =`
200	`function(x)`	200	`function(x)`
201	`unique( unlist(lapply(x, names)) )`	201	`unique( unlist(lapply(x, names)) )`
202		202
203		203
204	`combineNamedVectors =`	204	`combineNamedVectors =`
205	`function(els, attrs = character(), omit = character(), ...)`	205	`function(els, attrs = character(), omit = character(), ...)`
206	`{`	206	`{`
207	`if(is.function(attrs))`	207	`if(is.function(attrs))`
208	`attrs = attrs(els)`	208	`attrs = attrs(els)`
209		209
210	`if(!length(attrs)) {`	210	`if(!length(attrs)) {`
211	`attrs = allNames(els)`	211	`attrs = allNames(els)`
212		212
213	`if(length(omit))`	213	`if(length(omit))`
214	`attrs = setdiff(attrs, omit)`	214	`attrs = setdiff(attrs, omit)`
215	`}`	215	`}`
216		216
217	`if(length(attrs) == 0) {`	217	`if(length(attrs) == 0) {`
218	`warning("no elements to combine across records")`	218	`warning("no elements to combine across records")`
219	`return(data.frame())`	219	`return(data.frame())`
220	`}`	220	`}`
221		221
222	`values = lapply(els, function(x) {`	222	`values = lapply(els, function(x) {`
223	`structure(x[attrs], names = attrs)`	223	`structure(x[attrs], names = attrs)`
224	`})`	224	`})`
225	`ans = as.data.frame(do.call(rbind, values), row.names = NULL, ...)`	225	`ans = as.data.frame(do.call(rbind, values), row.names = NULL, ...)`
226	`rownames(ans) = NULL`	226	`rownames(ans) = NULL`
227	`ans`	227	`ans`
228	`}`	228	`}`
229		229

The R Project SVN R-packages

(root)/trunk/XML/R/xmlToDataFrame.R – Rev 7747 → 8025