---
title: "Web scraping do Imovel Web com R"
subtitle: "Uso do `xml2`"
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
---

# Importação da página

```{r}
rm(list = objects())

library(xml2)
library(magrittr)

url <- "https://www.imovelweb.com.br/apartamentos-venda-curitiba-pr.html"

path <- paste0("../data/", basename(url))
if (file.exists(path)) {
    doc <- read_html(path)
} else {
    doc <- read_html(url)
    write_html(doc, file = path)
}

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

# Cuidado, o resultado é grande.
# xml_structure(doc)
```

# Validação das expressões XPath

```{r}
# Depois de aferir a expressão XPath no navegador para identificar os
# imóveis válidos, aplicar cada uma.

# Função para eliminar os espaços em excesso.
clean_spaces <- function(x) {
    gsub(x = trimws(x),
         pattern = "[[:space:]]+",
         replacement = " ")
}

# Extração dos anúncios.
xpath_imovel <- "//li[contains(@data-tipoaviso, 'Clasificados')]"

# É uma lista com cada imóvel.
doc_imovel <- xml_find_all(doc, xpath = xpath_imovel)
length(doc_imovel)

# Extração do ID do imóvel.
doc_imovel %>%
    xml_attr(attr = "data-aviso")

# Extração do preço.
xpath_price <- ".//span[@class = 'aviso-data-price-value']"
doc_imovel %>%
    xml_find_first(xpath = xpath_price) %>%
    xml_text()

# Extração do endereço.
xpath_loc <- ".//span[@class = 'aviso-data-location dl-aviso-link']"
doc_imovel %>%
    xml_find_first(xpath = xpath_loc) %>%
    xml_text() %>%
    clean_spaces()

# Extração das características.
xpath_features <- ".//li[@class = 'aviso-data-features-value']"
doc_imovel %>%
    xml_find_all(xpath = xpath_features) %>%
    xml_text() %>%
    clean_spaces()

# NOTE: dessa forma os valores ficam desagrupados, o que é ruim. Os
# valores de um mesmo imóvel precisam ser mantidos juntos (integridade).

# Divide elementos `ul` de cada imóvel que contem os `li`.
xpath_ul_features <- ".//ul[@class = 'aviso-data-features dl-aviso-link']"
u <- doc_imovel %>%
    xml_find_all(xpath = xpath_ul_features)
u

# Extração das características dentro de cada imóvel.
xpath_li_features <- "./li[@class = 'aviso-data-features-value']"
lapply(u,
       FUN = function(ul) {
           ul %>%
               xml_find_all(xpath = xpath_li_features) %>%
               xml_text() %>%
               clean_spaces()
       })
```

# Extração dos dados

```{r}
#-----------------------------------------------------------------------
# Agora as expressões XPath já foram validadas. Então pode-se desenhar a
# extração coletiva dos dados. Tenha cuidado com páginas que são
# grandes. Elas irão precisar de código feito com bastante eficiência
# para gestão de memória.

# Expressões XPath já calibradas.
xpath_loc <- ".//span[@class = 'aviso-data-location dl-aviso-link']"
xpath_price <- ".//span[@class = 'aviso-data-price-value']"
xpath_li_features <- ".//li[@class = 'aviso-data-features-value']"

# Fazendo dentro de cada imóvel os dados que que são de um valor, ou
# seja, não são vetores, são "escalares".
scl <- lapply(doc_imovel,
              FUN = function(imovel) {
                  id <- imovel %>%
                      xml_attr(attr = "data-aviso")
                  price <- imovel %>%
                      xml_find_first(xpath = xpath_price) %>%
                      xml_text()
                  loc <- imovel %>%
                      xml_find_first(xpath = xpath_loc) %>%
                      xml_text() %>%
                      clean_spaces()
                  data.frame(id = id,
                             price = price,
                             loc = loc,
                             stringsAsFactors = FALSE)
              })
scl

# Extraindo as características que foram um vetor (de comprimento
# variável) para cada imóvel.
vec <- lapply(doc_imovel,
              FUN = function(imovel) {
                  id <- imovel %>%
                      xml_attr(attr = "data-aviso")
                  features <- imovel %>%
                      xml_find_all(xpath = xpath_li_features) %>%
                      xml_text() %>%
                      clean_spaces()
                  data.frame(id = id,
                             features = features,
                             stringsAsFactors = FALSE)
                 })
vec

# IMPORTANT: o ID é extraído em ambas porque é a chave primária para
# fazer o pareamento da informação das duas tabelas.
```

# Organização e armazenamento

```{r}
#-----------------------------------------------------------------------
# Estruturação dos resultados.

library(tidyverse)

# Empilha em uma só tabela.
scl <- invoke(bind_rows, scl) %>%
    as_tibble()
vec <- invoke(bind_rows, vec) %>%
    as_tibble()

# Formata o preço do imóvel como número.
scl <- scl %>%
    mutate(price = {
        price %>%
            str_replace("R\\$", "") %>%
            parse_number(locale = locale(grouping_mark = ".",
                                         decimal_mark = ","))
    })

# TODO: Trabalhar para esparramar na horizontal as características.

# Vetor vazio para ir recebendo o tipo de característica.
vec$feat <- ""

# Formata a área útil para numérico.
i <- vec$features %>%
    str_detect("m² Útil")
vec$feat[i] <- "area"
vec$features[i] <- vec$features[i] %>%
    str_replace("m² Útil", "") %>%
    trimws()

# Formata o número de quartos para numérico.
i <- vec$features %>%
    str_detect("Quartos?")
vec$feat[i] <- "quartos"
vec$features[i] <- vec$features[i] %>%
    str_replace("Quartos?", "") %>%
    trimws()

# Formata o número de banheiros para numérico.
i <- vec$features %>%
    str_detect("Banheiros?")
vec$feat[i] <- "banheiros"
vec$features[i] <- vec$features[i] %>%
    str_replace("Banheiros?", "") %>%
    trimws()

vec$features <- vec$features %>%
    as.numeric()

# Desamontoa da vertical e esparrama na horizontal.
vec <- vec %>%
    spread(key = "feat", value = "features")
vec

# Junta as duas tabelas de dados.
imo <- inner_join(x = vec, y = scl, by = "id")

# Visualização da relação entre as variáveis.
ggplot(data = imo,
       mapping = aes(x = area,
                     y = price,
                     size = quartos)) +
    geom_smooth(method = "lm",
                color = "orange",
                show_guide = FALSE) +
    geom_point() +
    scale_x_log10() +
    scale_y_log10() +
    labs(x = "Área (m²)",
         y = "Preço (R$)",
         size = "Quartos") +
    theme(legend.position = c(0.05, 0.95),
          legend.justification = c(0, 1))

# Escreve TSV em disco.
fl <- paste("../data", sub("\\.html", ".txt", basename(url)))
write_tsv(imo, path = fl)
```

# Informações da sessão

```{r, echo = FALSE}
cat(format(Sys.time(), format = "%A, %d de %B de %Y, %H:%M"),
    "----------------------------------------", sep = "\n")
devtools::session_info()
```
