XML 到缺少节点的数据框

Question

此问题的多个版本已被问过，如 here and here。但是，我仍然无法让它工作。我正在尝试将 XML 文档解析为数据框。问题是某些观察结果不存在某些变量，因此我收到错误，因为行数不同。我的数据如下所示：

library("xml2")
library("dplyr")

example <- read_xml(
'
<particDesc>
<person role="participant" sameAs="#P484" xml:id="EDcon250_S1">
<age value="3">35-49</age>
<sex value="1">male</sex>
<occupation>waiter</occupation>
<langKnowledge>
<langKnown level="L1" tag="ita"/>
</langKnowledge>
</person>
<person role="participant" sameAs="#P485" xml:id="EDcon250_S7">
<age value="0">unknown</age>
<sex value="2">female</sex>
<occupation>waitress</occupation>
<langKnowledge>
<langKnown level="L1" tag="ger-AT"/>
</langKnowledge>
</person>
<person role="participant" sameAs="#P465" xml:id="EDcon250_S2">
<age value="2">25-34</age>
<sex value="2">female</sex>
<langKnowledge>
<langKnown level="L1" tag="ger-AT"/>
<langKnown level="L1" tag="eng-US"/>
</langKnowledge>
</person>
</particDesc>
')

我正在使用 Wickham 的 xml2 软件包来阅读 xml。我更喜欢使用这个包，但如果这是解决此问题的最佳（或唯一）方法，我愿意使用 XML。无论如何，我的代码如下：

participants <- xml_find_all(example, './/person[@role = "participant"]')

extract_participants <- function(div){
id <- xml_attr(div, "id")
same_as <- xml_attr(div, "sameAs")
role <- xml_attr(div, "role")
age <- xml_find_all(div, ".//age") %>% xml_text()
sex <- xml_find_all(div, ".//sex") %>% xml_text()
occupation <- xml_find_all(div, ".//occupation") %>% xml_text()

data_frame(id, same_as,role, age, sex, occupation)
}


parts_ls <- lapply(participants, extract_participants)

participants_df <- do.call(rbind, parts_ls)

这个具体的问题涉及 occupation 变量（第三人没有），但在我的实际数据中它也可能是其他变量之一。正如我所说，我可以看到之前有人问过这个问题，但我可以获得任何建议（可能是因为我没有完全理解解决方案）。最终，我希望在缺少特定节点时返回 NA（因此第三人称的 occupation 变量将是 NA.

编辑时：这是替代 XML 版本

library("XML")
library("magrittr")

example2 <- xmlParse(
'
 <particDesc>
 <person role="participant" sameAs="#P484" xml:id="EDcon250_S1">
 <age value="3">35-49</age>
 <sex value="1">male</sex>
 <occupation>waiter</occupation>
 <langKnowledge>
 <langKnown level="L1" tag="ita"/>
 </langKnowledge>
 </person>
 <person role="participant" sameAs="#P485" xml:id="EDcon250_S7">
 <age value="0">unknown</age>
 <sex value="2">female</sex>
 <occupation>waitress</occupation>
 <langKnowledge>
 <langKnown level="L1" tag="ger-AT"/>
 </langKnowledge>
 </person>
 <person role="participant" sameAs="#P465" xml:id="EDcon250_S2">
 <age value="2">25-34</age>
 <sex value="2">female</sex>
 <langKnowledge>
 <langKnown level="L1" tag="ger-AT"/>
 <langKnown level="L1" tag="eng-US"/>
 </langKnowledge>
 </person>
 </particDesc>
')

example_root <- xmlRoot(example2) 

process <- function(x){
id <- xmlGetAttr(x, "id")
role <- xmlGetAttr(x, "role")
age <- getNodeSet(x, ".//age") %>% xmlSApply(xmlValue)
sex <- getNodeSet(x, ".//sex") %>% xmlSApply(xmlValue)
#occupation <- getNodeSet(x, ".//occupation") %>% xmlSApply(xmlValue)
data.frame(id = id,
           role = role,
           #occupation = occupation,
           age = age,
           sex = sex,
           stringsAsFactors = FALSE)
}


 ls <- xpathApply(example_root, "//person", process)
 df <- do.call(rbind, ls)

只需取消注释 occupation 即可查看问题。

Answer 1

我有一些工作要做，但我不确定它是否是一个理想的解决方案（我认为它很啰嗦）。无论如何，这是我到目前为止所拥有的。欢迎提出改进建议。

library("XML")
library("magrittr")

example2 <- xmlParse(
'
<particDesc>
<person role="participant" sameAs="#P484" xml:id="EDcon250_S1">
<age value="3">35-49</age>
<sex value="1">male</sex>
<occupation>waiter</occupation>
<langKnowledge>
<langKnown level="L1" tag="ita"/>
</langKnowledge>
</person>
<person role="participant" sameAs="#P485" xml:id="EDcon250_S7">
<age value="0">unknown</age>
<sex value="2">female</sex>
<occupation>waitress</occupation>
<langKnowledge>
<langKnown level="L1" tag="ger-AT"/>
</langKnowledge>
</person>
<person role="participant" sameAs="#P465" xml:id="EDcon250_S2">
<age value="2">25-34</age>
<sex value="2">female</sex>
<langKnowledge>
<langKnown level="L1" tag="ger-AT"/>
<langKnown level="L1" tag="eng-US"/>
</langKnowledge>
</person>
</particDesc>
')

example_root <- xmlRoot(example2) 
person <- getNodeSet(example_root, "//person")

id <- lapply(person, xmlGetAttr, "id") %>% unlist()
role <- lapply(person, xmlGetAttr, "role") %>% unlist()
age <- lapply(person, xpathSApply, ".//age", xmlValue) %>% unlist()
sex <- lapply(person, xpathSApply, ".//sex", xmlValue) %>% unlist()
occupation <- lapply(person, xpathSApply, ".//occupation", xmlValue)
occupation[sapply(occupation, is.list)] <- NA 
occupation <- unlist(occupation)

df <- data.frame(
   id = id,
   role = role,
   age = age,
   sex = sex,
   occupation = occupation)

编辑时：补全，这里是对应的xml2版本（删节）

example <- read_xml(
'
 <particDesc>
 <person role="participant" sameAs="#P484" xml:id="EDcon250_S1">
 <age value="3">35-49</age>
 <sex value="1">male</sex>
 <occupation>waiter</occupation>
 <langKnowledge>
 <langKnown level="L1" tag="ita"/>
 </langKnowledge>
 </person>
 <person role="participant" sameAs="#P485" xml:id="EDcon250_S7">
 <age value="0">unknown</age>
 <sex value="2">female</sex>
 <occupation>waitress</occupation>
 <langKnowledge>
 <langKnown level="L1" tag="ger-AT"/>
 </langKnowledge>
 </person>
 <person role="participant" sameAs="#P465" xml:id="EDcon250_S2">
 <age value="2">25-34</age>
 <sex value="2">female</sex>
 <langKnowledge>
 <langKnown level="L1" tag="ger-AT"/>
 <langKnown level="L1" tag="eng-US"/>
 </langKnowledge>
 </person>
 </particDesc>
')

participants <- xml_find_all(example, './/person[@role = "participant"]')

id <- lapply(participants, xml_attr, "id")
occupation <- lapply(participants, xml_find_all, ".//occupation")
occupation <- lapply(occupation, xml_text)
occupation[!sapply(occupation, function(y) length(y == 0))] <- NA

occupation <- unlist(occupation)
id <- unlist(id)

data_frame(
  id = id, 
  occupation = occupation)

XML 到缺少节点的数据框

XML to data frame with missing nodes

xml

r

dataframe

xml2