Transformar scrapping em função

Olá pessoal,

Estou mexendo no código do srapping que vocês ajudaram a fazer na live de web scrapping para colocar todo esse código dentro de uma função, retornando a tabela final.

Editei bastante coisa depois que obtém a tabela de dados, mas não tenho experiência usando o POST e tal.
Feito o POST, é salvo um arquivo .html na pasta do projeto, que logo depois é utilizado na função rvest::read_html() para buscar os dados.
Tem como fazer isso direto sem salvar o arquivo na pasta?

Código:

search_cas_species <- function(species, path = getwd()) {
  
  url <- "https://researcharchive.calacademy.org/research/ichthyology/catalog/fishcatmain.asp"
  page_initial <- httr::GET(url)
  content_initial <- httr::content(page_initial)
  
  POST_safe <- purrr::safely(httr::POST)
  
  data_cas_species <- list(
    "tbl" = "Species",
    "contains" = species,
    "Submit" = "Search"
  )
  
  if(!dir.exists(path)) dir.create(path)
  
  species_clean <- stringr::str_replace_all(species, '[:blank:]', '_')
  html_name <- paste0(species_clean, ".html")
  html_path <- file.path(path, html_name)
  
#Aqui o arquivo é salvo
  search_page <- POST_safe(
    url = url,
    body = data_cas_species,
    encode = "form"
    write_disk(html_path, overwrite = TRUE)
  )
  
  return(html_name)
}

respostas <- search_cas_species("Cichla")

#Aqui o arquivo é utilizado
html <- respostas %>%
  rvest::read_html() %>%
  xml2::xml_find_all(".//p[@class='result']") %>%
  `[`(-1) %>%
  `[`(c(FALSE, TRUE))

tabela <- tibble(
  cas_info = xml2::xml_text(html),
  raw_species = html %>% xml2::xml_find_first("b") %>% xml2::xml_text(),
  species = paste(str_extract_all(raw_species, "(?<=\\, )(\\w).+"),
                    str_extract_all(raw_species, "((\\w).+(?=\\, ))")),
  autorship = str_extract(cas_info, paste0("(?<=",raw_species," ).+?(ref. [:digit:]+])")),
  past_valid_names = str_extract_all(cas_info, "(?<=•Valid as )(\\w+) (\\w+)"),
  past_synonym_names = str_extract_all(cas_info, "(?<=•Synonym of )(\\w+) (\\w+)"),
  current_status = str_extract(cas_info, "(?<=Current status: ).+?(?=\\.)"),
  family = str_match(cas_info, "(?<=Current status:[^\\.]{0,100}\\. ).+?(?=(\\:)|\\.)"),
  subfamily = ifelse(is.na(family),NA,str_match(cas_info, paste0("(?<=",family,": )\\w+"))),
  holotype = str_extract(cas_info, "(?<=Holotype: ).+?(?=\\.)"),
  paratype = str_extract(cas_info, "(?<=Paratype: ).+?(?=\\.)"),
  paralectotype = str_extract(cas_info, "(?<=Paralectotypes: ).+?(?=\\.)"),
  type_catalog = str_extract(cas_info, "(?<=Type catalog: ).+(?=\\]\\.)\\]"),
  type_locality = str_extract(cas_info, "(?<=ref. [:digit:]{1,6}] ).+?(?=[:alpha:]\\.)[:alpha:]"),
  type_coordinates = str_extract(cas_info, "((\\d{1,3})°(\\d{2})[:punct:](\\d{2}).+(\\d{1,3})°(\\d{2})[:punct:](\\d{2}).\\w)|
            ((\\d{1,3})°(\\d{2}).+(\\d{1,3})°(\\d{2})[:punct:].\\w)"),
  type_basin = str_extract(cas_info, "(([:alpha:]+\\s)+(?=basin))\\w+"),
  habitat = str_extract(cas_info, "(?<=Habitat: ).+?(?=\\.)"),
  distribution = str_extract(cas_info, "(?<=Distribution: ).+?(?=\\.)"),
  ) %>% 
  select(-raw_species) %>% 
  unnest(col = c(past_valid_names,past_synonym_names), keep_empty = TRUE)

Bruno,

Você só precisa tirar o write_disk() de dentro do POST(). É essa função que está salvando o arquivo e, sem ela, o HTML é retornado diretamente.

Para fazer tudo funcionar, basta substituir a sua search_cas_species() pela versão abaixo. Eu removi todo o código que gera o nome do arquivo que seria salvo e retornei search_page$result ao invés de só search_page (isso é necessário por causa do safely() lá em cima).

search_cas_species <- function(species) {
  
  url <- "https://researcharchive.calacademy.org/research/ichthyology/catalog/fishcatmain.asp"
  page_initial <- httr::GET(url)
  content_initial <- httr::content(page_initial)
  
  POST_safe <- purrr::safely(httr::POST)
  
  data_cas_species <- list(
    "tbl" = "Species",
    "contains" = species,
    "Submit" = "Search"
  )
  
  search_page <- POST_safe(
    url = url,
    body = data_cas_species,
    encode = "form"
  )

  search_page$result
}

Não sei se fiz algo errado, mas aqui o search_page$result está retornando NULL para mim, mesmo fora da função…

Exemplo do código fora da função

url <- "https://researcharchive.calacademy.org/research/ichthyology/catalog/fishcatmain.asp"

page_initial <- httr::GET(url)

content_initial <- httr::content(page_initial)

POST_safe <- purrr::safely(httr::POST)

data_cas_species <- list(
  "tbl" = "Species",
  "contains" = "Cichla",
  "Submit" = "Search"
)

search_page <- POST_safe(
  url = url,
  body = data_cas_species,
  encode = "form"
)

search_page$result

Bruno, pra mim esse código está funcionando :confused:

url <- "https://researcharchive.calacademy.org/research/ichthyology/catalog/fishcatmain.asp"

page_initial <- httr::GET(url)

content_initial <- httr::content(page_initial)
#> No encoding supplied: defaulting to UTF-8.

POST_safe <- purrr::safely(httr::POST)

data_cas_species <- list(
  "tbl" = "Species",
  "contains" = "Cichla",
  "Submit" = "Search"
)

search_page <- POST_safe(
  url = url,
  body = data_cas_species,
  encode = "form"
)

search_page$result
#> Response [https://researcharchive.calacademy.org/research/ichthyology/catalog/fishcatmain.asp]
#>   Date: 2022-06-28 19:54
#>   Status: 200
#>   Content-Type: text/html
#>   Size: 55 kB
#> 
#> 
#> <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
#>             "http://www.w3.org/TR/html4/loose.dtd">
#> <html>
#> <head>
#>    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
#>    <meta name="GENERATOR" content="Mozilla/4.75 [en] (Win98; U) [Netscape]">
#> 
#> 
#> ...

Created on 2022-06-28 by the reprex package (v2.0.1)

Que estranho. Substituí o POST_safe pelo POST padrão e aparece esse erro:

url <- "https://researcharchive.calacademy.org/research/ichthyology/catalog/fishcatmain.asp"

page_initial <- httr::GET(url)

content_initial <- httr::content(page_initial)
#> No encoding supplied: defaulting to UTF-8.

POST_safe <- purrr::safely(httr::POST)

data_cas_species <- list(
  "tbl" = "Species",
  "contains" = "Cichla",
  "Submit" = "Search"
)

search_page <- httr::POST(
  url = url,
  body = data_cas_species,
  encode = "form"
)
#> Error in curl::curl_fetch_memory(url, handle = handle): Failure when receiving data from the peer

Testei no meu PC tbm e tive o mesmo resultado que o Bruno. Tentei até usar o pacote {polite} por via das dúvidas e, apesar de ele dizer que é possível fazer scrap no site, o resultado foi negativo.

1 curtida

Talvez seja algum problema do Windows com o encoding ou de proxy. Não consigo imaginar uma razão para o mesmo código não estar funcionando em dois computadores.

Pelo o que conversei com o Julio, o erro parece ser isso aqui: https://github.com/jeroen/curl/issues/262

Como eu queria colocar esse scrapping em uma função de pacote, teria que funcionar nas 3 plataformas…