R/derived_catalog_do.R

In fognyc/bindr: Tools for Binding Raw Times-Series Hosted on Remote Site Into a Synchronized Factor Data Set

#' Performs 'do' operations on the internal catalog of derived factors.
#'
#' The function takes a string argument representing an operation to be
#' performed on a catalog of factors. The qualifier \emph{derived} indicates
#' that the catalog pertains to \strong{derived factors}, which are built from
#' so-called \emph{parent factors}. Note that the catalog can't be modified by
#' the user as it is \strong{defined internally} to protect its integrity and
#' that its existence is checked before implementing the selected command
#' operator.
#'
#' The internal catalog is used primarily to encode and maintain the parameters
#' required to build each derived factor, which belongs to an \emph{algebraic}
#' or \emph{econometric} category. The first category includes two (and possibly
#' more) \emph{parent factors} which are combined \emph{via} an algebraic
#' formula. A typical example would be the US Treasury term spread
#' (\emph{derived} factor) expressed as the yield difference between a
#' long-dated and a short-dated maturity (\emph{parent} factors). The second
#' category includes any number of \emph{parent factors} which are transformed
#' by an econometric or statistical procedure (\emph{e.g.} moving average,
#' fitted values from a regression model, \emph{etc}).
#'
#' The underlying catalog structure is a \emph{register} object using the
#' infrastructure developed in the package \pkg{registry}, which is endowed
#' with:
#'
#' \itemize{ \item Registry creator \item Matching functions \item Registry
#' object functions (\emph{e.g.} get_entries, get_fields, \emph{etc}) }
#'
#' It is important to note that the function and its underlying catalog have two
#' additional purposes. First it provides a wrapper for a selected number of
#' \pkg{registry} native functions, allowing a user unfamiliar with the
#' \pkg{registry} framework to access the catalog with simple and intuitive
#' function calls. Second, the building process is governed by the function
#' \code{build_derived_factor(...)}, which in turn has an internal gatekeeper.
#' Prior to the building procedure, the requested factor must be confirmed as a
#' valid catalog entry. This general framework tightly controls the building
#' process specific to each factor and prevents the unintended manufacturing of
#' additional derived factors.
#'
#' From a broader perspective, the internal object \emph{bindr::derived_catalog}
#' is to the function \code{bindr::build_derived_factor} what
#' \emph{factorr::catalog} is to the function \code{factorr::fetch}. Each
#' catalog in its respective package provides the underlying engine from which
#' their associated functions inherit some functional behavior. Thus both
#' packages (\pkg{factorr}, \pkg{bindr}) have a common structural thread.
#'
#' The function behaves differently under different operators, which is a
#' primitive form of function polymorphism. Each operator comes in the form of a
#' verb closely matching the intended operation. The command operator \code{get}
#' returns a copy of the catalog (a \emph{register} object), so that a user
#' familiar with the package \pkg{registry} can extensively search/filter the
#' catalog along any field. For additional details on how to manipulate and
#' query registry objects, please consult the \pkg{registry} package
#' documentation, and in particular the \emph{regobj} Help Page. See also the
#' \pkg{registry} package vignette from \insertCite{Meyer;textual}{bindr}
#'
#' The argument \emph{arg_supp} is required to support the command operator
#' \emph{validate_entry}, but is otherwise ignored. The argument must be of the
#' from \code{arg_supp = list(hdl = < string >, region = <string>, frequency = <
#' string >)}. Deviation from this form, either in object type, cardinality or
#' ordinality generates an error. The operator \emph{validate_entry} internally
#' verifies that the unique key formed by \emph{hdl}, \emph{region} and
#' \emph{frequency} maps to an existing entry.
#'
#' @param operation A string object, representing a command operator.
#' @param arg_supp A named list with items \emph{hdl}, \emph{region} and
#'   \emph{frequency} to support the command operator \emph{validate_entry}. See
#'   details.
#' @return \item{Integer}{Operator \code{count} returns the number of catalog
#'   entries.} \item{printout}{Operator \code{fields} prints to console every
#'   registry field and their associated attributes.} \item{Registry
#'   object}{Operator \code{get} returns the underlying registry object
#'   supporting the catalog structure.} \item{printout}{Operator \code{keys}
#'   prints to console all unique keys formed by \emph{hdl}, \emph{region} and
#'   \emph{frequency}.} \item{printout}{Operator \code{show} prints to console
#'   the entire catalog (\emph{i.e.} all entries).} \item{Tibble
#'   object}{Operator \code{src_hdl} prints a tibble of source handles
#'   associated with valid catalog entries. Useful with
#'   \code{bindr::assemble_factor()}} \item{entry/NULL}{Operator
#'   \code{validate_entry} return a valid catalog entry (as a named list),
#'   otherwise returns NULL if the parameters in \emph{arg_supp} do not map to a
#'   valid catalog entry.}
#'
#' @references{\insertAllCited{}}
#'
#' @examples
#' \dontrun{
#'
#' View the entire derived catalog:
#'
#'    derived_catalog_do(operation = 'show')
#'
#' Validate a derived catalog entry:
#'
#'    derived_catalog_do(operation = 'validate_entry',
#'                       arg_supp = list(hdl = 'TERM',
#'                                       region = 'US',
#'                                       frequency = 'M'))
#'
#' }
#'
#' @importFrom rlang .data
#' @importFrom magrittr "%>%"
#'
#' @export

derived_catalog_do <- function(operation = c('count', 'fields',
                                             'get', 'keys', 'show',
                                             'src_hdl', 'validate_entry'),
                               arg_supp = list()){

  if( !exists('derived_catalog') ){
    stop(stringr::str_glue("Object 'derived_catalog' does not exist."),
         call. = T)
  }

  if (!is.character(operation)) {
    stop('Argument operation must be a character.', call. = T)
  } else {
    operation <- match.arg(operation)
  }

  # Validate arg_supp
  if(operation == 'validate_entry'){
    if(length(arg_supp) != 3){
      err_msg <- stringr::str_glue(
        'Incorrect number of supplementary arguments.',
        " 'arg_supp' must be a named list with 'hdl', 'region' and 'frequency'.",
        ' Unable to validate entry.')
      stop(err_msg, call. = T)
    }
    if(!all(names(arg_supp) == c('hdl', 'region', 'frequency'))){
      err_msg <- stringr::str_glue(
        "'arg_supp' must be a named list with 'hdl', 'region' and 'frequency'.",
        ' Unable to validate entry.'
      )
      stop(err_msg, call. = T)
    }
  }

  if(operation == 'src_hdl'){
    key <- derived_catalog$get_entry_names()
    handles <- purrr::map_df(.x = key, .f = function(.){
      if(stringr::str_detect(string = ., pattern = 'INFLATION') == T){
        psn <- stringr::str_locate(string = .,
                                   pattern = '_[A-Z,-]{1,30}_[A-Z]{1}')
        psn.start <- psn[1]
        psn.end <- psn[2]
        str <- stringr::str_sub(string = .,
                                start = 1, end = psn.start - 1)
        str1 <- stringr::str_glue(str, '__naive_',
                                  stringr::str_sub(string = .,
                                                   start = psn.start,
                                                   end = psn.end))
        str2 <- stringr::str_glue(str, '__timeSeries_',
                                  stringr::str_sub(string = .,
                                                   start = psn.start,
                                                   end = psn.end))
        str3 <- stringr::str_glue(str, '__treasuryBills_',
                                  stringr::str_sub(string = .,
                                                   start = psn.start,
                                                   end = psn.end))
        tibble::tibble (src_hdl = c(str1, str2, str3))
      } else {
        tibble::tibble (src_hdl = .)
      }
    })
    remove(key)
  }

  return(
    switch(
      operation,
      count = derived_catalog$n_of_entries(),
      fields = derived_catalog$get_fields(),
      get = derived_catalog,
      keys = derived_catalog$get_entry_names(),
      show = derived_catalog$get_entries(),
      src_hdl = handles,
      validate_entry = derived_catalog$get_entry(hdl = arg_supp$hdl,
                                                 region = arg_supp$region,
                                                 frequency = arg_supp$frequency)
      )
    )

}