diff --git a/DESCRIPTION b/DESCRIPTION index d158acc8..f60c7bcd 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index 37852cfd..adc183ea 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -250,6 +250,7 @@ export( loadSymbols, getSymbols, getSymbols.MySQL, + getSymbols.PostgreSQL, getSymbols.SQLite, getSymbols.mysql, getSymbols.FRED, diff --git a/R/getSymbols.R b/R/getSymbols.R index 1c1761a3..e647ff74 100644 --- a/R/getSymbols.R +++ b/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) diff --git a/man/getSymbols.PostgreSQL.Rd b/man/getSymbols.PostgreSQL.Rd new file mode 100644 index 00000000..c8db0601 --- /dev/null +++ b/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 }