---
title: "Manuseio de arquivos XML com o R"
subtitle: "Uso do `xml2` e `XML`"
author: "[Walmes Marques Zeviani](http://leg.ufpr.br/~walmes)"
output:
  # rmdformats::html_clean:
  rmdformats::readthedown:
    #theme: yeti
    highlight: haddock
    fig_caption: yes
    fig_align: center
---

<!-- TODO http://uribo.github.io/rpkg_showcase/index.html -->

# Usando o pacote `xml2`

## XML como string

  * Não é uma situação muito realista.
  * Mas é viável quando o documento é curto.
  * Ou para fins didáticos.

```{r, message = FALSE}
library(tidyverse)
library(xml2)
ls("package:xml2")
```

  * O pacote [`xml2`] é uma interface em R para a [`libxml2`].
  * A [`libxml2`] é uma biblioteca em C.
  * Tem recursos para *parsing* de arquivos XML/HTML, acesso por meio de
    expressões XPath, dentre outros recursos.
  * É usada por diversas outras linguagens, como Python e R.
  * Para acesso ao código fonte, visite o [repositório da `libxml2`].

```{r}
text <- '<?xml version="1.0"?>
<catalog>
   <book id="bk101">
      <author>Gambardella, Matthew</author>
      <title>XML Developer\'s Guide</title>
      <genre>Computer</genre>
      <price>44.95</price>
      <publish_date>2000-10-01</publish_date>
      <description>An in-depth look at creating applications
      with XML.</description>
   </book>
   <book id="bk102">
      <author>Ralls, Kim</author>
      <title>Midnight Rain</title>
      <genre>Fantasy</genre>
      <price>5.95</price>
      <publish_date>2000-12-16</publish_date>
      <description>A former architect battles corporate zombies,
      an evil sorceress, and her own childhood to become queen
      of the world.</description>
   </book>
</catalog>'

# Exame/análise.
doc <- read_xml(text)
doc

# Estrutura.
str(doc)

# Classe e métodos disponíveis.
class(doc)
methods(class = "xml_document")
methods(class = "xml_node")

# Funções extratoras.
xml_name(doc)
xml_length(doc)

# Ponteiros.
str(doc[[1]])

# Atributos do documento.
xml_attrs(doc)

# Extração de conteúdo com XPath.
xml_find_all(doc, xpath = ".//author")
xml_find_all(doc, xpath = ".//author/text()")

# Caminho absoluto único para cada nó.
xml_find_all(doc, xpath = ".//author") %>%
    xml_path()

# Extração dos autores.
xml_find_all(doc, xpath = ".//author") %>%
    xml_text()

# Extração dos preços.
xml_find_all(doc, xpath = ".//price") %>%
    xml_double()

# Extração dos atributos dos nós filho.
xml_children(doc) %>%
    xml_attrs()

# As funções acima geram um objecto de classe `xml_nodeset`. Um
# `xml_nodeset` é uma lista de `xml_node`.
ns <- xml_children(doc)
str(ns)

# Classe e métodos.
class(ns)
methods(class = "xml_nodeset")

# Nem sempre essas expressões XPath serão equivalentes.
ns %>% xml_find_all(xpath = "./author")
ns %>% xml_find_all(xpath = ".//author")
ns %>% xml_find_all(xpath = "//author")
```

## Importação - catálogo botânico

  * A `xml2::read_xml()` lida com requisições HTTP básicas assim como a
    maioria de funções de importação do R.
  * Com os argumentos opcionais é possível especificar *encoding* e
    demais aspectos para importação do arquivo.

```{r}
# Importação de um arquivo XML.
url <- "https://www.w3schools.com/Xml/plant_catalog.xml"
doc <- read_xml(url)

# Classe e métodos disponíveis.
class(doc)
methods(class = "xml_document")
methods(class = "xml_node")

xml_name(doc)
xml_url(doc)
xml_length(doc)
xml_structure(doc)

# Extração do nome das plantas.
xml_find_all(doc, xpath = ".//COMMON") %>%
    xml_text()

# Extração com tratamento dos preços.
xml_find_all(doc, xpath = ".//PRICE") %>%
    xml_text() %>%
    str_replace("\\$", "") %>%
    as.numeric()

# Remover o preço da primeira planta.
doc %>%
    xml_find_first(xpath = ".//PRICE") %>%
    xml_remove()

xml_ch <- xml_children(doc)
length(xml_ch)

# Caminhos absolutos e únicos.
xml_ch %>%
    xml_path()

# Extrai todo o conteúdo mas concatena.
xml_ch %>%
    xml_text()

# Só os nomes comuns das plantas.
xml_ch %>%
    xml_find_first(xpath = "./COMMON") %>%
    xml_text()

# Os preços.
# IMPORTANT: é retornado NA quando a referência não é encontrada.
xml_ch %>%
    xml_find_first(xpath = "./PRICE") %>%
    xml_text()

# O NA não aparece aqui.
xml_ch %>%
    xml_find_all(xpath = "./COMMON|./PRICE") %>%
    xml_text()
```

## Importação - Liga da Justiça

```{r}
# Importação de um arquivo XML.
url <- "../data/justice-league.xml"
doc <- read_xml(url)
head(doc)

xml_name(doc)
xml_url(doc)
xml_length(doc)
xml_structure(doc)

# Cria a lista que aponta para cada resultado.
doc_ch <- xml_children(doc)

# Extrai o atributo `title`.
doc_ch %>%
    xml_attr(attr = "title")

# Extrai o ano.
doc_ch %>%
    xml_attr(attr = "year")

# Extrai o tipo.
doc_ch %>%
    xml_attr(attr = "type")

# Extrai todos os atributos do primeiro child.
doc_ch[[1]] %>%
    xml_attrs() %>%
    cbind()

# Extrai o título apenas dos que possuem atributo `poster`.
doc %>%
    xml_find_all(xpath = "./result[@poster]") %>%
    xml_attr(attr = "title")

# Extrai o título apenas dos que são `type = "movie"`.
doc %>%
    xml_find_all(xpath = "./result[@type = 'movie']") %>%
    xml_attr(attr = "title")

# Que o título comece com `Lego`.
doc %>%
    xml_find_all(xpath = "./result[starts-with(@title, 'Lego')]") %>%
    xml_attr(attr = "title")

# Que o título contenha `Lego`.
doc %>%
    xml_find_all(xpath = "./result[contains(@title, 'Lego')]") %>%
    xml_attr(attr = "title")
```

## Importação - endereços

  * [Nominatim] é uma API do OpenStreetMap de busca de endereços.
  * A que é usada no código abaixo retorna informações geográficas para
    um termo de busca como latitude e longitude.

```{r}
url <- paste0("http://nominatim.openstreetmap.org/search",
              "?q=2300, Rua Brigadeiro Franco, Curitiba, BR&format=xml")
# browseURL(URLencode(url))

url <- paste0("http://nominatim.openstreetmap.org/search",
              "?q=UFPR, Curitiba, BR&format=xml")

# Importação.
doc <- read_xml(URLencode(url))

# Propriedades e estrutura.
xml_url(doc)
xml_name(doc)
xml_length(doc)
xml_structure(doc)

# Extrai todos os atributos.
u <- doc %>%
    xml_find_all(xpath = "./place") %>%
    xml_attrs()

# Converções até chegar em tibble.
u <- u %>%
    map(as.list) %>%
    map(as.tibble)

# Empilha.
u <- invoke(bind_rows, u)

# Conversão para valor numérico.
u <- u %>%
    mutate_at(c("lat", "lon"), as.numeric)

# Coordenadas.
u %>%
    select(lat, lon, display_name)

# ggplot(u, aes(lon, lat)) +
#     geom_point()
```

## Importação - abalos sísmicos

  * O [U.S. Geological Survey](https://earthquake.usgs.gov) é um site
    americano que registra eventos sísmicos.
  * Ele possui um servido de API para aquisição em tempo real e consulta
    a dados históricos.

```{r}
# Quantos eventos sismicos no dia 02/02/2018?
# Retorna o número de eventos para no intervalo fornecido.
url <- paste0("https://earthquake.usgs.gov/fdsnws/event/1/",
              "count?",      # <-- tipo de serviço.
              "format=xml&", # <-- formato de saída.
              "starttime=2018-02-02T00:00:00&",
              "endtime=2018-02-03T00:00:00")
# browseURL(url)

# Detalhes das ocorrências no intervalo fornecido.
url <- paste0("https://earthquake.usgs.gov/fdsnws/event/1/",
              "query?",      # <-- informação detalhada.
              "format=xml&",
              "starttime=2018-02-02T00:00:00&",
              "endtime=2018-02-03T00:00:00")

# download.file(url, destfile = "../data/earth-quakes-2018-02-02.xml")
# browseURL(url)

# doc <- read_xml(url)
doc <- read_xml("../data/earth-quakes-2018-02-02.xml")

# Propriedades.
doc %>% xml_name()
doc %>% xml_url()
doc %>% xml_length()

# Para fazer exame dos nós de dados.
doc_event <- doc %>%
    xml_child() %>%
    xml_child()

doc_event %>% xml_name()
doc_event %>% xml_length()
doc_event %>% xml_structure()
doc_event %>% xml_children() %>% xml_name()

# Consulta um evento.
doc %>%
    xml_find_first(".//event")

# Esse documento tem namespace. Precisa ser removido para prosseguir.
doc %>%
    xml_ns_strip()

# Consulta um evento depois de remover namespace.
doc %>%
    xml_find_first(".//event")

# Extração de latitude, longitude e magnitude.
da <- list()
da$lat <- doc %>%
    xml_find_all(xpath = ".//event/origin/latitude/value") %>%
    xml_double()
da$lon <- doc %>%
    xml_find_all(xpath = ".//event/origin/longitude/value") %>%
    xml_double()
da$mag <- doc %>%
    xml_find_all(xpath = ".//event/magnitude/mag/value") %>%
    xml_double()

# Converte para tibble.
da <- da %>%
    invoke(.f = bind_cols)
da

ggplot(da, aes(x = lon, y = lat, size = mag)) +
    geom_point(pch = 19, alpha = 0.25)
```

<!---------------------------------------------------------------------- -->

# Usando o pacote `XML`

```{r}
library(XML)
packageVersion("XML")
ls("package:XML")
```

## XML como string

```{r}
text <- '<?xml version="1.0"?>
<catalog>
   <book id="bk101">
      <author>Gambardella, Matthew</author>
      <title>XML Developer\'s Guide</title>
      <genre>Computer</genre>
      <price>44.95</price>
      <publish_date>2000-10-01</publish_date>
      <description>An in-depth look at creating applications
      with XML.</description>
   </book>
   <book id="bk102">
      <author>Ralls, Kim</author>
      <title>Midnight Rain</title>
      <genre>Fantasy</genre>
      <price>5.95</price>
      <publish_date>2000-12-16</publish_date>
      <description>A former architect battles corporate zombies,
      an evil sorceress, and her own childhood to become queen
      of the world.</description>
   </book>
</catalog>'

doc <- xmlParse(text)
str(doc)

class(doc)
methods(class = "XMLInternalDocument")
methods(class = "XMLAbstractDocument")

# Propriedades.
docName(doc)
xmlSize(doc)
summary(doc)

# Para ver o documento. Cuidado com documentos grandes.
show(doc)

# Conversões.
xmlToList(doc)
xmlToDataFrame(doc)

# Aponta para a raíz do documento.
doc_root <- xmlRoot(doc)
str(doc_root)

class(doc_root)
methods(class = "XMLInternalElementNode")
methods(class = "XMLInternalNode")

xmlAttrs(doc_root)
xmlValue(doc_root)

# Aplica uma função no `children` do `root`.
xmlApply(doc_root, FUN = xmlAttrs)
xmlSApply(doc_root, FUN = xmlAttrs)

# O operador `[[` pode ser usado.
doc_root[[1]] %>% xmlAttrs()
doc_root[[2]] %>% xmlAttrs()

# Posição e nome de tag podem ser passados.
doc_root[[1]][[1]] %>% xmlValue()
doc_root[[1]][["author"]] %>% xmlValue()
doc_root[[1]][[2]] %>% xmlValue()
doc_root[[1]][["title"]] %>% xmlValue()

# Expressões XPath.
xpathSApply(doc_root, path = "./book", fun = xmlAttrs)
xpathSApply(doc_root, path = "./book/author", fun = xmlValue)
```

## Importação - catálogo botânico

```{r}
# Importação de um arquivo XML.
url <- "https://www.w3schools.com/Xml/plant_catalog.xml"
doc <- xmlParse(readLines(url))
summary(doc)

doc %>% xmlSize()

# Aponta para a raíz do documento. Classe XML.*Node.
doc_root <- xmlRoot(doc)

# Extração de conteúdo com XPath.
xpathSApply(doc, path = "//COMMON", fun = xmlValue)
xpathSApply(doc_root, path = ".//COMMON", fun = xmlValue)
xpathSApply(doc_root, path = ".//PRICE", fun = xmlValue) %>%
    str_replace("\\$", "") %>%
    as.numeric()

# Remove o preço da primeira planta para ver como lidar com missing
# estrutural.
doc_root[[1]][["PRICE"]]
removeChildren(doc_root[[1]], "PRICE")
doc_root[[1]][["PRICE"]]

# Retorna 36 elementos.
xpathSApply(doc_root, path = ".//COMMON", fun = xmlValue)

# Retorna 35 elementos. Aqui não retorna o NA. Então tem que tratar o
# missing manualmente.
xpathSApply(doc_root, path = ".//PRICE", fun = xmlValue)

# Mas é possível criar funções que operem nos nós. Aí se faz
# interessante o uso do `[[` que permite manter valores agrupados.
xpathApply(doc_root,
           path = "./PLANT",
           fun = function(node) {
               # Usando o `[[`.
               tibble(commom = xmlValue(node[["COMMON"]]),
                      price = xmlValue(node[["PRICE"]]))
           }) %>%
    invoke(.f = bind_rows)

xpathApply(doc_root,
           path = "./PLANT",
           fun = function(node) {
               # Usando expressões XPath.
               u <- xpathSApply(node,
                                path = "./COMMON",
                                fun = xmlValue)
               v <- xpathSApply(node,
                                path = "./PRICE",
                                fun = xmlValue)
               tibble(commom = u,
                      price = ifelse(length(v), v, NA))
           }) %>%
    invoke(.f = bind_rows)

# OBS: quando o que precisa ser extraído está como children, o uso do
# `[[` é mais interessante. Se o que tiver de ser consultado estiver em
# profundidade variável, então é mais simples usar expressão XPath.

# ATTENTION: nas duas versões acima, quando um elemento não é
# encontrado, esteja atento para a sutil diferença quanto ao que é
# retornado:
#
#   1. xmlValue(node[["PRICE"]])
#      : retorna vetor com NA.
#   2. xpathSApply(node, path = "./PRICE", fun = xmlValue)
#      : retorna uma lista vazia, ou seja, list().

# Cria lista de nós. -> XMLInternalNodeList.
doc_ch <- xmlChildren(doc_root)
class(doc_ch)

methods(class = "XMLInternalNodeList")
methods(class = "XMLNodeList")

length(doc_ch)
class(doc_ch[[1]])

# Extração dos preços.
sapply(doc_ch,
       FUN = function(node) {
           xmlValue(node[["PRICE"]])
       })

# Cria lista de nós. -> XMLNodeSet.
doc_ns <- getNodeSet(doc_root, path = "./PLANT")
class(doc_ns)

methods(class = "XMLNodeSet")

length(doc_ns)
class(doc_ns[[1]])

# xmlSApply opera em XMLNodeSet.
xmlSApply(doc_ns,
          FUN = function(node) {
              xmlValue(node[["PRICE"]])
          })
```

## Importação - Liga da Justiça

```{r}
# Importação de um arquivo XML.
url <- "../data/justice-league.xml"

doc <- xmlParse(url, asText = FALSE)
summary(doc)

doc_root <- xmlRoot(doc)

xpathSApply(doc_root, path = "./result",
            fun = xmlGetAttr, name = "title")
xpathSApply(doc_root, path = "./result",
            fun = xmlGetAttr, name = "year")
xpathSApply(doc_root, path = "./result",
            fun = xmlAttrs)

xpathSApply(doc_root,
            path = "./result[@poster]",
            fun = xmlGetAttr,
            name = "title")
xpathSApply(doc_root,
            path = "./result[@type = 'movie']",
            fun = xmlGetAttr,
            name = "title")
xpathSApply(doc_root,
            path = "./result[starts-with(@title, 'Lego')]",
            fun = xmlGetAttr,
            name = "title")
xpathSApply(doc_root,
            path = "./result[contains(@title, 'Lego')]",
            fun = xmlGetAttr,
            name = "title")
```

## Importação - endereços

```{r}
url <- paste0("http://nominatim.openstreetmap.org/search",
              "?q=2300, Rua Brigadeiro Franco, Curitiba, BR&format=xml")
# browseURL(URLencode(url))

url <- paste0("http://nominatim.openstreetmap.org/search",
              "?q=UFPR, Curitiba, BR&format=xml")

doc <- xmlParse(readLines(URLencode(url)))
summary(doc)

doc_root <- xmlRoot(doc)

u <- xpathSApply(doc_root,
                 path = "./place",
                 fun = xmlAttrs)

# Converções até chegar em tibble.
u <- u %>%
    map(as.list) %>%
    map(as.tibble)

# Empilha.
u <- invoke(bind_rows, u)
u

u <- u %>%
    mutate_at(c("lat", "lon"), as.numeric)

u %>%
    select(lat, lon, display_name)
```

## Importação - abalos sísmicos

```{r}
# Quantos eventos sismicos no dia 02/02/2018?
# Retorna o número de eventos para no intervalo fornecido.
url <- paste0("https://earthquake.usgs.gov/fdsnws/event/1/",
              "count?",      # <-- tipo de serviço.
              "format=xml&", # <-- formato de saída.
              "starttime=2018-02-02T00:00:00&",
              "endtime=2018-02-03T00:00:00")
# browseURL(url)

# Detalhes das ocorrências no intervalo fornecido.
url <- paste0("https://earthquake.usgs.gov/fdsnws/event/1/",
              "query?",      # <-- informação detalhada.
              "format=xml&",
              "starttime=2018-02-02T00:00:00&",
              "endtime=2018-02-03T00:00:00")
# browseURL(url)

# # ATTENTION: A `readLines()` não é a melhor opção para arquivos grandes.
# txt <- readLines(url)
# doc <- htmlParse(txt)
# summary(doc)
# saveXML(doc = doc, file = "../data/earth-quakes-2018-02-02.xml")

doc <- xmlParse("../data/earth-quakes-2018-02-02.xml")
summary(doc)

# Aponta para a raíz.
doc_root <- xmlRoot(doc)

doc_event <- doc_root[[1]][[1]][[1]][[1]]
doc_event <- doc_root[[1]][[1]]
doc_event %>% xmlName()
doc_event %>% xmlSize()
doc_event %>% xmlChildren() %>% names()

doc_event %>% xmlNamespace()
doc_event %>% xmlValue()

xmlNamespace(doc_root)
getDefaultNamespace(doc_root)
# removeXMLNamespaces(doc_root, all = TRUE)

# Para contornar o uso de namespaces.
ns <- getDefaultNamespace(doc)[[1]]$uri
names(ns)[1] <- "xmlns"

# Extrai as coordenadas e magnitude.
xpathApply(doc_root,
           path = "//xmlns:event",
           namespaces = ns,
           fun = function(node) {
               tibble(
                   lat = xmlValue(node[["origin"]][["latitude"]][["value"]]),
                   lon = xmlValue(node[["origin"]][["longitude"]][["value"]]),
                   mag = xmlValue(node[["magnitude"]][["mag"]][["value"]]))
           }) %>%
    invoke(.f = bind_rows)

# ATTENTION: um código que vai para produção deve conter tratamentos de
# excessão para valores ausentes e outras anomalias. Esses códigos tem
# fins didáticos e não possuem o adequado tratamento de excessão.
```

<!------------------------------------------- -->
[repositório da `libxml2`]: https://gitlab.gnome.org/GNOME/libxml2
[`libxml2`]: http://www.xmlsoft.org/
[`xml2`]: https://cran.r-project.org/package=xml2
[Nominatim]: https://nominatim.openstreetmap.org/

```{r, include = FALSE, eval = FALSE}
# doc <- xmlInternalTreeParse("../data/earth-quakes-2018-02-02.xml")
doc <- xmlParse("../data/earth-quakes-2018-02-02.xml")

ns <- getDefaultNamespace(doc)[[1]]$uri
names(ns)[1] <- "xmlns"

getNodeSet(doc, "//xmlns:event", namespaces = ns)

xpathSApply(doc,
           "//xmlns:latitude/xmlns:value",
           namespaces = ns,
           xmlValue)


```
