R/tlyfunctions.R

In transparentlyai/tlyrfunctions: Functions for Transparently.ai

# R functions for Transparently.ai

library(odbc)
library(yaml)
library(bigrquery)
library(readr)

tly_version <- '0.1.9.8'

# loading user environment and config file
tly_user_home <- Sys.getenv("HOME")
tly_config_file <-
  paste(tly_user_home, "/.tlyconfig.yml", sep = "")

if (file.exists(tly_config_file)) {
  tly_config_content <- read_file(tly_config_file)

  # get the yaml configuration
  tlyconfig <- read_yaml(tly_config_file)

  # version and information
  tly_info <- function() {
    writeLines(
      paste(
        "\ntlyrfunctions ver: ",
        tly_version ,
        "\n  configuration file:",
        tly_config_file,
        "\n"
      )
    )
    writeLines(tly_config_content, sep = "\n")
  }

  # connect to refinitiv server
  tly_ref_conn <- dbConnect(
    odbc(),
    Driver = tlyconfig$refconfig$driver,
    Server = tlyconfig$refconfig$server,
    Database = tlyconfig$refconfig$database,
    UID = tlyconfig$refconfig$user,
    PWD = tlyconfig$refconfig$password,
    Authentication = tlyconfig$refconfig$authentication,
    TrustServerCertificate = tlyconfig$refconfig$trustcertificate,
    Port = tlyconfig$refconfig$port
  )

  # prepare connection to bigquery
  tly_bq_conn <- dbConnect(bigrquery::bigquery(),
                           project = tlyconfig$bqconfig$project)
  bq_auth(path <- tlyconfig$bqconfig$credential_file)

  #' Refinitiv query function
  #'
  #' queries the refinitiv sql server using the connection configuration
  #' see tly_version() for details
  #' @param sql sql string
  #' @param format can be either 'dataframe' or 'list'
  #' @return data.dataframe if format is 'dataframe' or list if format is 'list'
  #' @export
  query_ref <- function(sql, format = "dataframe") {
    result <- dbGetQuery(tly_ref_conn, sql)
    if (format == "list") {
      return(result)
    }
    if (format == "dataframe") {
      return(as.data.frame(result))
    }
  }

  #' Bigquery query function
  #'
  #' queries the bigquery database using the connection configuration
  #' see tly_version() for details
  #' @param sql sql string
  #' @param format can be either 'dataframe' or 'list'
  #' @param n_max Maximum number of results to retrieve. Use Inf to retrieve all rows.
  #' @param page_size The number of rows requested per chunk. It is recommended to leave this unspecified until you have evidence that the page_size selected automatically by bq_table_download() is problematic. When page_size = NULL bigrquery determines a conservative, natural chunk size empirically. If you specify the page_size, it is important that each chunk fits on one page, i.e. that the requested row limit is low enough to prevent the API from paginating based on response size.
  #' @param quiet If FALSE, displays progress bar; if TRUE is silent; if NA displays progress bar only for long-running jobs.
  #' @param retry Number of times to retry if the download fails. With each retry the waiting time increases 2^t
  #' @return data.dataframe if format is 'dataframe' or list if format is 'list'
  #' @export
  query_bq <- function(sql,
                       format = "dataframe",
                       n_max = Inf,
                       page_size = Inf,
                       retry = 6,
                       quiet = FALSE) {
    table <- bq_project_query(tlyconfig$bqconfig$project, query = sql)
    wait_retry <- 1
    for (i in 1:retry) {
      try({
        result <- bq_table_download(table,
                                    n_max = n_max,
                                    page_size = page_size,
                                    quiet = quiet)
        break
      }, silent = FALSE)
      print(paste('Attempt ', i, 'failed. retrying in ', wait_retry, 'seconds'))
      Sys.sleep(wait_retry)
      wait_retry = 2 ^ i
    }
    if (!(exists("result"))) {
      stop("\nUnable to download data ...  Aborting")
    }

    if (format == "list") {
      return(result)
    }

    if (format == "dataframe") {
      return(as.data.frame(result))
    }
  }

  #' Bigquery upload function
  #'
  #' uploads a data.frame to a bigquery table
  #' @param dataframe the dataframe containing the data to be uploaded
  #' @param destination the dentination dataset and table as 'dataset.table'
  #' @param if_exists use 'replace' to overwrite an existing table, 'fail' to abort.
  #' @param description add a short description to the table in BQ
  #' @return data.dataframe if format is 'dataframe'
  #' @return list if format is 'list'
  #' @export
  dataframe_to_bq <- function(dataframe,
                              destination,
                              if_exists = "fail",
                              description = '',
                              quiet = FALSE) {
    destination_split <- strsplit(destination, "\\.")
    dataset_id <- destination_split[[1]][1]
    table_id <- destination_split[[1]][2]
    table_ <-
      bq_table(tlyconfig$bqconfig$project, dataset_id, table = table_id)

    if (bq_table_exists(table_)) {
      if (if_exists == "fail") {
        stop(
          paste(
            "Destination: '",
            destination,
            "' already exists. Use if_exist='replace' to overwrite"
          )
        )
      }
      if (if_exists == "replace") {
        bq_table_delete(table_)
      }
    }
    bq_table_create(table_, as_bq_fields(dataframe), description = description)
    bq_table_upload(table_, dataframe, quiet = quiet)
  }
} else {
  print(
    paste(
      "WARNING: No config file found at",
      tly_config_file,
      "xreate one and relaod the library"
    )
  )
}
#' Saves currently list of packages as a CSV
#' @param filename destination file
save_packages <- function(filename) {
  installed <- as.data.frame(installed.packages())
  write.csv(installed, filename)
}

#' re-installs packages listed in a CSV file.
#' @param filename source file
restore_packages <- function(filename) {
  installedPreviously <- read.csv(filename)
  baseR <- as.data.frame(installed.packages())
  toInstall <- setdiff(installedPreviously, baseR)
  install.packages(toInstall, dependencies = TRUE)
}