R/adjusted_data.R

#' Get Historical Data with Adjusted Prices
#'
#' Given a valid stock name listed in CFM, this function returns the corresponding financial
#' data including the ADJUSTED PRICES for the specified period
#' (\code{start_date} until \code{end_date}). The returned dataframe includes SEANCE,
#' COURS_CLOTURE, COURS_AJUSTE, EVOLUTION, QUANTITE_ECHANGE and VOLUME
#'
#' @param stock_name A character vector of length one. Use \code{get_stocks()} to list all valid
#' stocks names listed 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 An R 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 xml2 read_html
#' @importFrom rvest html_node
#' @importFrom rvest html_attr
#' @importFrom rvest html_table
#' @importFrom magrittr %>%
#' @importFrom magrittr %<>%
#' @importFrom stringr str_replace_all
#' @importFrom utils tail
#'
#' @export
#'
#' @examples
#' \dontrun{adjusted_data('COSUMAR', '01/01/2014', '31/12/2016')}
#' \dontrun{adjusted_data('ATLANTA', '01/01/2017', '30/06/2017')}
#'
adjusted_data <- function(stock_name, start_date, end_date) {

    validate_dates(start_date, end_date)

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

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

    stock_value <- get_stocks_helper(request, with_values = TRUE) %>%
        .[stock_name]

    params <- list(
        '__VIEWSTATE' = view_state,
        '__EVENTTARGET' = 'HistoriqueNegociation1$HistValeur1$LinkButton1',
        'HistoriqueNegociation1$HistValeur1$historique' = 'RBSearchDate',
        'HistoriqueNegociation1$HistValeur1$DDValeur' = stock_value,
        'HistoriqueNegociation1$HistValeur1$DateTimeControl1$TBCalendar' = start_date,
        'HistoriqueNegociation1$HistValeur1$DateTimeControl2$TBCalendar' = end_date
    )

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

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

    names(data_table) <- data_table[1, ]

    data_table %<>% tail(n = -1L)

    f <- function(x) {
        str_replace_all(x, ',', '.')
    }

    data_table %<>% sapply(f) %>% as.data.frame(stringsAsFactors = FALSE)

    colnames(data_table)[1] <- 'SEANCE'

    data_table$SEANCE %<>% as.Date('%d/%m/%Y')
    data_table$COURS_CLOTURE %<>% as.numeric()
    data_table$COURS_AJUSTE %<>% as.numeric()
    data_table$EVOLUTION %<>% as.numeric()
    data_table$QUANTITE_ECHANGE %<>% as.integer()
    data_table$VOLUME %<>% as.numeric()

    return(data_table)

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