XML с различным числом дочерних элементов к фрейму данных / таблице

Question

Я пытаюсь преобразовать данные из XML в табличную форму. Я борюсь с элементами с детьми. Вот пример:

library(xml2)
library(data.table)

doc =
"<doc>
    <rec>
        <name> John </name>
        <address>
            <street> 2nd Av </street>
            <number> 1036 </number>
        </address>
        <hobbies>
            <hobby> tennis </hobby>
            <hobby> gardening </hobby>    
        </hobbies>
    </rec>
    <rec>
        <name> Mary </name>
        <address>
            <street>55th St</street>
            <number> 132 </number>
        </address>
        <hobbies>
            <hobby> running </hobby>
        </hobbies>
    </rec>
</doc>
"

# read in
pg <- read_xml(doc)

# make a list of records
recs = xml_find_all(pg, "//rec", xml_ns(pg))

# function to loop over list
extractRecord = function(x) {

    txt = xml_text(xml_children(x))
    name = xml_name(xml_children(x))
    names(txt) = name

    dt = setDT(as.list(txt))[]
    return(dt)
}

# loop over list of records
lst = lapply(recs, extractRecord)

# bind elements do a data table
dt  = rbindlist(lst, use.names = T, fill = T); dt

>      name        address             hobbies
> 1:  John   2nd Av  1036   tennis  gardening 
> 2:  Mary    55th St 132             running 

Это работает как шарм, за исключением того, что я хотел бы иметь:

1. два столбца для «адреса», по одному для каждого подэлемента -- скажем, address.street и address.number.
2. две колонки для хобби - скажем, хобби1 и хобби2. Важно отметить, что число детей может варьироваться.

В конце концов, у меня будет что-то вроде

Я бы также хотел придерживаться пакета xml2, если это возможно (поскольку у меня много файлов большого размера, а в пакете XML есть известные проблемы с памятью, которые становятся проблемой в моем случае).

Answer 1

Рассмотрим XSLT специальный декларативный язык (того же типа, что и SQL), предназначенный для преобразования файлов XML, например, для выравнивания исходного ввода. В R XSLT может быть запущен с сестринским пакетом для xml2: xslt. А поскольку это отраслевой язык, его можно запускать с другими языками общего назначения (например, Java, Python), CLI (Bash, PowerShell) или исполняемыми файлами (Saxon, Xalan), которые R может вызыватьв командной строке с помощью system().

library(xslt)

xsl <- '<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
  <xsl:output indent="yes"/>
  <xsl:strip-space elements="*"/>

  <xsl:template match="@*|node()">
    <xsl:copy>
      <xsl:apply-templates select="@*|node()"/>
    </xsl:copy>
  </xsl:template>

  <xsl:template match="text()">
    <xsl:value-of select="normalize-space()"/>
  </xsl:template>

  <xsl:template match="/*/*">
    <xsl:copy>
      <xsl:copy-of select="*[not(*)]"/>
      <xsl:apply-templates select="*"/>
    </xsl:copy>
  </xsl:template>

  <xsl:template match="/*/*/*">
      <xsl:apply-templates select="*"/>
  </xsl:template>

</xsl:stylesheet>'

См .: Демонстрация в режиме онлайн

Аналогично предыдущему процессу, но с шагом преобразования для создания new_pg :

# read in
pg <- read_xml(doc)
style <- read_xml(xsl, package = "xslt")

# transform original
new_pg <- xml_xslt(pg, style)

# make a list of records
recs <- xml_find_all(new_pg, "//rec")

# function to loop over list
extractRecord <- function(x) {      
  txt <- setNames(xml_text(xml_children(x)), 
                  xml_name(xml_children(x))
         )

  dt <- setDT(as.list(txt))[]
  return(dt)
}

# loop over list of records
lst <- lapply(recs, extractRecord)

# bind elements do a data table
dt <- rbindlist(lst, use.names = TRUE, fill = TRUE)
dt
#     name   street number     hobby       hobby
# 1:  John   2nd Av   1036    tennis   gardening 
# 2:  Mary  55th St    132   running        <NA>

Чтобы избежать повторения столбцов (т. Е. hobby ), добавьте этот шаблон в конце XSLT (перед закрытием </xsl:stylesheet>), где вы можете разделить по конвейеру любые другие известные вам столбцы. заранее появятся повторяющиеся столбцы:

  <!-- PIPE DELIMIT ANY REPEAT NAMED COLS IN TEMPLATE MATCH-->
  <xsl:template match="hobby|anothernode|othernode|stillothernode">
    <xsl:variable name="num" select="concat(name(), count(preceding-sibling::*)+1)"/>
    <xsl:element name="{$num}">
      <xsl:value-of select="normalize-space()"/>
    </xsl:element>  
  </xsl:template>

Answer 2

Итак, если вы открыты для использования tidyverse, вот подход. Сначала измените вашу функцию, чтобы извлечь все данные для отдельной записи:

library(tidyverse)

get_elements <- function(rec) {

  name = xml_find_all(rec, "name") %>% xml_text

  hobbies = xml_find_all(rec, "hobbies")
  hobby_list = hobbies %>% xml_find_all("hobby") %>% xml_text

  address = xml_find_all(rec, "address")
  street = address %>% xml_find_all("street") %>% xml_text
  street_num = address %>% xml_find_all("number") %>% xml_text

  df = tibble(
    name = str_squish(name),
    street = str_squish(street), 
    street_num = str_squish(street_num),
    hobbies = str_squish(hobby_list)
  )
  return(df)
}

Итак, теперь для любой данной записи (например, recs[1], recs[2]) мы возвращаем таблицу:

get_elements(recs[1])
#> # A tibble: 2 x 4
#>   name  street street_num hobbies  
#>   <chr> <chr>  <chr>      <chr>    
#> 1 John  2nd Av 1036       tennis   
#> 2 John  2nd Av 1036       gardening
get_elements(recs[2])
#> # A tibble: 1 x 4
#>   name  street  street_num hobbies
#>   <chr> <chr>   <chr>      <chr>  
#> 1 Mary  55th St 132        running

Затем скомбинируйте эти таблицы, используя ваш любимый метод:

res_df <- 
bind_rows(
  get_elements(recs[1]),
  get_elements(recs[2])
)

# More tidyverse/purrr-like:
res_df <- 
  recs %>%
  map_df(get_elements)

res_df
#> # A tibble: 3 x 4
#>   name  street  street_num hobbies  
#>   <chr> <chr>   <chr>      <chr>    
#> 1 John  2nd Av  1036       tennis   
#> 2 John  2nd Av  1036       gardening
#> 3 Mary  55th St 132        running

Наконец, сделайте несколько обработок данных, чтобы повернуть данные в желаемый конечный формат:

res_df %>% 
  group_by(name) %>%
  mutate(
    hobby_idx = paste0("hobby", row_number())
  ) %>%
  pivot_wider(
    names_from = hobby_idx,
    values_from = hobbies
  )
#> # A tibble: 2 x 5
#> # Groups:   name [2]
#>   name  street  street_num hobby1  hobby2   
#>   <chr> <chr>   <chr>      <chr>   <chr>    
#> 1 John  2nd Av  1036       tennis  gardening
#> 2 Mary  55th St 132        running <NA>