getSymbols.PostgreSQL

DESCRIPTION

@@ -9,7 +9,7 @@ Authors@R: c(
   person(given="Wouter", family="Thielen", role="ctb")
   )
 Depends: xts(>= 0.9-0), zoo, TTR(>= 0.2), methods
-Suggests: DBI,RMySQL,RSQLite,timeSeries,its,XML,downloader
+Suggests: DBI,RMySQL,RPostgreSQL,RSQLite,timeSeries,its,XML,downloader
 Description: Specify, build, trade, and analyse quantitative financial trading strategies.
 LazyLoad: yes
 License: GPL-3

NAMESPACE

@@ -250,6 +250,7 @@ export(
     loadSymbols,
     getSymbols,
     getSymbols.MySQL,
+    getSymbols.PostgreSQL,
     getSymbols.SQLite,
     getSymbols.mysql,
     getSymbols.FRED,

R/getSymbols.R

@@ -149,7 +149,7 @@ formals(loadSymbols) <- loadSymbols.formals
 #         stop(paste("package:",dQuote('RBloomberg'),"cannot be loaded."))
 #       }
 #       bbconn <- blpConnect()
-#       for(i in 1:length(Symbols)) {
+#       for(i in seq_along(Symbols)) {
 #           bbsym <- paste(Symbols[[i]],bb.suffix)
 #
 #           if(verbose) {
@@ -238,7 +238,7 @@ function(Symbols,env,return.class='xts',index.class="Date",
 
      tmp <- tempfile()
      on.exit(unlink(tmp))
-     for(i in 1:length(Symbols)) {
+     for(i in seq_along(Symbols)) {
        return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
        return.class <- ifelse(is.null(return.class),default.return.class,
                               return.class)
@@ -327,7 +327,7 @@ function(Symbols,env,return.class='xts',index.class="Date",
           stop("package:",dQuote("XML"),"cannot be loaded.")
 
         yahoo.URL <- "http://info.finance.yahoo.co.jp/history/"
-        for(i in 1:length(Symbols)) {
+        for(i in seq_along(Symbols)) {
             # The name of the symbol, which will actually be used as the
             # variable name. It needs to start with YJ, and it will be appended
             # if it does not.
@@ -483,7 +483,7 @@ function(Symbols,env,return.class='xts',
 
      tmp <- tempfile()
      on.exit(unlink(tmp))
-     for(i in 1:length(Symbols)) {
+     for(i in seq_along(Symbols)) {
        Symbols.name <- getSymbolLookup()[[Symbols[[i]]]]$name
        Symbols.name <- ifelse(is.null(Symbols.name),Symbols[[i]],Symbols.name)
        if(verbose) cat("downloading ",Symbols.name,".....\n\n")
@@ -558,7 +558,7 @@ function(Symbols,env,return.class='xts',
                 warning(paste('could not load symbol(s): ',paste(missing.db.symbol,collapse=', ')))
                 Symbols <- Symbols[Symbols %in% db.Symbols]
         }
-        for(i in 1:length(Symbols)) {
+        for(i in seq_along(Symbols)) {
             if(verbose) {
                 cat(paste('Loading ',Symbols[[i]],
                     paste(rep('.',10-nchar(Symbols[[i]])),collapse=''),
@@ -627,7 +627,7 @@ function(Symbols,env,return.class='xts',
                 warning(paste('could not load symbol(s): ',paste(missing.db.symbol,collapse=', ')))
                 Symbols <- Symbols[Symbols %in% db.Symbols]
         }
-        for(i in 1:length(Symbols)) {
+        for(i in seq_along(Symbols)) {
             if(verbose) {
                 cat(paste('Loading ',Symbols[[i]],paste(rep('.',10-nchar(Symbols[[i]])),collapse=''),sep=''))
             }
@@ -654,6 +654,73 @@ function(Symbols,env,return.class='xts',
 "getSymbols.mysql" <- getSymbols.MySQL
 # }}}
 
+# getSymbols.PostgreSQL {{{
+"getSymbols.PostgreSQL" <- function(Symbols,env,return.class='xts',
+                               db.fields=c('date','o','h','l','c','v','a'),
+                               field.names = NULL,
+                               user=NULL,password=NULL,dbname=NULL,host='localhost',port=5432,options="",search_path=NULL,
+                               ...) {
+     importDefaults("getSymbols.PostgreSQL")
+     this.env <- environment()
+     for(var in names(list(...))) {
+        # import all named elements that are NON formals
+        assign(var, list(...)[[var]], this.env)
+     }
+     if(!hasArg(verbose)) verbose <- FALSE
+     if(!hasArg(auto.assign)) auto.assign <- TRUE
+
+     if(!requireNamespace("DBI", quietly=TRUE))
+       stop("package:",dQuote("DBI"),"cannot be loaded.")
+     if(!requireNamespace("RPostgreSQL", quietly=TRUE))
+       stop("package:",dQuote("RPostgreSQL"),"cannot be loaded.")
+
+        if(is.null(user) || is.null(password) || is.null(dbname)) {
+          stop(paste(
+              'At least one connection argument (',sQuote('user'),
+              sQuote('password'),sQuote('dbname'),
+              ") is not set"))
+        }
+        con <- DBI::dbConnect(RPostgreSQL::PostgreSQL(),user=user,password=password,dbname=dbname,host=host,port=port,options=options)
+
+        if(!is.null(search_path)) { 
+          dbGetQuery(con, paste0("set search_path to ", search_path) )
+        }
+
+        db.Symbols <- DBI::dbListTables(con)
+        if(length(Symbols) != sum(tolower(Symbols) %in% tolower(db.Symbols))) {
+          missing.db.symbol <- Symbols[!tolower(Symbols) %in% tolower(db.Symbols)]
+                warning(paste('could not load symbol(s): ',paste(missing.db.symbol,collapse=', ')))
+                Symbols <- Symbols[tolower(Symbols) %in% tolower(db.Symbols)]
+        }
+        for(i in seq_along(Symbols)) {
+            if(verbose) {
+                cat(paste('Loading ',Symbols[[i]],paste(rep('.',10-nchar(Symbols[[i]])),collapse=''),sep=''))
+            }
+            query <- paste0("SELECT ",paste(db.fields,collapse=',')," FROM \"",
+              if(any(Symbols[[i]] == tolower(db.Symbols))) { tolower(Symbols[[i]]) } else { toupper(Symbols[[i]]) }  
+            , "\" ORDER BY date")
+            rs <- DBI::dbSendQuery(con, query)
+            fr <- DBI::fetch(rs, n=-1)
+            #fr <- data.frame(fr[,-1],row.names=fr[,1])
+            fr <- xts(as.matrix(fr[,-1]),
+                      order.by=as.Date(fr[,1],origin='1970-01-01'),
+                      src=dbname,updated=Sys.time())
+            colnames(fr) <- paste(Symbols[[i]],
+                                  c('Open','High','Low','Close','Volume','Adjusted'),
+                                  sep='.')
+            fr <- convert.time.series(fr=fr,return.class=return.class)
+            if(auto.assign)
+              assign(Symbols[[i]],fr,env)
+            if(verbose) cat('done\n')
+        }
+        DBI::dbDisconnect(con)
+        if(auto.assign)
+          return(Symbols)
+        return(fr)
+}
+"getSymbols.PostgreSQL" <- getSymbols.PostgreSQL 
+# }}}
+
 # getSymbols.FRED {{{
 `getSymbols.FRED` <- function(Symbols,env,
      return.class="xts", ...) {
@@ -669,7 +736,7 @@ function(Symbols,env,return.class='xts',
 
      tmp <- tempfile()
      on.exit(unlink(tmp))
-     for(i in 1:length(Symbols)) {
+     for(i in seq_along(Symbols)) {
        if(verbose) cat("downloading ",Symbols[[i]],".....\n\n")
        URL <- paste(FRED.URL, "/", Symbols[[i]], "/downloaddata/", Symbols[[i]], ".csv", sep="")
        try.download.file(URL, destfile=tmp, quiet=!verbose, ...)
@@ -772,7 +839,7 @@ function(Symbols,env,
   if(!hasArg(verbose)) verbose <- FALSE
   if(!hasArg(auto.assign)) auto.assign <- TRUE
 
-  for(i in 1:length(Symbols)) {
+  for(i in seq_along(Symbols)) {
     return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
     return.class <- ifelse(is.null(return.class),default.return.class,
                            return.class)
@@ -841,7 +908,7 @@ function(Symbols,env,
   if(!hasArg(verbose)) verbose <- FALSE
   if(!hasArg(auto.assign)) auto.assign <- TRUE
 
-  for(i in 1:length(Symbols)) {
+  for(i in seq_along(Symbols)) {
     return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
     return.class <- ifelse(is.null(return.class),default.return.class,
                            return.class)
@@ -900,7 +967,7 @@ function(Symbols,env,
   if(!hasArg(verbose)) verbose <- FALSE
   if(!hasArg(auto.assign)) auto.assign <- TRUE
 
-  for(i in 1:length(Symbols)) {
+  for(i in seq_along(Symbols)) {
     return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
     return.class <- ifelse(is.null(return.class),default.return.class,
                            return.class)
@@ -963,7 +1030,7 @@ useRTH = '1', whatToShow = 'TRADES', time.format = '1', ...)
 
     if(missing(endDateTime)) endDateTime <- NULL
 
-    for(i in 1:length(Symbols)) {
+    for(i in seq_along(Symbols)) {
       Contract <- getSymbolLookup()[[Symbols[i]]]$Contract
       if(inherits(Contract,'twsContract')) {
         fr <- do.call('reqHistoricalData',list(tws, Contract, endDateTime=endDateTime,
@@ -1044,7 +1111,7 @@ function(Symbols,env,return.class='xts',
 
      tmp <- tempfile()
      on.exit(unlink(tmp))
-     for(i in 1:length(Symbols)) {
+     for(i in seq_along(Symbols)) {
        return.class <- getSymbolLookup()[[Symbols[[i]]]]$return.class
        return.class <- ifelse(is.null(return.class),default.return.class,
                               return.class)

man/getSymbols.PostgreSQL.Rd

@@ -0,0 +1,124 @@
+\name{getSymbols.PostgreSQL}
+\alias{getSymbols.PostgreSQL}
+\alias{getSymbols.PostgreSQL}
+\title{ Retrieve Data from PostgreSQL Database }
+\description{
+Fetch data from PostgreSQL database.  As with other
+methods extending the \code{getSymbols} function,
+this should \emph{NOT} be called directly.  Its
+documentation is meant to highlight the formal
+arguments, as well as provide a reference for
+further user contributed data tools.
+}
+\usage{
+getSymbols.PostgreSQL(Symbols,
+                 env, 
+                 return.class = 'xts',
+                 db.fields = c("date", "o", "h", "l", "c", "v", "a"), 
+                 field.names = NULL,
+                 user = NULL, 
+                 password = NULL, 
+                 dbname = NULL, 
+                 host = "localhost", 
+                 port = 5432,
+                 options = "",
+                 search_path=NULL,
+                 ...)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+       \item{Symbols}{ a character vector specifying
+                       the names of each symbol to be loaded}
+       \item{env}{ where to create objects. (.GlobalEnv)}
+       \item{return.class}{ desired class of returned object.
+                            Can be xts, 
+                            zoo, data.frame, ts, or its. (zoo)}
+       \item{db.fields}{ character vector indicating
+                           names of fields to retrieve}
+       \item{field.names}{ names to assign to returned columns }
+       \item{user}{ username to access database }
+       \item{password}{ password to access database }
+       \item{dbname}{ database name }
+       \item{host}{ database host }
+       \item{port}{ database port }
+       \item{options}{ command-line options to be sent to the server }
+       \item{search_path}{ schema path for table search }
+       \item{\dots}{ currently not used }
+}
+\details{
+Meant to be called internally by \code{getSymbols} (see also)
+
+One of a few currently defined methods for loading data for
+use with \pkg{quantmod}. Its use requires the packages
+\pkg{DBI} and \pkg{RPostgreSQL}, along with a running
+PostgreSQL database with tables corresponding to the
+\code{Symbol} name.
+
+The purpose of this abstraction is to make transparent the
+\sQuote{source} of the data, allowing instead the user to
+concentrate on the data itself.
+}
+\value{
+A call to getSymbols.PostgreSQL will load into the specified
+environment one object for each \code{Symbol} specified,
+with class defined by \code{return.class}.
+}
+\references{ 
+\itemize{
+   \cite{PostgreSQL \url{https://www.postgresql.org}}
+   \cite{R-SIG-DB. DBI: R Database Interface}
+ }
+ }
+\author{ Jeffrey A. Ryan and Andre I. Mikulec }
+\note{ 
+The default configuration needs a table named
+for the Symbol specified (e.g. MSFT), with
+column names date,o,h,l,c,v,a. For table
+layout changes it is best to use
+\code{setDefaults(getSymbols.PostgreSQL,...)} with
+the new db.fields values specified.
+}
+\note{ 
+Also in this particular getSymbols implementation,
+the user may have a PostgreSQL table named msft(lowercase). 
+In that situation the returned symbol will be msft(lowercase).
+The returned columns will be msft.Open, msft.High, etc.
+However, it is recommeded to work with upper case xts object 
+names e.g. MSFT to be consistent with the rest 
+of the quantmod workflow.
+In R an xts object and it's column uppercase 
+or lowercase names can be changed 
+with the functions tolower and toupper.
+Mixed case PostgreSQL table names are not supported.
+Therefore, a PostgreSQL table named MsFt will cause an Error.
+}
+\seealso{ \code{\link{getSymbols}},
+          \code{\link{setSymbolLookup}} }
+\examples{
+\dontrun{
+# All 3 getSymbols calls return the same
+# MSFT to the global environment
+# The last example is what NOT to do!
+
+setDefaults(getSymbols.PostgreSQL,user='jdoe',password='secret',
+            dbname='tradedata',search_path='usschema')
+
+## Method #1
+getSymbols('MSFT',src='PostgreSQL')
+
+
+## Method #2
+setDefaults(getSymbols,src='PostgreSQL')
+  # OR
+setSymbolLookup(MSFT='PostgreSQL')
+
+getSymbols('MSFT')
+
+#########################################
+##  NOT RECOMMENDED!!!
+#########################################
+## Method #3
+getSymbols.PostgreSQL('MSFT',env=globalenv())
+}
+}
+\keyword{ data }