R/database_handler.R

In alejandro-sotolongo/pbi:

#' #' @title Download time-series from FRED api
#' #'
#' #' @import jsonlite
#' #'
#' #' @param ticker String of financial time-series ticker, e.g., 'DSG1'
#' #' @param try_mode Boolean to catch download errors
#' #'
#' #' @return data.frame with time-series data
#' #' @export
#' downloadFred <- function(ticker, try_mode = TRUE) {
#'   url <- paste0("https://fred.stlouisfed.org/series/", ticker, "/downloaddata/",
#'                 ticker, ".csv")
#'   temp_file <- tempfile()
#'   on.exit(unlink(temp_file))
#'   download.file(url, temp_file)
#'   if (try_mode) {
#'     d <- try(read.csv(temp_file, na.strings = "."))
#'   } else {
#'     d <- read.csv(temp_file, na.strings = ".")
#'     d <- d %>%
#'       mutate(DATE = as.Date(DATE))
#'     return(d)
#'   }
#'
#'   if (class(d)[1] == "try-error") {
#'     return(ticker)
#'   } else {
#'     d <- d %>%
#'       mutate(DATE = as.Date(DATE))
#'     return(d)
#'   }
#' }
#'

#' @import R6
#' @import reticulate
#' @import jsonlite
#' @export
DataMgmt <- R6Class(

  classname = 'DataMgmt',

  public = list(
    arctic_lib = NULL,
    tiingo_api = NULL,

    initialize = function(arctic_lib = NA, store = NA, tiingo_api = NA) {
      if (!is.na(arctic_lib)) {
        arctic_lib <- self$setArcticLib(arctic_lib, store)
      }
      self$arctic_lib <- arctic_lib
      self$tiingo_api <- tiingo_api
    },

    setArcticLib = function(arctic_lib_name, store = NA) {
      arctic <- try(reticulate::import('arctic'))
      if (class(arctic)[1] == 'try-error') {
        stop('unable to load \'arctic\'')
      }
      if (is.na(store)) {
        store <- arctic$Arctic('localhost')
      }
      arctic_lib <- try(store$get_library(arctic_lib_name))
      if (class(arctic_lib)[1] == 'try-error') {
        stop(paste0('unable to load ', arctic_lib_name))
      }
      self$arctic_lib <- arctic_lib
    },

    downloadTiingo = function(ticker, try_mode = TRUE) {
      tapi <- self$tiingo_api
      if (is.na(tapi)) {
        stop('need to set Tiingo API before downloading from Tiingo.')
      }
      url <- paste0(
        'https://api.tiingo.com/tiingo/daily/',
        ticker,
        '/prices?startDate=1970-1-1&endDate=',
        Sys.Date(),
        '&token=',
        tapi
      )

      if (try_mode) {
        d <- try(jsonlite::fromJSON(url), silent = TRUE)
      } else {
        d <- jsonlite::fromJSON(url)
        d <- d %>%
          mutate(date = as.Date(date))
        return(d)
      }

      if (class(d)[1] == 'try-error') {
        return(ticker)
        print(paste0(ticker, ' not downloaded.'))
      } else {
        print(paste0(ticker, ' downloaded.'))
        d <- d %>%
          mutate(date = as.Date(date))
        return(d)
      }
    },

    downloadFrench5 = function(ticker = "ff_5", skip = 3, try_mode = TRUE) {
      url <- paste0("http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/",
                    "F-F_Research_Data_5_Factors_2x3_daily_CSV.zip")
      temp_file <- tempfile()
      on.exit(unlink(temp_file))
      download.file(url, temp_file)

      if (try_mode) {
        d <- try(self$cleanFrench5(temp_file, skip))
      } else {
        d <- self$cleanFrench5(temp_file, skip)
        return(d)
      }

      if (class(d)[1] == "try-error") {
        return(ticker)
        print('could not clean fama-french 5 factors')
      } else {
        print('downloaded fama-french 5 factors')
        return(d)
      }
    },

    cleanFrench5 = function(temp_file, skip) {
      d <- unzip(temp_file) %>% read.csv(skip = skip)
      colnames(d)[1:2] <- c("Date", "RMRF")
      d[, 2:7] <- d[, 2:7] / 100
      date_vec <- as.character(d[, 1]) %>% as.Date(format = "%Y%m%d")
      d[, 1] <- date_vec
      return(d)
    },

    addNewItem = function(metadata, try_mode = TRUE) {
      if (is.null(metadata$data_source)) {
        stop('must supply data_source')
      }
      if (toupper(metadata$data_source) == 'TIINGO') {
        d <- self$downloadTiingo(metadata$ticker, try_mode)
      } else if(toupper(metadata$data_source) == 'FF5') {
        d <- self$downloadFrench5(try_mode = try_mode)
      } else {
        d <- NULL
      }
      self$arctic_lib$write(metadata$key_id, d, metadata)
    },

    updateItem = function(key_id, try_mode = TRUE) {
      if (!key_id %in% self$arctic_lib$list_symbols()) {
        stop('key_id not found.')
      }
      item <- self$arctic_lib$read(key_id)
      if (toupper(item$metadata$data_source) == 'TIINGO') {
        d <- self$downloadTiingo(key_id, try_mode)
      } else if (toupper(meta_data$data_source) == 'FF5') {
        d <- self$downloadFrench5(try_mode = try_mode)
      } else {
        d <- NULL
      }
      self$arctic_lib$write(key_id, d, item$metadata)
    },

    metadataFromCsv = function(csv_file, add_new_item = FALSE, try_mode = TRUE) {
      metadf <- read.csv(csv_file, stringsAsFactors = FALSE)
      metalst <- list()
      for (i in 1:nrow(metadf)) {
        metalst[[i]] <- sapply(metadf[i, ], list)
      }
      if (add_new_item) {
        lapply(metalst, self$addNewItem, try_mode = try_mode)
      }
      return(metalst)
    },

    setMetadata = function(
      key_id = NULL,
      name = NULL,
      ticker = NULL,
      data_source = NULL,
      asset_class = NULL,
      strategy = NULL,
      benchmark = NULL,
      vehicle = NULL,
      geography = NULL,
      country = NULL,
      backfill = NULL,
      freq = NULL,
      is_return = NULL,
      net_rf = NULL
    ) {
      # need asset_class, strategy, etc tables to control entry
      metadata <- list(
        key_id = key_id,
        name = name,
        ticker = ticker,
        data_source = data_source,
        asset_class = asset_class,
        strategy = strategy,
        benchmark = benchmark,
        vehicle = vehicle,
        geography = geography,
        country = country,
        freq = freq,
        is_return = is_return,
        net_rf = net_rf
      )
      return(metadata)
    }
  )
)