R/index_data.R

#' Get Historical Data for a CFM Index
#'
#' Given a valid index code available, this function returns the corresponding historical data
#' for the specified period (\code{start_date} until \code{end_date}). The returned dataframe
#' includes Session, Value and Change columns
#'
#' @param index_code A character vector of length one. Use \code{get_indexes()} to list all
#' valid indexes in CFM
#' @param start_date A character vector of length one matching the format 'dd/mm/yyyy'
#' @param end_date A character vector of length one matching the format 'dd/mm/yyyy'
#'
#' @return data.frame
#'
#' @note The difference between \code{end_date} and \code{start_date} should be less than or
#' equal 3 years.
#'
#' @importFrom httr GET
#' @importFrom httr POST
#' @importFrom magrittr %>%
#' @importFrom magrittr %<>%
#' @importFrom rvest html_node
#' @importFrom rvest html_nodes
#' @importFrom rvest html_table
#' @importFrom rvest html_attr
#' @importFrom xml2 read_html
#' @importFrom stringr str_replace_all
#'
#' @export
#'
#' @examples
#' \dontrun{index_data('MASI', '01/01/2014', '31/12/2016')}
#' \dontrun{index_data('MADEX', '01/01/2017', '30/06/2017')}
#'
#'
index_data <- function(index_code, start_date, end_date) {

    validate_dates(start_date, end_date)

    request <- GET(URL_INDEXES, add_headers('User-Agent' = 'Mozilla'))

    view_state <- request %>%
        read_html() %>%
        html_node(xpath = VIEW_STATE_XPATH) %>%
        html_attr('value')

    params <- list(
        '__EVENTTARGET' = 'IndiceHistorique1$LinkButton1',
        '__VIEWSTATE' = view_state,
        'IndiceHistorique1$historique' = 'RBSearchDate',
        'IndiceHistorique1$DDLIndice' = index_code,
        'IndiceHistorique1$DateTimeControl1$TBCalendar' = start_date,
        'IndiceHistorique1$DateTimeControl2$TBCalendar' = end_date
    )

    response <- POST(URL_INDEXES, body = params, add_headers('User-Agent' = 'Mozilla'))

    table <- response %>%
        read_html() %>%
        html_table() %>%
        .[[1]]

    names(table) <- table[1, ]
    table %<>% tail(n = -1L)

    table %<>% sapply(function(x) str_replace_all(x, ',', '.')) %>%
        as.data.frame(stringsAsFactors = FALSE)

    table$Session %<>% as.Date('%d/%m/%Y')
    table$Value %<>% as.numeric()
    table$Change %<>% as.numeric()

    return(table)

}
blnash508/cfm documentation built on May 30, 2019, 4:31 p.m.