How to extract values from complex XML in R without discarding nodes without existing value?

Viewed 908

I am starting with a large, complex XML-file and need to extract values and attributes of certain sub(sub...)nodes. But because not all subnodes have all wanted values (some are missing) I cannot easily use the very fast xml_find_all (xml2 package), because it will of course not include the subnodes with missing values.

My solution is to use a for-loop cycling through all of my xml-nodes (Objects) and check within each node, if my desired value is exists - if yes, extract it. Thanks to the index of the loop I know to which Object it belongs and write it to the corresponding data.frame$Feature[i].

This approach works fine, but for my large XML-Node it takes a VERY long time (20 min) and is very memory consuming (~1.5GB, because of if-loop). My XML: 100MB, about 30.000 "entries/Objects" each with about 50 features (~ 2 Mio lines)

The main problem which I figured out: xpathSApply(...xml_path(Obj[i]...) is very slow, if the indexing [i] of my loop is quite high (>5000)

My questions are:

  • Is there any better/simpler ideas to solve my problem with a very complex and higly inhomogenic, structured XML, where not all features are present in all object(nodes)?
  • I read this interesting approach, but could not figure out how to translate it to my very complex XML, where my desired values are in different Nodeset-levels...
  • Is there maybe some nested xpathSApply-expression to circumvent a for-loop and avoid using index?
  • Do you now any "vector"-processing approaches (which are quite faster in R) for my problem?

See my MWE-Code with some more comments below.

XML

<?xml version="1.0" encoding="UTF-8"?>
<featureMember>
        <Object>
                <XML_Name>Object 1</XML_Name>
               <XML_Feature1>
                   <XML_Feature1a href="URL1"></XML_Feature1a>
                </XML_Feature1>
                <XML_Feature2>
                   <XML_Feature2a>1</XML_Feature2a>
                   <XML_Feature2a>1x</XML_Feature2a>
                   <XML_Feature2a>1y</XML_Feature2a>
                </XML_Feature2>
                <XML_Feature3>
                   <XML_Feature3a>F3a_1</XML_Feature2a>
                   <XML_Feature3b>F3b_1</XML_Feature2a>
                </XML_Feature3>
                <XML_Feature3>
                   <XML_Feature3a>F3a_2</XML_Feature2a>
                   <XML_Feature3b>F3b_2</XML_Feature2a>
                </XML_Feature3>
                <XML_Feature4>F4_1</XML_Feature4>
                <XML_Feature4>F4_2</XML_Feature4>   
        </Object>       
        <Object >
            <XML_Name>Object 2</XML_Name>
               <XML_Feature1>
                   <XML_Feature1a href="URL2"></XML_Feature1a>
                </XML_Feature1>         
        </Object>       
        <Object >
        <XML_Name>Object 3</XML_Name>
            <XML_Feature1>
               <XML_Feature1>               
               </XML_Feature1>
            </XML_Feature1>
            <XML_Feature2>
                <XML_Feature2a>Value 3</XML_Feature2a>
            </XML_Feature2>
        </Object>
</featureMember>

R

require(xml2)
require(XML)
test_xml2 <- read_xml("above_file.xml") # using Packet xml2 (for using xml_find_all)
test_XML <- xmlParse("above_file.xml") # Packet XML (for using xpathSApply)

  # XML-Noteset of all Objects I want to process:
Obj <- xml_find_all(test_xml2, "//Object") # --> has 3 nodes, contains all Objects!
  
  # initialize a destination dataframe and fill with NAs
df <- data.frame('Name'=integer(), 'f2a'=character() , 'f1a'=character(), stringsAsFactors = FALSE)
df[1:length(Obj),] <- NA

# My Initial approach to extract all features by xml_find_all (which is very fast) is not working because not all xml-nodes have all wanted xml-features:
Name <- xml_text(xml_find_all(test_xml2, "//XML_Name")) 
  # --> length(Name)=3, because all 3 Objects have a name!
f1a  <- xml_attr(xml_find_all(test_xml2, "//XML_Feature1/XML_Feature1a"),"href") 
  # --> length(f1a)=2, because XML_Feature1a is missing in Object3! 
f2a  <- xml_text(xml_find_all(test_xml2, "//XML_Feature2/XML_Feature2a")) 
  # --> length(f2a)=2, because XML_Feature2a is missing in Object2!
# Joining these to a final df is not possible, because "Name", "f2a" and "f1a" have of course different lengths, plus correct data matching is not possible!


# Therefore I decided to make instead the following approach.
  # 1.) crawl all features, which are present in all nodes, because its fast (here: "Name"):
df$Name <- xml_text(xml_find_all(test_xml2, "//XML_Name"))
  
  # 2.) making a for-loop over all Objects/XML-Nodes of interest and check if eacht wanted feature exist.
    # if yes: write to df$FeatureXY[i]
    # if not: make nothing (thus df$FeatureXY[i]stays NA from initialization)
for (i in 1:length(Obj))
{  # 1. Feature:
 tmp  <- xpathSApply(test_XML, paste0(xml_path(Obj[i]),"/XML_Feature1/XML_Feature1a"),  xmlGetAttr, "href")
 if(length(tmp )>0) { df$f1a[i] <- tmp # otherwise it would produce an error-message}
    # 2. Feature:
 tmp  <- xpathSApply(test_XML, paste0(xml_path(Obj[i]),"/XML_Feature2/XML_Feature2a"),  xmlValue)
 if(length(tmp )>0) { df$f2a[i] <- tmp} 
}  

# Result of df as it should be:
# Name      f2a             f1a   f3a            f3b             f4
# Object 1  1 # 1x # 1y     URL1  F3a_1 # F3a_2  F3b_1 # F3b_2   F4_1 # F4_2
# Object 2  NA              URL2  NA             NA              NA 
# Object 3  Value 3         NA    NA             NA              NA

Edit 1: Extended XML example (multiple elements of feature2a, feature3a/b feature4)

2 Answers

Problems like this can be tricky, in order to handle any potential changes between the sample data and the actual data. If we assume there is at most a single "Feature1a" node and at most a single "Feature2a" node per "Object" then this breaks down to a straight forward problem.

First find all of the parent "Object" nodes then using this vector of nodes parse each one for the Name, feature1a attribute and feature2a text. xml_find_first will return a value if the node exists, if not then it will return NA. Since the xml_find_first function is vectorized, it will operate on the vector of parent nodes without the need of a loop and with a very significant performance improvement.

library(xml2)
library(dplyr)

#Read file to process
doc<- read_xml("above_file.xml")

#find parent nodes
parents <- xml_find_all(doc, ".//Object")

#Now extract the requested data from each parent
# Notice the use of the . in the xpath. 
# //  finds anywhere in the document (ignoring the current node)
# .// finds anywhere beneath the current node
Names<- xml_find_first(parents, ".//XML_Name") %>% xml_text()
feature1 <- xml_find_first(parents, ".//XML_Feature1a") %>% xml_attr("href")

#fill features with first elements as default
feature2 <- xml_find_first(parents, ".//XML_Feature2a") %>% xml_text()
#find parents with more than 1 feature2
moretwos<-which(xml_find_all(parents, ".//XML_Feature2")  %>% xml_length() >1)
#reparse the parent nodes with more than one child
feature2[moretwos] <-sapply(parents[moretwos], function(node){
        xml_find_all(node, ".//XML_Feature2a") %>% xml_text() %>% paste(collapse = "#")
})


#Make combinded dataframe
answer <-data.frame(Names, feature1, feature2)
answer

Here is a similar question but with an unknown number of subnodes: Create data frame from xml with different number of elements

UPDATE For your revised problem of having multiple subnodes with multiple children, but no grandchildren here is option.

#find parent nodes
parents<-xml_find_all(doc, ".//Object")

dfs<-lapply(parents, function(parent) {
  #Get oject name
  object<-xml_find_first(parent, ".//XML_Name") %>% xml_text()

  #find the number of children under each child
  numchild<-xml_children(parent) %>% xml_length()

  #if number of children is zero get name and value
  name  <- xml_children(parent)[numchild==0] %>% xml_name()
  value <- xml_children(parent)[numchild==0] %>% xml_text()

   #if the number of childern is 1 or more the get the name value of the child
   namec2  <- xml_children(parent)[numchild>=1] %>% xml_children() %>% xml_name()
   valuec2 <- xml_children(parent)[numchild>=1] %>% xml_children() %>% xml_text()

  #make data frame of the values and column headings
  df<-data.frame(object, name=c(name, namec2), value=c(value, valuec2), stringsAsFactors = FALSE)
  print(df)
  df
})

#Make combinded dataframe
answer<-bind_rows(dfs)
answer
library(tidyr) 
pivot_wider(answer, object, names_from = name, values_from= value, values_fn = list(value = toString))

The final answer will need to some cleaning of the columns, gsub(", ", " # ", ...) and retrieving the URL attribute from above

At 100 MB, consider XSLT, the special-purpose language designed to transform XML files such as very nested levels to flatter outputs for easy R data frame import. R can run XSLT with xslt, extended package to xml2. Otherwise use any XSLT executable to handle the transformation as demonstrated further below. And because you also use XML, consider its convenience method xmlToDataFrame for import of flatter XML files.

XSLT (save as .xsl file, a special .xml file)

<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">

  <xsl:output method="xml" indent="yes"/>
  <xsl:strip-space elements="*"/>

  <xsl:template match="/featureMember">
      <root>
        <xsl:apply-templates select="Object"/>
      </root>
  </xsl:template>

  <xsl:template match="Object">
      <data>
        <Name><xsl:apply-templates select="XML_Name"/></Name>
        <f1><xsl:apply-templates select="XML_Feature1/XML_Feature1a/@href"/></f1>
        <f2><xsl:apply-templates select="XML_Feature2"/></f2>
      </data>
  </xsl:template>

</xsl:stylesheet>

XSLT Demo

XML Output

<?xml version="1.0" encoding="utf-16"?>
<root>
  <data>
    <Name>Object 1</Name>
    <f1>URL1</f1>
    <f2>Value 1</f2>
  </data>
  <data>
    <Name>Object 2</Name>
    <f1>URL2</f1>
    <f2 />
  </data>
  <data>
    <Name>Object 3</Name>
    <f1 />
    <f2>Value 3</f2>
  </data>
</root>

R (no for loops, apply calls, if logic, or XPath search needed)

library(xml2)
library(xslt)
library(XML)

# PARSE XML AND XSLT
doc <- read_xml('/path/toInput.xml')
style <- read_xml('/path/to/Script.xsl', package = "xslt")

# TRANSFORM NESTED INPUT INTO FLATTER OUTPUT
new_xml <- as.character(xslt::xml_xslt(doc, style))

# PARSE FLATTER XML
flat_xml <- XML::xmlParse(new_xml, asText=TRUE)

# BUILD DATA FRAME
final_df <- XML::xmlToDataFrame(flat_xml, XML::getNodes(nodes="//data"))

To demonstrate an external XSLT solution, below interfaces to the xsltproc command line tool available for installation on Unix machines (i.e., Linux, MacOS):

library(XML)

# COMMAND LINE CALL TO UNIX'S XSLTPROC (ALTERNATIVE TO xslt PACKAGE)
system("xsltproc -o /path/to/input.xml /path/to/script.xsl /path/to/output.xml")

flat_xml <- xmlParse("/path/to/output.xml")

final_df <- xmlToDataFrame(flat_xml, getNodes(nodes="//data"))
Related