R/stock_data.R

#' Get a CFM Stock Historical Data
#'
#' Given a valid stock name listed in CFM, this function returns the corresponding financial
#' data for the specified period (\code{start_date} until \code{end_date}). The returned
#' dataframe includes Session, Reference price, Last price, +Intraday high, + Intraday low
#' Number of shares traded and Capitalisation columns
#'
#' @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 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{stock_data('COSUMAR', '01/01/2014', '31/12/2016')}
#' \dontrun{stock_data('ATLANTA', '01/01/2017', '30/06/2017')}
#'
#'
stock_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,
        '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'))

    table <- response %>%
        read_html() %>%
        html_nodes(xpath = '//*[@id="arial11bleu"]') %>%
        .[[3]] %>%
        html_table() %>%
        .[, seq(2, 16, by = 2)]

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

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

    table %<>% sapply(function(x) str_replace_all(x, '\u00C2', '')) %>%
        as.data.frame(stringsAsFactors = FALSE)  ## unicode for 'Â'

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

    table$`+Intraday high` %<>% str_replace_all('-', 'NAN')
    table$`+ Intraday low` %<>% str_replace_all('-', 'NAN')

    table$Session %<>% as.Date('%d/%m/%Y')
    table$`Reference price` %<>% as.numeric()
    table$`Last price` %<>% as.numeric()
    table$`+Intraday high` %<>% as.numeric()
    table$`+ Intraday low`%<>% as.numeric()
    table$`Number of shares traded` %<>% as.integer()
    table$Capitalisation %<>% as.numeric()

    return(table)

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