R/sabesp.R

In jtrecenti/sabesp: Baixa dados da sabesp

#' Baixa dados da sabesp
#' 
#' Baixa dados da sabesp sobre volume armazenado, pluviometria do dia, 
#' pluviometria acumulada no mês e média histórica do mês.
#' 
#' @param datas vetor de datas (Date ou character vector)
#' 
#' @return \code{data.frame com resultados}
#' 
#' @examples
#' \dontrun{
#' dados <- baixa_sabesp_dias('2015-05-06')
#' datas <- lubridate::today() - months(0:10)
#' dados2 <- baixa_sabesp_dias(datas)
#' }
#' @export
baixa_sabesp_dias <- function(datas) {
  baixa_sabesp_dia <- function(data) {
    link <- 'http://www2.sabesp.com.br/mananciais/DivulgacaoSiteSabesp.aspx'
    txt <- httr::GET(link)
    viewstate <- txt %>% 
      httr::content('text') %>% 
      xml2::read_html() %>% 
      rvest::html_node('#__VIEWSTATE') %>% 
      rvest::html_attr('value')
    eventval <- txt %>% 
      httr::content('text') %>% 
      xml2::read_html() %>% 
      rvest::html_node('#__EVENTVALIDATION') %>% 
      rvest::html_attr('value')
    data <- as.Date(data)
    dados <- list(cmbDia = lubridate::day(data), 
                  cmbMes = lubridate::month(data), 
                  cmbAno = lubridate::year(data), 
                  Imagebutton1.x = '0', 
                  Imagebutton1.y = '0', 
                  '__VIEWSTATE' = viewstate, 
                  '__EVENTVALIDATION' = eventval)
    r <- httr::POST(link, body = dados)
    
    nomes <- r %>% 
      httr::content('text') %>% 
      xml2::read_html() %>% 
      rvest::html_nodes('img') %>% 
      rvest::html_attr('src') %>% 
      purrr::keep(~stringr::str_detect(.x, '\\.gif$')) %>% 
      purrr::map_chr(~stringr::str_match(.x, '/(.+)\\.gif')[, 2])
    
    d <- r %>% 
      httr::content('text') %>% 
      xml2::read_html() %>% 
      rvest::html_node('#tabDados') %>% 
      rvest::html_table(fill = TRUE) %>%
      dplyr::select(titulo = X1, info = X2) %>%
      dplyr::filter(titulo != '') %>%
      dplyr::mutate(lugar = rep(nomes, each = 4)) %>% 
      dplyr::mutate(info = stringr::str_extract(info, '[\\-0-9, %m]+$'),
                    info = stringr::str_replace_all(info, '^[^:]+:', ''), 
                    info = stringr::str_replace_all(info, ',', '.'), 
                    info = stringr::str_replace_all(info, '[^0-9.\\-]', ''),
                    info = as.numeric(info)) %>% 
      dplyr::tbl_df()
    return(d)
  }
  f <- dplyr::failwith(dplyr::data_frame, baixa_sabesp_dia)
  datas %>% 
    as.character() %>% 
    {dplyr::data_frame(data = .)} %>% 
    dplyr::group_by(data) %>% 
    dplyr::do(f(.$data)) %>%
    dplyr::ungroup() %>% 
    dplyr::mutate(data = as.Date(data))
}