在R中提取XML节点和属性

Cla*_*ley 3 xml r

我有一个XML数据集,如下所示:

<protocol ID='.'>
    <HEAD></HEAD>
    <block ID='...'>
        <HEAD></HEAD>
        <trial ID='.....'>
            <HEAD></HEAD>
            <seq ID=''>
                <HEAD></HEAD>
                <calibration CLASS='affine-calibration' ID='New Calibration'>
                    <AX>.........</AX>
                    <BX>-........</BX>
                    <AY>.........</AY>
                    <BY>.........</BY>
                    <type>'por'</type>
                </calibration>
                <POR TIME='......'>
                    <PUPIL>.</PUPIL>
                    <BLINK>.</BLINK>
                    <V>...</V>
                    <H>...</H>
                    <PLANEINTRWV>...</PLANEINTRWV>
                    <PLANEINTRWH>...</PLANEINTRWH>
                    <PLANE>.</PLANE>
                </POR>
                <POR TIME='......'>
                    <PUPIL>.</PUPIL>
                    <BLINK>.</BLINK>
                    <V>...</V>
                    <H>...</H>
                    <PLANEINTRWV>...</PLANEINTRWV>
                    <PLANEINTRWH>...</PLANEINTRWH>
                    <PLANE>.</PLANE>
                </POR>
                <POR TIME='......'>
                    <PUPIL>.</PUPIL>
                    <BLINK>.</BLINK>
                    <V>...</V>
                    <H>...</H>
                    <PLANEINTRWV>...</PLANEINTRWV>
                    <PLANEINTRWH>...</PLANEINTRWH>
                    <PLANE>.</PLANE>
                </POR>
            </seq>
        </trial>
        <trial ID='.....'>
            <HEAD></HEAD>
            <seq ID=''>
                <HEAD></HEAD>
                <calibration CLASS='affine-calibration' ID='New Calibration'>
                    <AX>.........</AX>
                    <BX>-........</BX>
                    <AY>.........</AY>
                    <BY>.........</BY>
                    <type>'por'</type>
                </calibration>
                <POR TIME='......'>
                    <PUPIL>.</PUPIL>
                    <BLINK>.</BLINK>
                    <V>...</V>
                    <H>...</H>
                    <PLANEINTRWV>...</PLANEINTRWV>
                    <PLANEINTRWH>...</PLANEINTRWH>
                    <PLANE>.</PLANE>
                </POR>
                <POR TIME='......'>
                    <PUPIL>.</PUPIL>
                    <BLINK>.</BLINK>
                    <V>...</V>
                    <H>...</H>
                    <PLANEINTRWV>...</PLANEINTRWV>
                    <PLANEINTRWH>...</PLANEINTRWH>
                    <PLANE>.</PLANE>
                </POR>
            </seq>
        </trial>
    </block>
</protocol>
Run Code Online (Sandbox Code Playgroud)

使用XML包,提取POR标记的子项和标记属性的最简洁方法是什么?

我把这个有用的kludge放在一起,但它很慢(由于最有可能的xpathSApply调用)并且难以读取.

trackToDataFrame = function(file) {
    doc2=xmlParse(file)
    timeStamps = t(xpathSApply(doc2, '//*[@TIME]', function(x) c(name=xmlName(x), xmlAttrs(x))))
    dd2 = xmlToDataFrame(getNodeSet(doc2, "//POR"), colClasses=c(rep("integer", 7)))
    dd2 = cbind(dd2, timeStamps)
    dd2
}
Run Code Online (Sandbox Code Playgroud)

调用数据集返回:

  PUPIL BLINK  V  H PLANEINTRWV PLANEINTRWH PLANE name   TIME
1    NA    NA NA NA          NA          NA    NA  POR ......
2    NA    NA NA NA          NA          NA    NA  POR ......
3    NA    NA NA NA          NA          NA    NA  POR ......
4    NA    NA NA NA          NA          NA    NA  POR ......
5    NA    NA NA NA          NA          NA    NA  POR ......
Run Code Online (Sandbox Code Playgroud)

我想通过单个xmlToDataFrame调用可以完成所有事情,但是我对XML包不够熟悉才能使它工作.

我真正感兴趣的是'TIME'列以及从xmlToDataFrame调用中提取的所有列.

use*_*452 15

require(XML)
Fun1 <- function(xdata){
  dum <- xmlParse(xdata)
  xDf <- xmlToDataFrame(nodes = getNodeSet(dum, "//*/POR"), stringsAsFactors = FALSE)
  xattrs <- xpathSApply(dum, "//*/POR/@TIME")
  xDf$name <- "POR"
  xDf$TIME <- xattrs
  xDf
}

Fun2 <-function(xdata){
  dumFun <- function(x){
    xname <- xmlName(x)
    xattrs <- xmlAttrs(x)
    c(sapply(xmlChildren(x), xmlValue), name = xname, xattrs)
  }
  dum <- xmlParse(xdata)
  as.data.frame(t(xpathSApply(dum, "//*/POR", dumFun)), stringsAsFactors = FALSE)
}

> identical(Fun1(xdata), Fun2(xdata))
[1] TRUE

library(rbenchmark)

benchmark(Fun1(xdata), Fun2(xdata))

         test replications elapsed relative user.self sys.self user.child
1 Fun1(xdata)          100   1.047    2.069     1.044        0          0
2 Fun2(xdata)          100   0.506    1.000     0.504        0          0
  sys.child
1         0
2         0
Run Code Online (Sandbox Code Playgroud)