R/utils.R

In mbannert/pgsqltsmap: Map S4 class based time series to a PostgreSQL database

#' Create single line data.frame from time series
#' 
#' This function creates single line data.frames from time series 
#' that can be bound together and processed by dbWriteTable. This function
#' is a helper function for \code{\link{create_db_table}} and is not meant 
#' to be used as a standalone function.
#' 
#' @author Matthias Bannert
#' @param Obj time series object or name of time series object
#' @param type character based flag, either main or meta. Should localized 
#' meta information or main data be generated. 
#' @param meta_env_name character name of the environment that stores the
#' metainformation
create_df_lines <- function(Obj,type="main",meta_env_name = "meta",
                            vintage_key=NA_character_){
  if(is.character(Obj)){
    nm <- Obj
    Obj <- get(Obj)
  } 
  mi_key <- attr(Obj,"mi_key")
  # throw an error if there is no key attribute
  if(is.null(mi_key)){
    stop_statement <- paste("There is no meta information attached to this object.
Storing to archive is not allowed without meta information.",
                            sep="")
    stop(stop_statement)
  }
  
  
  if(type == "main"){
    data_hstore <- create_hstore(Obj)
    ### create data.frame with fixed information
    ts_main <- data.frame(ts_key = mi_key,
                          ts_data = data_hstore,
                          md_frequency = get(meta_env_name)[[mi_key]]$ts_frequency,
                          md_generated_by = get(meta_env_name)[[mi_key]]$ts_edited_by,
                          md_generated_on = get(meta_env_name)[[mi_key]]$ts_edited_on,
                          md_legacy_key = get(meta_env_name)[[mi_key]]$ts_legacy_key,
                          md_source = get(meta_env_name)[[mi_key]]$ts_source,
                          md_notes = get(meta_env_name)[[mi_key]]$ts_comment,
                          md_restrictions = get(meta_env_name)[[mi_key]]$ts_restrictions)
    # return
    ts_main
  } else if(type == "meta"){
    
    if(length(ls(get(meta_env_name)[[mi_key]]$ts_localized_mi)) != 0){
      # create data.frame for localized meta information
      meta_localized_hstore <- create_hstore(get(meta_env_name)[[mi_key]]$ts_localized_mi) 
      # just got to add ts_key and language name to a data.frame
      meta_localized <- data.frame(ts_key = mi_key,
                                   ts_language = names(meta_localized_hstore),
                                   ts_labels = t(as.data.frame(meta_localized_hstore)),
                                   stringsAsFactors = F
      )  
      # return
      meta_localized
      }
    } else if(type == "vintage"){
      # throw an exception if there's no vintage key specified.
      if(is.na(vintage_key)){
        stop("No vintage key specified. Can't prepare entry for vintage
database.")
      }
      # prepare data.frame for use with dbWriteTable.
      vintage_hstore <- create_hstore(Obj)
      vintage <- data.frame(ts_key = mi_key,
                            vintage_key = vintage_key,
                            vintage_data = vintage_hstore)
      #return
      vintage
    } else {
    stop("invalid type, only 'main','vintage' or 'meta' allowed.")
  } 
  
}


#' Create Table From Time Series
#' 
#' This function creates a data.frame that mimmicks the 
#' the database tables. 
#'
#' @param ts_keys character vector containing all series name.  
#' @param type character based flag, either main or meta. Should localized 
#' meta information or main data be generated. 
#' @param meta_env_name character name of the environment that stores the
#' meta information
#' @author Matthias Bannert
#' @note Write a better version of this function that supports objects and 
#' object names(just like its helper function). Currently ts_keys only supports
#' character vectors.
create_db_table <- function(ts_keys,type="main",
                            meta_env_name = meta_env_name,...){
  vintage_key <- unlist(list(...))
  out <- ldply(ts_keys,create_df_lines,type=type,
               vintage_key=vintage_key)
  out
}