Estratégias para colheita de dados

Prof. Walmes Marques Zeviani

14 Mar 2017

Objetivo e justificativa

Download dos scripts R em ~walmes/ensino/ce089-2014-02/

library(XML)
library(RCurl)

urls <- "http://leg.ufpr.br/~walmes/ensino/ce089-2014-02/"

# Extrai os links dos elementos <a href></a>.
href <- getHTMLLinks(urls, relative = FALSE)

# Filtra só os com extensão R.
u <- grep("\\.R$", x = href, value = TRUE)
u <- paste0(urls, u)

# Abre a página.
browseURL(u[1])

# Baixa o arquivo.
download.file(u[1], destfile = basename(u[1]))

# Faça um laço para baixar todos os arquivos.

Download dos scripts R do GitLab

urls <- "https://gitlab.c3sl.ufpr.br/walmes/ce089/tree/master/scripts"
browseURL(urls)

# Extrai os links dos elementos <a href></a>.
href <- getHTMLLinks(getURL(urls))

# Seleciona aqueles na pasta script de extensão .R.
fls <- grep(".*/scripts/.*\\.R$", x = href, value = TRUE)

# Link para o raw dos arquivos.
raw <- "https://gitlab.c3sl.ufpr.br/walmes/ce089/raw/master/scripts/%s"

# Extraí só o nome dos arquivos e cria as url para o raw de cada.
bn <- basename(fls)
u <- sprintf(raw, bn)

# Abre a página.
browseURL(u[1])

# Faz o download do arquivo.
download.file(url = u[1], destfile = bn[1])

# Coloque o código dentro de um laço para baixar tudo.

Percorrendo páginas com resultados

Resultados da São Silvestre 2016

url <- "http://www.saosilvestre.com.br/resultados/"
browseURL(url)

# Clique sobre o botão "Feminino". Faça a análise da URL na página 1 e 2
# para verificar se está parametrizada na URL.

# http://www.yescom.com.br/codigo_comum/classificacao/
# codigo/p_classificacao03_v1.asp?evento_yescom_id=1689
# &tipo=4
# &tipo_do_evento_id=5131
# &PaginaAtual=2                <-- A página é parte da URL!
# &faixa=
# &sexo=M
# &campo=
# &pesquisa=

molde <- paste0("http://www.yescom.com.br/codigo_comum/",
                "classificacao/codigo/p_classificacao03_v1.asp?",
                "evento_yescom_id=1689&tipo=4&tipo_do_evento_id=5131",
                "&PaginaAtual=%d", # %d <-- Para trocar por números.
                "&faixa=&sexo=M&campo=&pesquisa=")

i <- 23
url <- sprintf(molde, i)

browseURL(url)

r <- readHTMLTable(url, which = 10)
length(r)

# Faça um for de 1 até 733 para extrair todas as tabelas.
inter <- 1:10
tab <- vector(mode = "list", length = length(inter))

# Laço.
for (i in inter) {
    cat("Lendo página", i, "\n")
    url <- sprintf(molde, i)
    tab[[i]] <- readHTMLTable(url, which = 10)
    # Sys.sleep()
}

# Desmonta a lista para empilhar as tabelas.
do.call(rbind, tab)

Múltiplas informações em coleções de elementos

Imóveis Web

# Apartamentos para comprar no centro de Curitiba.
url <- paste0("http://www.imovelweb.com.br/",
              "apartamentos-venda-centro-curitiba.html")
Figura 1: Printscreen da página inicial de anúncio de apartamentos para compra no centro do Curitiba no <http://www.imoveisweb.com.br>, com anotações sobre a imagem.

Figura 1: Printscreen da página inicial de anúncio de apartamentos para compra no centro do Curitiba no http://www.imoveisweb.com.br, com anotações sobre a imagem. 

h <- htmlParse(url)
summary(h)

# Exibe só o primeiro <li> da lista. Cole em um embelezador de HTML.
xpathApply(h, path = "//ul[@class = 'list-posts']/li[1]")

browseURL("http://www.cleancss.com/html-beautify/")
browseURL("https://dirtymarkup.com/")
Figura 2: Printscreen da página inicial de anúncio de apartamentos para compra no centro do Curitiba no <http://www.imoveisweb.com.br>, com anotações que indicam os elementos no código fonte correspondentes aos dados na página.

Figura 2: Printscreen da página inicial de anúncio de apartamentos para compra no centro do Curitiba no http://www.imoveisweb.com.br, com anotações que indicam os elementos no código fonte correspondentes aos dados na página. 

# Preço.
xpathSApply(h,
            path = paste0("//ul[@class = 'list-posts']/li",
                          "//span[@class = 'precio-valor  ']"),
            fun = xmlValue,
            trim = TRUE)

# Para remover caracteres de espaço em excesso (aprenda REGEX).
xmlvaltrim <- function(node, ...) {
    val <- xmlValue(node, ...)
    gsub("[[:space:]][[:space:]]+", " ", val)
}

# Endereço.
xpathSApply(h,
           path = paste0("//ul[@class = 'list-posts']/li",
                         "//div[@class = 'post-text-location']"),
           # fun = xmlValue,
           fun = xmlvaltrim,
           trim = TRUE)

# Características (informação não pareável).
xpathSApply(h,
            path = paste0("//ul[@class = 'list-posts']/li",
                          "//ul[@class = 'misc unstyled']/li"),
            fun = xmlvaltrim,
            trim = TRUE)

# O nome dos atributos.
xpathSApply(h,
            path = paste0("//ul[@class = 'list-posts']/li",
                          "//ul[@class = 'misc unstyled']/li"),
            fun = xmlAttrs)

# Extrai os atributos e valores gerando vetor nomeado.
xmlattrval <- function(node) {
    a <- xmlAttrs(node)
    a <- gsub("^misc-", "", a)
    v <- xmlvaltrim(node, trim = TRUE)
    names(v) <- a
    return(v)
}

xpathSApply(h,
            path = paste0("//ul[@class = 'list-posts']/li",
                          "//ul[@class = 'misc unstyled']/li[text()]"),
            fun = xmlattrval)

# É importante ser capaz de parear os valores para criar uma
# representação tabular.
# Fonte da solução depois de 1.5 hora de busca.
# http://stackoverflow.com/questions/14957632/r-xpathapply-on-xmlnodeset-with-xml-package

# Função de extração a partir do ponto "//ul[@class = 'list-posts']/li".
getInfo <- function(node) {
    node <- xmlDoc(node)
    preco <-
        xpathSApply(node,
                    path = "//span[@class = 'precio-valor  ']",
                    fun = xmlValue,
                    trim = TRUE)
    ender <-
        xpathSApply(node,
                    path = "//div[@class = 'post-text-location']",
                    fun = xmlvaltrim,
                    trim = TRUE)
    carac <-
        xpathSApply(node,
                    path = "//ul[@class = 'misc unstyled']/li[text()]",
                    fun = xmlattrval
                    # fun = xmlValue, trim = TRUE
                    )
    carac <- gsub("[[:space:]][[:space:]]+", " ", carac)
    res <- c(list(preco = preco, ender = ender), as.list(carac))
    return(as.data.frame(res, stringsAsFactors = FALSE))
}

L <- getNodeSet(h, path = "//ul[@class = 'list-posts']/li[position() < 3]")
xmlApply(L, FUN = getInfo)

a <- xpathApply(h,
                path = "//ul[@class = 'list-posts']/li",
                fun = getInfo)
do.call(plyr::rbind.fill, a)

Resumo

Próxima aula

Referências